+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
+++ /dev/null
-cmp: # compile everything and compare
- (cd etc ; make cmp )
- (cd util ; make cmp )
- (cd lang ; make cmp )
- (cd mach ; make cmp )
-
-install: # compile everything to machine code
- (cd etc ; make install )
- (cd util ; make install )
- (cd lang/cem ; make install )
- (cd mach ; make install )
- (cd lang/pc ; make install )
-
-clean: # remove all non-sources, except boot-files
- (cd doc ; make clean )
- (cd man ; make clean )
- (cd h ; make clean )
- (cd etc ; make clean )
- (cd util ; make clean )
- (cd lang ; make clean )
- (cd mach ; make clean )
-
-opr: # print all sources
- make pr | opr
-
-pr: # print all sources
- @( pr Makefile ; \
- (cd doc ; make pr ) ; \
- (cd man ; make pr ) ; \
- (cd h ; make pr ) ; \
- (cd etc ; make pr ) ; \
- (cd lang ; make pr ) ; \
- (cd util ; make pr ) ; \
- (cd mach ; make pr ) \
- )
+++ /dev/null
-SUF=pr
-PRINT=cat
-RESFILES=cref.$(SUF) pcref.$(SUF) val.$(SUF) v7bugs.$(SUF) install.$(SUF)\
-ack.$(SUF) cg.$(SUF) regadd.$(SUF) peep.$(SUF) toolkit.$(SUF)
-NROFF=nroff
-MS=-ms
-
-cref.$(SUF): cref.doc
- tbl $? | $(NROFF) >$@
-v7bugs.$(SUF): v7bugs.doc
- $(NROFF) $(MS) $? >$@
-ack.$(SUF): ack.doc
- $(NROFF) $(MS) $? >$@
-cg.$(SUF): cg.doc
- $(NROFF) $(MS) $? >$@
-regadd.$(SUF): regadd.doc
- $(NROFF) $(MS) $? >$@
-install.$(SUF): install.doc
- $(NROFF) $(MS) $? >$@
-pcref.$(SUF): pcref.doc
- $(NROFF) $? >$@
-peep.$(SUF): peep.doc
- $(NROFF) $(MS) $? >$@
-val.$(SUF): val.doc
- $(NROFF) $? >$@
-toolkit.$(SUF): toolkit.doc
- $(NROFF) $(MS) $? >$@
-
-install cmp:
-
-pr:
- @make "SUF="$SUF "NROFF="$NROFF "PRINT="$PRINT $(RESFILES) \
- >make.pr.out 2>&1
- @$(PRINT) $(RESFILES)
-
-opr:
- make pr | opr
-
-clean:
- -rm -f *.old $(RESFILES) *.t
+++ /dev/null
-.nr LL 7.5i
-.tr ~
-.nr PD 1v
-.TL
-Ack Description File
-.br
-Reference Manual
-.AU
-Ed Keizer
-.AI
-Wiskundig Seminarium
-Vrije Universiteit
-Amsterdam
-.NH
-Introduction
-.PP
-The program \fIack\fP(I) internally maintains a table of
-possible transformations and a table of string variables.
-The transformation table contains one entry for each possible
-transformation of a file.
-Which transformations are used depends on the suffix of the
-source file.
-Each transformation table entry tells which input suffixes are
-allowed and what suffix/name the output file has.
-When the output file does not already satisfy the request of the
-user, with the flag \fB-c.suffix\fP, the table is scanned
-starting with the next transformation in the table for another
-transformation that has as input suffix the output suffix of
-the previous transformation.
-A few special transformations are recognized, among them is the
-combiner.
-A program combining several files into one.
-When no stop suffix was specified (flag \fB-c.suffix\fP) \fIack\fP
-stops after executing the combiner with as arguments the -
-possibly transformed - input files and libraries.
-\fIAck\fP will only perform the transformations in the order in
-which they are presented in the table.
-.LP
-The string variables are used while creating the argument list
-and program call name for
-a particular transformation.
-.NH
-Which descriptions are used
-.PP
-\fIAck\fP always uses two description files: one to define the
-front-end transformations and one for the machine dependent
-back-end transformations.
-Each description has a name.
-First the way of determining
-the name of the descriptions needed is described.
-.PP
-When the shell environment variable ACKFE is set \fIack\fP uses
-that to determine the front-end table name, otherwise it uses
-\fBfe\fP.
-.PP
-The way the backend table name is determined is more
-convoluted.
-.br
-First, when the last filename in the program call name is not
-one of \fIack\fP, \fIcc\fP, \fIacc\fP, \fIpc\fP or \fIapc\fP,
-this filename is used as the backend description name.
-Second, when the \fB-m\fP is present the \fB-m\fP is chopped of this
-flag and the rest is used as the backend description name.
-Third, when both failed the shell environment variable ACKM is
-used.
-Last, when also ACKM was not present the default backend is
-used, determined by the definition of ACKM in h/local.h.
-The presence and value of the definition of ACKM is
-determined at compile time of \fIack\fP.
-.PP
-Now, we have the names, but that is only the first step.
-\fIAck\fP stores a few descriptions at compile time.
-This descriptions are simply files read in at compile time.
-At the moment of writing this document, the descriptions
-included are: pdp, fe, i86, m68k2, vax2 and int.
-The name of a description is first searched for internally,
-then in the directory lib/ack and finally in the current
-directory of the user.
-.NH
-Using the description file
-.PP
-Before starting on a narrative of the description file,
-the introduction of a few terms is necessary.
-All these terms are used to describe the scanning of zero
-terminated strings, thereby producing another string or
-sequence of strings.
-.IP Backslashing 5
-.br
-All characters preceded by \e are modified to prevent
-recognition at further scanning.
-This modification is undone before a string is passed to the
-outside world as argument or message.
-When reading the description files the
-sequences \e\e, \e# and \e<newline> have a special meaning.
-\e\e translates to a single \e, \e# translates to a single #
-that is not
-recognized as the start of comment, but can be used in
-recognition and finally, \e<newline> translates to nothing at
-all, thereby allowing continuation lines.
-.nr PD 0
-.IP "Variable replacement"
-.br
-The scan recognizes the sequences {{, {NAME} and {NAME?text}
-Where NAME can be any combination if characters excluding ? and
-} and text may be anything excluding }.
-(~\e} is allowed of course~)
-The first sequence produces an unescaped single {.
-The second produces the contents of the NAME, definitions are
-done by \fIack\fP and in description files.
-When the NAME is not defined an error message is produced on
-the diagnostic output.
-The last sequence produces the contents of NAME if it is
-defined and text otherwise.
-.PP
-.IP "Expression replacement"
-.br
-Syntax: (\fIsuffix sequence\fP:\fIsuffix sequence\fP=\fItext\fP)
-.br
-Example: (.c.p.e:.e=tail_em)
-.br
-If the two suffix sequences have a common member -~\&.e in this
-case~- the text is produced.
-When no common member is present the empty string is produced.
-Thus the example given is a constant expression.
-Normally, one of the suffix sequences is produced by variable
-replacement.
-\fIAck\fP sets three variables while performing the diverse
-transformations: HEAD, TAIL and RTS.
-All three variables depend on the properties \fIrts\fP and
-\fIneed\fP from the transformations used.
-Whenever a transformation is used for the first time,
-the text following the \fIneed\fP is appended to both the HEAD and
-TAIL variable.
-The value of the variable RTS is determined by the first
-transformation used with a \fIrts\fP property.
-.LP
-Two runtime flags have effect on the value of one or more of
-these variables.
-The flag \fB-.suffix\fP has the same effect on these three variables
-as if a file with that \fBsuffix\fP was included in the argument list
-and had to be translated.
-The flag \fB-r.suffix\fP only has that effect on the TAIL
-variable.
-The program call names \fIacc\fP and \fIcc\fP have the effect
-of an automatic \fB-.c\fB flag.
-\fIApc\fP and \fIpc\fP have the effect of an automatic \fB-.p\fP flag.
-.IP "Line splitting"
-.br
-The string is transformed into a sequence of strings by replacing
-the blank space by string separators (nulls).
-.IP "IO replacement"
-.br
-The > in the string is replaced by the output file name.
-The < in the string is replaced by the input file name.
-When multiple input files are present the string is duplicated
-for each input file name.
-.nr PD 1v
-.LP
-Each description is a sequence of variable definitions followed
-by a sequence of transformation definitions.
-Variable definitions use a line each, transformations
-definitions consist of a sequence of lines.
-Empty lines are discarded, as are lines with nothing but
-comment.
-Comment is started by a # character, and continues to the end
-of the line.
-Three special two-characters sequences exist: \e#, \e\e and
-\e<newline>.
-Their effect is described under 'backslashing' above.
-Each - nonempty - line starts with a keyword, possibly
-preceded by blank space.
-The keyword can be followed by a further specification.
-The two are separated by blank space.
-.PP
-Variable definitions use the keyword \fIvar\fP and look like this:
-.DS X
- var NAME=text
-.DE
-The name can be any identifier, the text may contain any
-character.
-Blank space before the equal sign is not part of the NAME.
-Blank space after the equal is considered as part of the text.
-The text is scanned for variable replacement before it is
-associated with the variable name.
-.br
-.sp 2
-The start of a transformation definition is indicated by the
-keyword \fIname\fP.
-The last line of such a definition contains the keyword
-\fIend\fP.
-The lines in between associate properties to a transformation
-and may be presented in any order.
-The identifier after the \fIname\fP keyword determines the name
-of the transformation.
-This name is used for debugging and by the \fB-R\fP flag.
-The keywords are used to specify which input suffices are
-recognized by that transformation,
-the program to run, the arguments to be handed to that program
-and the name or suffix of the resulting output file.
-Two keywords are used to indicate which run-time startoffs and
-libraries are needed.
-The possible keywords are:
-.IP \fIfrom\fP
-.br
-followed by a sequence of suffices.
-Each file with one of these suffices is allowed as input file.
-Preprocessor transformations, those with the \fBP\fP property
-after the \fIprop\fP keyword, do not need the \fIfrom\fP
-keyword. All other transformations do.
-.nr PD 0
-.IP \fIto\fP
-.br
-followed by the suffix of the output file name or in the case of a
-linker -~indicated by C option after the \fIprop\fP keyword~-
-the output file name.
-.IP \fIprogram\fP
-.br
-followed by name of the load file of the program, a pathname most likely
-starts with either a / or {EM}.
-This keyword must be
-present, the remainder of the line
-is subject to backslashing and variable replacement.
-.IP \fImapflag\fP
-.br
-The mapflags are used to grab flags given to \fIack\fP and
-pass them on to a specific transformation.
-This feature uses a few simple pattern matching and replacement
-facilities.
-Multiple occurences of this keyword are allowed.
-This text following the keyword is
-subjected to backslashing.
-The keyword is followed by a match expression and a variable
-assignment separated by blank space.
-As soon as both description files are read, \fIack\fP looks
-at all transformations in these files to find a match for the
-flags given to \fIack\fP.
-The flags \fB-m\fP, \fB-o\fP,
-\fI-O\fP, \fB-r\fP, \fB-v\fP, \fB-g\fP, -\fB-c\fP, \fB-t\fP,
-\fB-k\fP, \fB-R\fP and -\f-.\fP are specific to \fIack\fP and
-not handed down to any transformation.
-The matching is performed in the order in which the entries
-appear in the definition.
-The scanning stops after first match is found.
-When a match is found, the variable assignment is executed.
-A * in the match expression matches any sequence of characters,
-a * in the right hand part of the assignment is
-replaced by the characters matched by
-the * in the expression.
-The right hand part is also subject to variable replacement.
-The variable will probably be used in the program arguments.
-The \fB-l\fP flags are special,
-the order in which they are presented to \fIack\fP must be
-preserved.
-The identifier LNAME is used in conjunction with the scanning of
-\fB-l\fP flags.
-The value assigned to LNAME is used to replace the flag.
-The example further on shows the use all this.
-.IP \fIargs\fP
-.br
-The keyword is followed by the program call arguments.
-It is subject to backslashing, variable replacement, expression
-replacement, line splitting and IO replacement.
-The variables assigned to by \fImapflags\P will probably be
-used here.
-The flags not recognized by \fIack\fP or any of the transformations
-are passed to the linker and inserted before all other arguments.
-.IP \fIprop\fB
-.br
-This -~optional~- keyword is followed by a sequence of options,
-each option is indicated by one character
-signifying a special property of the transformation.
-The possible options are:
-.DS X
- < the input file will be read from standard input
- > the output file will be written on standard output
- p the input files must be preprocessed
- m the input files must be preprocessed when starting with #
- O this transformation is an optimizer and may be skipped
- P this transformation is the preprocessor
- C this transformation is the linker
-.DE
-.IP \fIrts\fP
-.br
-This -~optional~- keyword indicates that the rest of the line must be
-used to set the variable RTS, if it was not already set.
-Thus the variable RTS is set by the first transformation
-executed which such a property or as a result from \fIack\fP's program
-call name (acc, cc, apc or pc) or by the \fB-.suffix\fP flag.
-.IP \fIneed\fP
-.br
-This -~optional~- keyword indicates that the rest of the line must be
-concatenated to the NEEDS variable.
-This is done once for every transformation used or indicated
-by one of the program call names mentioned above or indicated
-by the \fB-.suffix\fP flag.
-.br
-.nr PD 1v
-.NH
-Conventions used in description files
-.PP
-\fIAck\fP reads two description files.
-A few of the variables defined in the machine specific file
-are used by the descriptions of the front-ends.
-Other variables, set by \fack\fB, are of use to all
-transformations.
-.PP
-\fIAck\fP sets the variable EM to the home directory of the
-Amsterdam Compiler Kit.
-The variable SOURCE is set to the name of the argument that is currently
-being massaged, this is usefull for debugging.
-.br
-The variable M indicates the
-directory in mach/{M}/lib/tail_..... and NAME is the string to
-be defined by the preprocessor with -D{NAME}.
-The definitions of {w}, {s}, {l}, {d}, {f} and {p} indicate
-EM_WSIZE, EM_SSIZE, EM_LSIZE, EM_DSIZE, EM_FSIZE and EM_PSIZE
-respectively.
-.br
-The variable INCLUDES is used as the last argument to \fIcpp\fP,
-it is currently used to add the directory {EM}/include to
-the list of directories containing #include files.
-{EM}/include contains a few files used by the library routines
-for part III from the
-.UX
-manual.
-These routines are included in the kit.
-.PP
-The variables HEAD, TAIL and RTS are set by \fIack\fP and used
-to compose the arguments for the linker.
-.NH
-Example
-.sp 1
-description for front-end
-.DS X
-name cpp # the C-preprocessor
- # no from, it's governed by the P property
- to .i # result files have suffix i
- program {EM}/lib/cpp # pathname of loadfile
- mapflag -I* CPP_F={CPP_F?} -I* # grab -I.. -U.. and
- mapflag -U* CPP_F={CPP_F?} -U* # -D.. to use as arguments
- mapflag -D* CPP_F={CPP_F?} -D* # in the variable CPP_F
- args {CPP_F?} {INCLUDES?} -D{NAME} -DEM_WSIZE={w} -DEM_PSIZE={p} \
--DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d} <
- # The arguments are: first the -[IUD]...
- # then the include dir's for this machine
- # then the NAME and size valeus finally
- # followed by the input file name
- prop >P # Output on stdout, is preprocessor
-end
-name cem # the C-compiler proper
- from .c # used for files with suffix .c
- to .k # produces compact code files
- program {EM}/lib/em_cem # pathname of loadfile
- mapflag -p CEM_F={CEM_F?} -Xp # pass -p as -Xp to cem
- mapflag -L CEM_F={CEM_F?} -l # pass -L as -l to cem
- args -Vw{w}i{w}p{p}f{f}s{s}l{l}d{d} {CEM_F?}
- # the arguments are the object sizes in
- # the -V... flag and possibly -l and -Xp
- prop <>p # input on stdin, output on stdout, use cpp
- rts .c # use the C run-time system
- need .c # use the C libraries
-end
-name decode # make human readable files from compact code
- from .k.m # accept files with suffix .k or .m
- to .e # produce .e files
- program {EM}/lib/em_decode # pathname of loadfile
- args < # the input file name is the only argument
- prop > # the output comes on stdout
-end
-.DE
-
-.DS X
-Example of a backend, in this case the EM assembler/loader.
-
-var w=2 # wordsize 2
-var p=2 # pointersize 2
-var s=2 # short size 2
-var l=4 # long size 4
-var f=4 # float size 4
-var d=8 # double size 8
-var M=int # Unused in this example
-var NAME=int22 # for cpp (NAME=int results in #define int 1)
-var LIB=mach/int/lib/tail_ # part of file name for libraries
-var RT=mach/int/lib/head_ # part of file name for run-time startoff
-var SIZE_FLAG=-sm # default internal table size flag
-var INCLUDES=-I{EM}/include # use {EM}/include for #include files
-name asld # Assembler/loader
- from .k.m.a # accepts compact code and archives
- to e.out # output file name
- program {EM}/lib/em_ass # load file pathname
- mapflag -l* LNAME={EM}/{LIB}* # e.g. -ly becomes
- # {EM}/mach/int/lib/tail_y
- mapflag -+* ASS_F={ASS_F?} -+* # recognize -+ and --
- mapflag --* ASS_F={ASS_F?} --*
- mapflag -s* SIZE_FLAG=-s* # overwrite old value of SIZE_FLAG
- args {SIZE_FLAG} \
- ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
- (.p:{TAIL}={EM}/{LIB}pc) \
- (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
- (.c.p:{TAIL}={EM}/{LIB}mon)
- # -s[sml] must be first argument
- # the next line contains the choice for head_cc or head_pc
- # and the specification of in- and output.
- # the last three args lines choose libraries
- prop C # This is the final stage
-end
-.DE
-
-The command "ack -mint -v -v -I../h -L -ly prog.c"
- would result in the following
-calls (with exec(II)):
-.DS X
-1) /lib/cpp -I../h -I/usr/em/include -Dint22 -DEM_WSIZE=2 -DEM_PSIZE=2
- -DEM_SSIZE=2 -DEM_LSIZE=4 -DEM_FSIZE=4 -DEM_DSIZE=8 prog.c
-2) /usr/em/lib/em_cem -Vw2i2p2f4s2l4d8 -l
-3) /usr/em/lib/em_ass -sm /usr/em/mach/int/lib/head_cc -o e.out prog.k
- /usr/em/mach/int/lib/tail_y /usr/em/mach/int/lib/tail_cc.1s
- /usr/em/mach/int/lib/tail_cc.2g /usr/em/mach/int/lib/tail_mon
-.DE
+++ /dev/null
-.RP
-.TL
-The table driven code generator from
-.br
-the Amsterdam Compiler Kit
-.AU
-Hans van Staveren
-.AI
-Dept. of Mathematics and Computer Science
-Vrije Universiteit
-Amsterdam, The Netherlands
-.AB
-It is possible to automate the process of compiler building
-to a great extent using collections of tools.
-The Amsterdam Compiler Kit is such a collection of tools.
-This document provides a description of the internal workings
-of the table driven code generator in the Amsterdam Compiler Kit,
-and a description of syntax and semantics of the driving table.
-.AE
-.NH 1
-Introduction
-.PP
-Part of the Amsterdam Compiler Kit is a code generator system consisting
-of a code generator generator (\fIcgg\fP for short) and some machine
-independent C code.
-.I Cgg
-reads a machine description table and creates two files,
-tables.h and tables.c.
-These are then used together with other C code to produce
-a code generator for the machine at hand.
-.PP
-This in turn reads compact EM code and produces
-assembly code.
-The remainder of this document will first broadly describe
-the working of the code generator,
-then a description of the machine table follows after which
-the internal workings of the code generator will be explained.
-.PP
-The reader is assumed to have at least a vague notion about the
-semantics of the intermediary EM code.
-Someone wishing to write a table for a new machine
-should be thoroughly acquainted with EM code
-and the assembly code of the machine at hand.
-.NH 1
-Global overview of the workings of the code generator.
-.PP
-The code generator or
-.I cg
-tries to generate good code by simulating the runtime stack
-of the program compiled and delaying emission of code as long
-as possible.
-It also keeps track of register contents, which enables it to
-eliminate redundant moves, and tries to eliminate redundant tests
-by keeping information about condition code status,
-if applicable for the machine.
-.PP
-.I Cg
-maintains a `fakestack' containing `tokens' that are built
-by executing the pseudo code contained in the code rules given
-by the table writer.
-One can think of the fakestack as a logical extension of the real
-stack the program compiled will have when run.
-During code generation tokens will be kept on the fakestack as long
-as possible but when they are moved to the real stack,
-by generating code for the push,
-all tokens above\u*\d
-.FS
-* in the rest of this document the stack is assumed to grow downwards,
-although the top of the stack will mean the first element that will
-be popped.
-.FE
-the tokens pushed will be pushed also,
-so that the fakestack will not contain holes.
-.PP
-The main loop of
-.I cg
-is this:
-.IP 1)
-find a pattern of EM instructions starting at the current one to
-generate code for.
-This pattern will usually be of length one but longer patterns can be used.
-.IP 2)
-Select one of the possibly many stack patterns that go with this
-EM pattern on the basis of heuristics and/or lookahead.
-.IP 3)
-Force the current fakestack contents to match the pattern.
-This may involve
-copying tokens to registers, making dummy transformations, e.g. to
-transform a "local" into an "register offsetted" or might even
-cause to have the complete fakestack contents put to the real stack
-and then back into registers if no suitable transformations
-were provided by the table writer.
-.IP 4)
-Execute the pseudocode associated with the code rule just selected,
-this may cause registers to be allocated,
-code to be emitted etc..
-.IP 5)
-Put tokens onto the fakestack to reflect the result of the operation.
-.IP 6)
-Insert some EM instructions into the stream,
-this is possible but not common.
-.IP 7)
-Account for the cost.
-The cost is kept in a (space, time) vector and lookahead decisions
-are based on a linear combination of these.
-.PP
-The table that drives
-.I cg
-is not read in every time,
-but instead is used at compiletime
-of
-.I cg
-to set parameters and to load pseudocode tables.
-A program called
-.I cgg
-reads the table and produces large lists of numbers that are
-compiled together with machine independent code to produce
-a code generator for the machine at hand.
-.NH 1
-Description of the machine table
-.PP
-The machine description table consists of the following sections:
-.IP 1)
-Constant definitions
-.IP 2)
-Register definitions
-.IP 3)
-Token definitions
-.IP 4)
-Token expression definitions
-.IP 5)
-Code rules
-.IP 6)
-Move definitions
-.IP 7)
-Test definitions
-.IP 8)
-Stacking definitions
-.PP
-Input is in free format, white space and newlines may be used
-at will to improve legibility.
-Identifiers used in the table have the same syntax as C identifiers,
-upper and lower case considered different, all characters significant.
-There is however one exception:
-identifiers must be more than one character long for parsing reasons.
-C style comments are accepted
-.DS
- /* this is a comment */
-.DE
-and #define macros may be used if the need arises.
-.NH 2
-Some constants
-.PP
-Before anything else three constants must be defined,
-all with the syntax NAME=value, value being an integer.
-These constants are:
-.IP EM_WSIZE 10
-Number of bytes in a machine word.
-This is the number of bytes
-a simple \fBloc\fP instruction will put on the stack.
-.IP EM_PSIZE
-Number of bytes in a pointer.
-This is the number of bytes
-a \fBlal\fP instruction will put on the stack.
-.IP EM_BSIZE
-Number of bytes in the hole between AB and LB.
-If the calling sequence just saves PC and LB this
-size will be twice the pointersize.
-.PP
-EM_WSIZE and EM_PSIZE are checked when a program is compiled
-with the resulting code generator.
-EM_BSIZE is used by
-.I cg
-to add to the offset of instructions dealing with locals
-having positive offsets,
-i.e. parameters.
-.PP
-Optionally one can give here the factors with which the size and time
-parts of the cost function have to be multiplied to ensure they have the
-same order of magnitude.
-This can be done as
-.DS
-TIMEFACTOR = C\d1\u/C\d2\u
-SIZEFACTOR = C\d3\u/C\d4\u
-.DE
-Above numbers must be read as rational numbers.
-Defaults are 1/1 for both of them.
-These constants set the default size/time tradeoff in the code generator,
-so if TIMEFACTOR and SIZEFACTOR are both 1 the code generator will choose
-at random between two codesequences where one has
-cost (10,4) and the other has cost (8,6).
-See also the description of the cost field below.
-.PP
-Also optional is the definition of a printformat for integers in the codefile.
-This is given as
-.DS
-FORMAT = string
-.DE
-The default for string is "%d" or "%ld" depending on the wordsize of
-the machine. For example on the PDP 11 one can use
-.DS
-FORMAT= "0%o"
-.DE
-to satisfy the old UNIX assembler that reads octal unless followed by
-a period, and the ACK assembler that follows C conventions.
-.NH 2
-Register definition
-.PP
-The next part of the tables describes the various registers of the
-machine and defines identifiers
-to be used in later parts of the tables.
-Example for the PDP-11:
-.DS L
-REGISTERS:
-R0 = ( "r0",2), REG.
-R1 = ( "r1",2), REG, ODDREG.
-R2 = ( "r2",2), REG.
-R3 = ( "r3",2), REG, ODDREG.
-R4 = ( "r4",2), REG.
-LB = ( "r5",2), LOCALBASE.
-R01= ( "r0",4,R0,R1), REGPAIR.
-R23= ( "r2",4,R2,R3), REGPAIR.
-FR0= ( "r0",4), FREG.
-FR1= ( "r1",4), FREG.
-FR2= ( "r2",4), FREG.
-FR3= ( "r3",4), FREG.
-DR0= ( "r0",8,FR0), DREG.
-DR1= ( "r1",8,FR1), DREG.
-DR2= ( "r2",8,FR2), DREG.
-DR3= ( "r3",8,FR3), DREG.
-.DE
-.PP
-The identifier before the '=' sign is the name of the register
-as used further on in the table.
-The string is the name of the register as far as the assembler is concerned.
-The number is the size of the register in bytes.
-Identifiers following the number but within the parentheses are previously
-defined registernames that are contained in the register being defined.
-The identifiers following the closing parenthesis are properties
-of the register.
-So for example R23 is a register with assembler name r2, 4 bytes long,
-contains the registers R2 and R3 and has the property REGPAIR.
-.PP
-It might seem wise to list each and every property of a register,
-so one might give R0 the extra property MFPTREG named after the not
-too well known MFPT instruction on newer PDP-11 types,
-but this is not a good idea.
-Every extra property means the registerset is more unorthogonal
-and
-.I cg
-execution time is influenced by that,
-because it has to take into account a larger set of registers
-that are not equivalent.
-.PP
-There is a predefined property SCRATCH that is dynamic,
-i.e. a register can have the property SCRATCH one time,
-and loose it the next.
-A register has the property SCRATCH when it has a reference count of one.
-One needs to be able to discriminate between SCRATCH registers
-and others,
-because it is only allowed to do arithmetic on
-SCRATCH registers.
-.NH 2
-Stack token definition
-.PP
-The next part describes all possible tokens that can reside on
-the fakestack during code generation.
-Attributes of a token are described in the form of a C struct declaration,
-this is followed by the size in bytes of the token,
-optionally followed by the cost of the token when used as an addressing mode
-and the format
-to be used on output.
-.PP
-Tokens should usually be declared for every addressing mode
-of the machine at hand and for every size directly usable in
-a machine instruction.
-Example for the PDP-11 (incomplete):
-.DS L
-TOKENS:
-IREG2 = { REGISTER reg; } 2 "*%[reg]" /* indirect register */
-REGCONST = { REGISTER reg; STRING off; } 2 /* not really addressable */
-REGOFF2 = { REGISTER reg; STRING off; } 2 "%[off](%[reg])"
-IREGOFF2 = { REGISTER reg; STRING off; } 2 "*%[off](%[reg])"
-CONST = { INT off; } 2 cost=(2,850) "$%[off]."
-EXTERN2 = { STRING off; } 2 "%[off]"
-IEXTERN2 = { STRING off; } 2 "*%[off]"
-PAIRSIGNED = { REGISTER regeven,regodd; } 2 "%[regeven]"
-.DE
-.PP
-Types allowed in the struct are REGISTER, INT and STRING.
-Tokens without a printformat should never be output.
-.PP
-Notice that tokens need not correspond to addressing modes,
-the REGCONST token listed above,
-meaning the sum of the contents of the register and the constant,
-has no corresponding addressing mode on the PDP-11,
-but is included so that a sequence of add constant, load indirect,
-can be handled efficiently.
-This REGCONST token is needed as part of the path
-.DS
-REGISTER -> REGCONST -> REGOFF
-.DE
-of which the first and the last "exist" and the middle is needed
-only as an intermediate step.
-.NH 2
-Token expressions
-.PP
-Usually machines have certain collections of addressing modes that
-can be used with certain instructions.
-The stack patterns in the table are lists of these collections
-and since it is cumbersome to write out these long lists
-every time, there is a section here to give names to these
-collections.
-Please note that it is not forbidden to write out a token expression
-in the remainder of the table,
-but for clarity it is usually better not to.
-Example for the PDP-11 (incomplete):
-.DS L
-TOKENEXPRESSIONS:
-SOURCE2 = REG + IREG2 + REGOFF2 + IREGOFF2 + CONST + EXTERN2 +
- IEXTERN2
-SREG = REG * SCRATCH
-.DE
-Permissible in the expressions are all PASCAL set operators, i.e.
-.IP +
-set union
-.IP -
-set difference
-.IP *
-set intersection
-.PP
-Every tokenidentifier is also a token expression identifier
-denoting the singleton collection of tokens containing
-just itself.
-Every register property as defined above is also a token expression
-matching all registers with that property when on the fakestack.
-The standard token expression identifier ALL denotes the collection of
-all tokens.
-.NH 2
-Expressions
-.PP
-Throughout the rest of the table expressions can be used in some
-places.
-This section will give the syntax and semantics of expressions.
-There are four types of expressions: integer, string, register and undefined.
-Type checking is performed by
-.I cgg .
-An operator with at least one undefined operand returns undefined except
-for the defined() function mentioned below.
-An undefined expression is interpreted as FALSE when it is needed
-as a truth value.
-Basic terms in an expression are
-.IP number 16
-A number is a constant of type integer.
-.IP "string"
-A string within double quotes is a constant of type string.
-All the normal C style escapes may be used within the string.
-.IP REGIDENT
-The name of a register is a constant of type register.
-.IP $\fIi\fP
-A dollarsign followed by a number is the representation of the argument
-of EM instruction \fI\fP.
-The type of the operand is dependent on the instruction,
-sometimes it is integer,
-sometimes it is string.
-It is undefined when the instruction has no operand.
-.br
-Although an exhaustive list could be given describing all the types
-the following rule of thumb will suffice.
-If you cannot imagine the operand of the instruction ever to be
-something different from a plain integer, the type is integer,
-otherwise it is string.
-.br
-.I Cg
-makes all necessary conversions for you,
-like adding EM_BSIZE to positive arguments of instructions
-dealing with locals,
-prepending underlines to global names,
-converting codelabels into a unique representation etc.
-Details about this can be found in the section about
-machine dependent C code.
-.IP %[1]
-This in general means the token mentioned first in the
-stack pattern.
-When used inside an expression the token must be a simple register.
-Type of this is register.
-.IP %[1.off]
-This means field "off" of the first stack pattern token.
-Type is the same as that of field "off".
-To use this expression implies a check that all tokens
-in the token expression used have the same attributes.
-.IP %[1.1]
-This is the first subregister of the first token.
-Previous comments apply.
-.IP %[b]
-The second allocated register.
-.IP %[a.2]
-The second subregister of the first allocated register.
-.PP
-All normal C operators apply to integers,
-the + operator serves for string concatenation
-and register expressions can only be compared to each other.
-Furthermore there are some special "functions":
-.IP tostring(e) 16
-Converts an integer expression e to a string.
-.IP defined(e)
-Returns 1 if expression e is defined, 0 otherwise.
-.IP samesign(e1,e2)
-Returns 1 if integer expression e1 and e2 have the same sign.
-.IP sfit(e1,e2)
-Returns 1 if integer expression e1 fits as a signed integer
-into a field of e2 bits, 0 otherwise.
-.IP ufit(e1,e2)
-Same as above but now for unsigned e1.
-.IP rom(a,n)
-Integer expression giving the n'th argument from the \fBrom\fP descriptor
-pointed at by the a'th EM instruction.
-Undefined if that descriptor does not exist.
-.IP loww(a)
-Returns the lower half of the argument of the a'th EM instruction.
-This is used to split the arguments of a \fBldc\fP instruction.
-.IP highw(a)
-Same for upper half.
-.NH 2
-Code rules
-.PP
-The largest section of the tables consists of the code generation rules.
-They specify EM patterns, stack patterns, code to be generated etc.
-Syntax is
-.DS L
-code rule : EM pattern '|' stack pattern '|' code '|'
- stack replacement '|' EM replacement '|' cost ;
-.DE
-All parts are optional, however there must be at least one pattern present.
-If the empattern is missing the rule becomes a rewriting rule or
-.I coercion
-to be used when code generation cannot continue
-because of an invalid stack pattern.
-The code rules are preceded by the word
-.DS
-CODE:
-.DE
-The next paragraphs describe the various parts in detail.
-.NH 3
-The EM pattern
-.PP
-The EM pattern consists of a list of EM mnemonics followed
-by a boolean expression.
-Examples:
-.DS
-\fBloe\fP
-.DE
-will match a single \fBloe\fP instruction,
-.DS
-\fBloc\fP \fBloc\fP \fBcif\fP $1==2 && $2==8
-.DE
-is a pattern that will match
-.DS
-\fBloc\fP 2
-\fBloc\fP 8
-\fBcif\fP
-.DE
-and
-.DS
-\fBlol\fP \fBinc\fP \fBstl\fP $1==$3
-.DE
-will match for example
-.DS
-\fBlol\fP 6
-\fBinc\fP
-\fBstl\fP 6
-.DE
-A missing boolean expression evaluates to TRUE.
-.PP
-When the EM pattern is the same as in the previous code rule the pattern
-should be given as `...'.
-The code generator will match the longest EM pattern on every occasion,
-if two patterns of the same length match the first in the table will be chosen,
-while all patterns of length greater than or equal to three are considered
-to be of the same length.
-.NH 3
-The stack pattern
-.PP
-The stack pattern is a list of token expressions,
-usually token expression identifiers for clarity.
-No boolean expression is allowed here.
-The first expression is the one that matches the top of the stack.
-.PP
-The pattern can be followed by the word STACK
-in which case the pattern only matches if there is nothing
-else on the fakestack.
-The code generator will stack everything not matched at the start
-of the rule.
-.PP
-The pattern can be preceded with the word
-.DS
-nocoercions:
-.DE
-which tells the code generator not to try to coerce to the pattern
-but only to use it when it is already there.
-There are two reasons for this construction,
-correctness and speed.
-It is needed for correctness when the pattern contains a register
-that is not transparent when data is moved through it.
-.PP
-Example: on the PDP-11 the shortest code for
-.DS
-\fBlae\fP a
-\fBloi\fP 8
-\fBlae\fP b
-\fBsti\fP 8
-.DE
-is
-.DS
-movf _a,fr0
-movf fr0,_b
-.DE
-assuming that the floating point processor is in double
-precision mode and fr0 is free.
-Unfortunately this is not correct since a trap can occur on certain
-kinds of data.
-This could happen if there was a pattern for \fBsti\fP\ 8 that allowed
-one to move a floating point register not preceded by nocoercions: .
-The code generator would then find that moving the 8-byte global _a
-to a floating point register and then storing it to _b was the cheapest,
-assuming that the space/time knob was turned far enough to space.
-It is unfortunate that the type information is no longer present,
-since if _a really is a floating point number the move could be
-made without error.
-.PP
-The second reason for the nocoercions: construct is speed.
-When the code generator has a long list of possible stack patterns
-for one EM pattern it can waste a lot of time trying to find coercions
-to all of them, while the mere presence of such a long list
-indicates that the table writer has given a lot of special cases.
-In this case prepending all the special cases by nocoercions:
-will stop the code generator from trying to find things there aren't.
-.NH 3
-The code part
-.PP
-The code part consists of three parts, stack cleanup, register allocation
-and code to generate.
-All of these may be omitted.
-.NH 4
-Stack cleanup
-.PP
-The stack cleanup part describes certain stacktokens that should neither remain on
-the fakestack, nor remembered as contents of registers.
-This is usually only required with store operations.
-The entire fakestack, except for the part matched in the stack pattern,
-is searched for tokens matching the expression and they are copied
-to the real stack.
-Every register that contains the stacktoken is marked as empty.
-.PP
-Syntax is
-.DS
-remove(token expression) \fIor\fP
-remove(token expression, boolean expression)
-.DE
-Example:
-.DS
-remove(REGOFF2,%[reg] != LB || %[off] == $1)
-.DE
-is part of a remove() call for use in the \fBstl\fP code rule.
-It removes all register offsetted tokens where the register is not the
-localbase plus the local wherein the store is done.
-The necessity for this can be seen from the following example:
-.DS
-\fBlol\fP 4
-\fBinl\fP 4
-\fBstl\fP 6
-.DE
-Without a proper remove() call in the rule for \fBinl\fP code would
-be generated as here
-.DS
-inc 4(r5)
-mov 4(r5),6(r5)
-.DE
-so local 6 would be given the new value of local 4 instead of the old
-as the EM code prescribed.
-.PP
-When generating something like a branch instruction it
-might be needed to empty the fakestack completely.
-This can of course be done with
-.DS
-remove(ALL)
-.DE
-.NH 4
-Register allocation
-.PP
-The register allocation part describes the kind of registers needed.
-Syntax for allocate() is
-.DS
-allocate(itemlist)
-.DE
-where itemlist is a list of three kinds of things:
-.IP 1)
-a tokendescription, for example %[1].
-.br
-This will instruct the code generator to temporarily decrement the reference count
-of all registers contained in the token,
-so that they are available for allocation in this allocate() call
-if they were only used in that token.
-See example below.
-.IP 2)
-a register property.
-.br
-This will allocate a register with that property.
-The register will be marked as empty at this point.
-Lookahead will be performed if necessary.
-.IP 3)
-a register property with initialization.
-.br
-This will allocate the register as in 2) but will also
-initialize it.
-This eases the task of the code generator because it can
-find a register already filled with the right value
-if it exists.
-.PP
-Examples:
-.DS
-allocate(OREG)
-.DE
-will allocate an odd register, while
-.DS
-allocate(REG={REGOFF2,LB,$1})
-.DE
-will allocate a register while simultaneously filling it with
-the asked value.
-.br
-Inside the coercion from SOURCE2 to REGISTER in the PDP-11 table
-the following allocate() can be found.
-.DS
-allocate(%[1],REG=%[1])
-.DE
-This tells the code generator that registers contained in %[1] can be used
-again and asks to fill the register allocated with %[1].
-So if %[1]={REGOFF2,R3,"4"} and R3 has a reference count of 1
-the following code might be generated.
-.DS
-mov 4(r3),r3
-.DE
-In the rest of the line the registers allocated can be named by
-%[a] and %[b.1],%[b.2], i.e. with lower case letters
-in order of allocation.
-.PP
-Warning:
-.DS
-allocate(R3)
-.DE
-is \fRnot\fP the way to allocate R3.
-R3 is not a register property, so it will be seen as a token description
-and the effect is that R3 will have its reference count decremented.
-.NH 4
-Code
-.PP
-Code to be generated is specified as a list of items of the following kind:
-.IP 1)
-a string in double quotes ("This is a string").
-.br
-This is copied to the codefile and a newline ( \en ) is appended.
-Inside the string all normal C string conventions are allowed,
-and substitutions can be made of the following sorts.
-.RS
-.IP a)
-$1, $2 etc.
-These are the operands of the corresponding EM instructions
-and are printed according to their type.
-To put a real '$' inside the string it must be doubled ('$$').
-.IP b)
-%[1], %[2.reg], %[b.1] etc.
-These have their obvious meaning.
-If they describe a complete token ( %[1] )
-the printformat for the token is used.
-If they stand for a basic term in an expression
-they will be printed according to their type.
-To put a real '%' inside the string it must be doubled ('%%').
-.IP c)
-%( arbitrary expression %).
-This allows inclusion of arbitrary expressions inside strings.
-Usually not needed very often,
-so that the awkward notation is not too bad.
-Note that %(%[1]%) is equivalent to %[1].
-.RE
-.IP 2)
-a move() call.
-This has the following syntax:
-.DS
-move(token description, token description)
-.DE
-Moves are handled specially since that enables the code generator
-to keep track of register contents.
-Example:
-.DS
-move(R3,{REGOFF2,LB,$1})
-.DE
-will generate code to move R3 to $1(r5) except when
-R3 already was a copy of $1(r5).
-Then the code will be omitted.
-The rules describing how to move things to each other
-can be found in the MOVES section described below.
-.IP 3)
-an erase() call.
-This has the following syntax:
-.DS
-erase(register expression)
-.DE
-This tells the code generator that the register mentioned no longer has any
-useful value.
-This is
-.I necessary
-after code in the table has changed the contents of registers.
-For example, after an add to a register the register must be erased,
-because the contents do no longer match any token.
-.IP 4)
-For machines that have condition codes,
-alas most of them do,
-there are provisions to remember condition code setting
-and prevent needless testing.
-To set the condition code to a token put in the code the following call:
-.DS
-test(token)
-.DE
-where token can be all of the standard forms that can also be used in move().
-This will generate a test if the condition codes
-were not already set to that token.
-It is also possible to tell
-.I cg
-that a certain operation, like a preceding add
-has set the condition codes to some token with the call
-.DS
-setcc(token)
-.DE
-So a sequence of a setcc and a test on the same token will generate
-no code.
-Another allowed call within the code is
-.DS
-samecc
-.DE
-which tells the code generator that condition codes were unaffected
-in this rule.
-If no setcc or samecc has been given the default is
-.DS
-nocc
-.DE
-when a piece of code contained strings,
-which tells the code generator that the condition codes
-have no useful value any more.
-.NH 3
-Stack replacement
-.PP
-The stack replacement is a possibly empty list of items to be pushed onto
-the fakestack. Three kinds of items are possible:
-.IP 1)
-An item of the form %[1]. This will push the stacktoken mentioned back
-onto the stack unchanged.
-.IP 2)
-A register expression. This will push the register mentioned
-onto the fakestack.
-.IP 3)
-An item of the form { REGOFF2,%[1.reg],$1 }.
-This generates a token with tokenidentifier REGOFF2 and attributes
-in order of declaration.
-.PP
-All tokens matched by the stack pattern at the beginning of the code rule
-are first removed and their registers deallocated.
-Items are pushed in the order of appearance.
-This means that the last item will be on the top of the
-stack after the push.
-So if the stack pattern contained two token expressions
-and you want to push them back unchanged,
-you have to specify as stack replacement
-.DS
-%[2] %[1]
-.DE
-and not the other way around.
-.NH 3
-EM replacement
-.PP
-In exceptional cases it might be useful to leave part of an empattern
-undone.
-For example, a \fBsdl\fP instruction might be split into two \fBstl\fP instructions
-when there is no 4-byte quantity on the stack. The emreplacement part allows
-one to express this.
-Example:
-.DS
-\fBstl\fP $1 \fBstl\fP $1+2
-.DE
-The instructions are inserted in the stream so that they can match
-the first part of a pattern in the next step.
-Note that since the code generator traverses the EM instructions in a strict
-linear fashion,
-it is impossible to let the EM replacement match later parts of a pattern.
-So if there is a pattern
-.DS
-\fBloc\fP \fBstl\fP $1==0
-.DE
-and the input is
-.DS
-\fBloc\fP 0 \fBsdl\fP 4
-.DE
-the \fBloc\fP\ 0 will be processed first,
-then the \fBsdl\fP might be split into two \fBstl\fP's but the pattern
-cannot match now.
-.NH 3
-Cost
-.PP
-The cost field can be specified when there is more than one
-code rule with the same empattern.
-If the code generator has a choice between two possibilities
-to generate code it will choose the cheapest according to
-the cost field.
-The cost for a code generation is the sum of the costs
-of all the coercions needed, plus the cost for freeing
-registers plus the cost of the code rule itself.
-.PP
-The format of the costfield is
-.DS
-( nbytes, time ) or
-( nbytes, time ) + %[\fIi\fP]
-.DE
-with time in the metric desired, like nanoseconds or states.
-See constants section above.
-The %[\fIi\fP] in the second example is used for adding the cost of a certain
-address mode used in the code generated.
-This can of course be repeated if desired.
-The cost of the address mode must then be specified in the token definition
-section.
-.NH 3
-Examples
-.PP
-A list of examples for the PDP-11 is given here.
-Far from being complete it gives examples of most kinds
-of instructions.
-.DS L
-\fBadi\fP $1==2 | SREG,SOURCE2 |
- "add %[2],%[1]" erase(%[1]) setcc(%[1])
- | %[1] | | (2,450) + %[2]
-\&... | SOURCE2,SREG |
- "add %[1],%[2]" erase(%[2]) setcc(%[2])
- | %[2] | | (2,450) + %[1]
-.DE
-is an example of the use of the `...' construct
-and shows how to place erase() and setcc() calls.
-.DS L
-
-\fBdvi\fP $1==2 | SOURCE2,SPAIRSIGNED |
- "div %[1],%[2]" erase(%[2])
- | %[2.regeven] | |
-
-\fBcmi\fP \fBtgt\fP $1==2 | SOURCE2,SOURCE2 | allocate(REG={CONST,0})
- "cmp %[2],%[1];ble 1f;inc %[a];1:" erase(%[a])
- | %[a] | |
-
-\fBcal\fP | STACK |
- "jsr pc,$1"
- | | |
-
-\fBlol\fP | | | { REGOFF2, LB, $1 } | |
-
-\fBstl\fP | SOURCE2 |
- remove(REGOFF2,%[off]==$1)
- move(%[1],{REGOFF2,LB,$1})
- | | |
-
-| SOURCE2 |
- allocate(%[1],REGPAIR)
- move(%[1],%[a.2])
- test(%[a.2])
- "sxt %[a.even]" | { PAIRSIGNED, %[a.1], %[a.2] }| |
-.DE
-This coercion shows how to use the move and test calls.
-At first you might think that the testcall is unnecessary,
-since the move will have set the condition codes,
-but the move may never have been executed
-if the register already contained the value,
-in which case it is necessary to do the test.
-If the move was executed the test will be omitted.
-.DS L
-| SOURCE2 | allocate(%[1],REG=%[1]) | %[a] | |
-
-\fBsdl\fP | SOURCE2 | | %[1] | \fBstl\fP $1 \fBstl\fP $1+2 |
-
-\fBexg\fP $1==2 | SOURCE2 SOURCE2 | | %[1] %[2] | |
-.DE
-This last example again shows the difference in the order
-of the stack pattern and the stack replacement.
-.NH 2
-Move code rules
-.PP
-When issuing a move() call as described above or a register allocation
-with initialization, the code generator has to know which
-instruction to use for the move.
-The code will of course only be generated if it cannot be omitted.
-This is listed in the move section of the tables by giving a list
-of tuples:
-.DS
-( source, destination, codepart [ , costfield ] )
-.DE
-where the square brackets mean the costfield is optional.
-Example for the PDP-11
-.DS
-MOVES:
-( CONST %[off]==0 , SOURCE2, "clr %[2]" )
-( SOURCE2, SOURCE2, "mov %[1],%[2]" )
-.DE
-The moves are scanned from top to bottom,
-so the first one that matches will be chosen.
-.NH 2
-Test code rules
-.PP
-When issuing a test() call as described above,
-the code generator has to know which instruction
-to use for the test.
-The code will only be generated if the condition codes
-were not already set to the token.
-This is listed in the test section of the tables by giving
-a list of tuples:
-.DS
-( source, codepart [ , costfield ] )
-.DE
-Example for the PDP-11
-.DS
-TESTS:
-( SOURCE2, "tst %[1]")
-( DREG, "tstf %[1]\encfcc")
-.DE
-The tests are scanned from top to bottom,
-so the first one that matches will be chosen.
-.NH 2
-Stacking code rules.
-.PP
-When the code generator has to stack a token it must know
-which code to use.
-Since it must at all times be possible to empty the fakestack
-even when no registers are free,
-it is mandatory that all
-tokens used must have a rule attached for stacking them
-without using a scratch register.
-Since however this might be clumsy and
-a register might in practice be available
-it is also possible to give rules
-which use a register.
-On the Intel 8086 for example,
-there is no instruction to push a constant without using a register,
-and the code needed to do it without, must use global data
-and as such is very complicated and wasteful of memory and time.
-It can therefore be left to be used in extreme cases,
-while in general the constant is pushed through a register.
-The stacking rules are listed in the stack section of the table as a list
-of tuples:
-.DS
-(source, [ register property ] , codepart [ , costfield ] )
-.DE
-Example for the Intel 8086:
-.DS
-STACKS:
-(CONST, REG, move(%[1],%[a]) "push %[a]")
-(REG ,, "push %[1]")
-.DE
-.NH 1
-The files mach.h and mach.c
-.PP
-The table writer must also supply two files containing
-machine dependent declarations and C code.
-These files are mach.h and mach.c.
-.NH 2
-Types in the code generator
-.PP
-Three different types of integer coexist in the code generator
-and their range depends on the machine at hand.
-The type 'int' is used for things like labelcounters that won't require
-more than 16 bits precision.
-The type 'word' is used among others to assemble datawords and
-is of type 'long' if EM_WSIZE>2.
-The type 'full' is used for addresses and is of type 'long' if
-EM_WSIZE>2 or EM_PSIZE>2.
-.PP
-In macro and function definitions in later paragraphs implicit typing
-will be used for parameters, that is parameters starting with an 's'
-will be of type string, and the letters 'i','w','f' will stand for
-int, word and full respectively.
-.NH 2
-Global variables to work with
-.PP
-Some global variables are present in the code generator
-that can be manipulated by the routines in mach.h and mach.c.
-.LP
-The declarations are:
-.DS L
-.ta 20
-FILE *codefile; /* code is emitted on this stream */
-word part_word; /* words to be output are put together here */
-int part_size; /* number of bytes already put in part_word */
-char str[]; /* Last string read in */
-long argval; /* Last int read and kept */
-.DE
-.NH 2
-Macros in mach.h
-.PP
-In the file mach.h a collection of macros is defined that have
-to do with formatting of assembly code for the machine at hand.
-Some of these macros can of course be left undefined in which case the
-macro calls are left in the source and will be treated as
-function calls.
-These functions can then be defined in \fImach.c\fR.
-.PP
-The macros to be defined are:
-.IP ex_ap(s) 16
-Must print the magic incantations that will mark the symbol \fI\fR
-to be exported to other modules.
-This is the translation of the EM \fBexa\fP and \fBexp\fP instructions.
-.IP in_ap(s)
-Same to import the symbol.
-Translation of \fBina\fP and \fBinp\fP.
-.IP newilb(s)
-Must print the definition of instruction label \fIs\fR.
-.IP newdlb(s)
-Must print the definition of data label \fIs\fR.
-.IP dlbdlb(s1,s2)
-Must define data label
-.I s1
-to be equal to
-.I s2 .
-.IP newlbss(s,f)
-Must declare a piece of memory initialized to BSS_INIT(see below)
-of length
-.I f
-and with label
-.I s .
-.IP cst_fmt
-Format to be used when converting constant arguments of
-EM instructions to string.
-Argument to be formatted will be 'full'.
-.IP off_fmt
-Format to be used for integer part of label+constant,
-argument will be 'full'.
-.IP ilb_fmt
-Format to be used for creation of unique instruction labels.
-Arguments will be a unique procedure number (int) and the label
-number (int).
-.IP dlb_fmt
-Format to be used for printing numeric data labels.
-Argument will be 'int'.
-.IP hol_fmt
-Format to be used for generation of labels for
-space generated by a
-.B hol
-pseudo.
-Argument will be 'int'.
-.IP hol_off
-Format to be used for printing of the address of an element in
-.B hol
-space.
-Arguments will be the offset in the
-.B hol
-block (word) and the number of the
-.B hol
-(int).
-.IP con_cst(w)
-Must generate output that will assemble into one machineword.
-.IP con_ilb(s)
-Must generate output that will put the address of the instruction label
-into the datastream.
-.IP con_dlb(s)
-Must generate output that will put the address of the data label
-into the datastream.
-.IP id_first
-Must be a character.
-This is prepended to all nonnumeric global labels if their length
-is shorter than the maximum allowed(currently 8) or if they already
-start with that character.
-This is to avoid conflicts of user labels with system labels.
-.IP BSS_INIT
-Must be a constant.
-This is the value filled in all the words not initialized explicitly.
-This is loader and system dependent.
-If omitted no initialization is assumed.
-.NH 3
-Example mach.h for the PDP-11
-.DS L
-.ta 8 16 24 32 40 48 56
-#define ex_ap(y) fprintf(codefile,"\et.globl %s\en",y)
-#define in_ap(y) /* nothing */
-
-#define newilb(x) fprintf(codefile,"%s:\en",x)
-#define newdlb(x) fprintf(codefile,"%s:\en",x)
-#define dlbdlb(x,y) fprintf(codefile,"%s=%s\en",x,y)
-#define newlbss(l,x) fprintf(codefile,"%s:.=.+%d.\en",l,x);
-
-#define cst_fmt "$%d."
-#define off_fmt "%d."
-#define ilb_fmt "I%02x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "%d.+hol%d"
-
-#define con_cst(x) fprintf(codefile,"%d.\en",x)
-#define con_ilb(x) fprintf(codefile,"%s\en",x)
-#define con_dlb(x) fprintf(codefile,"%s\en",x)
-
-#define id_first '_'
-#define BSS_INIT 0
-.DE
-.NH 2
-Functions in mach.c
-.PP
-In mach.c some functions must be supplied,
-mostly manipulating data resulting from pseudoinstructions.
-The specifications are given here,
-implicit typing of parameters as above.
-.IP con_part(isz,word) 20
-This function must manipulate the globals
-part_word and part_size to append the isz bytes
-contained in word to the output stream.
-If part_word is full, i.e. part_size==EM_WSIZE
-the function part_flush() may be called to empty the buffer.
-This is the function that must go through the trouble of
-doing byte order in words correct.
-.IP con_mult(w_size)
-This function must take the string str[] and create an integer
-from the string of size w_size and generate code to assemble global
-data for that integer.
-Only the sizes for which arithmetic is implemented need be
-handled,
-so if you didn't implement 200-byte integer division
-you don't have to implement 200-byte integer global data.
-Here one must take care of word order in long integers.
-.IP con_float()
-This function must generate code to assemble a floating
-point number of which the size is contained in argval
-and the ASCII representation in str[].
-.IP prolog(f_nlocals)
-This function is called at the start of every procedure.
-Function prolog code must be generated,
-and room made for local variables for a total of f_nlocals bytes.
-.IP mes(w_mesno)
-This function is called when a
-.B mes
-pseudo is seen that is not handled by the machine independent part.
-Example below shows all you probably have to know about that.
-.IP segname[]
-This is not a function,
-but an array of four strings.
-These strings are put out whenever the code generator
-switches segments.
-Segments are SEGTXT, SEGCON, SEGROM and SEGBSS in that order.
-.NH 3
-Example mach.c for the PDP-11
-.PP
-As an example of the sort of code expected,
-the mach.c for the PDP-11 is presented here.
-.DS L
-.ta 8 16 24 32 40 48 56 64
-/*
- * machine dependent back end routines for the PDP-11
- */
-
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == EM_WSIZE)
- part_flush();
- if (sz == 1) {
- w &= 0xFF;
- if (part_size)
- w <<= 8;
- part_word |= w;
- } else {
- assert(sz == 2);
- part_word = w;
- }
- part_size += sz;
-}
-
-con_mult(sz) word sz; {
- long l;
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- l = atol(str);
- fprintf(codefile,"\et%o;%o\en",(int)(l>>16),(int)l);
-}
-
-con_float() {
- double f;
- register short *p,i;
-
- /*
- * This code is correct only when the code generator is
- * run on a PDP-11 or VAX-11 since it assumes native
- * floating point format is PDP-11 format.
- */
-
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- f = atof(str);
- p = (short *) &f;
- i = *p++;
- if (argval == 8) {
- fprintf(codefile,"\et%o;%o;",i,*p++);
- i = *p++;
- }
- fprintf(codefile,"\et%o;%o\en",i,*p++);
-}
-
-prolog(nlocals) full nlocals; {
-
- fprintf(codefile,"mov r5,-(sp)\enmov sp,r5\en");
- if (nlocals == 0)
- return;
- if (nlocals == 2)
- fprintf(codefile,"tst -(sp)\en");
- else
- fprintf(codefile,"sub $%d.,sp\en",nlocals);
-}
-
-mes(type) word type; {
- int argt ;
-
- switch ( (int)type ) {
- case ms_ext :
- for (;;) {
- switch ( argt=getarg(
- ptyp(sp_cend)|ptyp(sp_pnam)|sym_ptyp) ) {
- case sp_cend :
- return ;
- default:
- strarg(argt) ;
- fprintf(codefile,".globl %s\en",argstr) ;
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
-.DE
-.NH 1
-Coercions
-.PP
-A central part in code generation is taken by the
-.I coercions .
-It is the responsibility of the table writer to provide
-all necessary coercions so that code generation can continue.
-The very minimal set of coercions are
-the coercions to unstack every token expression,
-in combination with the rules to stack every token.
-.PP
-If these are present the code generator can always make the necessary
-transformations by stacking and unstacking.
-Of course for codequality it is usually best to provide extra coercions
-to prevent this stacking to take place.
-.I Cg
-discriminates three types of coercions:
-.IP 1)
-Unstacking coercions.
-This category can use the allocate() call in its code.
-.IP 2)
-Splitting coercions, these are the coercions that split
-larger tokens into smaller ones.
-.IP 3)
-Transforming coercions, these are the coercions that transform
-a token into another one of the same size.
-This category can use the allocate() call in its code.
-.PP
-When a stack configuration does not match the stack pattern
-.I coercions
-are searched for in the following order:
-.IP 1)
-First tokens are split if necessary to get their sizes right.
-.IP 2)
-Then transforming coercions are found that will make the pattern match.
-.IP 3)
-Finally if the stack pattern is longer than the fakestack contents
-unstacking coercions will be used to fill up the pattern.
-.PP
-At any point, when coercions are missing so code generation could not
-continue, the offending tokens are stacked.
-.NH 1
-Internal workings of the code generator.
-.NH 2
-Description of tables.c and tables.h contents
-.PP
-In this section the intermediate files will be described
-that are produced by
-.I cgg
-and compiled with machine independent code to produce a code generator.
-.NH 3
-Tables.c
-.PP
-Tables.c contains a large number of initialized array's of all sorts.
-Description of each follows:
-.br
-.in 1i
-.ti -0.5i
-byte code rules[]
-.br
-Pseudo code interpreted by the code generator.
-Always starts with some opcode followed by operands depending
-on the opcode.
-Integers in this table are between 0 and 32767 and have a one byte
-encoding if between 0 and 127.
-.ti -0.5i
-char stregclass[]
-.br
-Number of computed static register class per register.
-Two registers are in the same class if they have the same properties
-and don't share a common subregister.
-.ti -0.5i
-struct reginfo machregs[]
-.br
-Info per register.
-Initialized with representation string, size,
-members of the register and set of registers affected when this
-one is changed.
-Also contains room for runtime information,
-like contents and reference count.
-.ti -0.5i
-tkdef_t tokens[]
-.br
-Information per tokentype.
-Initialized with size, cost, type of operands and formatstring.
-.ti -0.5i
-node_t enodes[]
-.br
-List of triples representing expressions for the code generator.
-.ti -0.5i
-string code strings[]
-.br
-List of strings.
-All strings are put in a list and checked for duplication,
-so only one copy per string will reside here.
-.ti -0.5i
-set_t machsets[]
-.br
-List of token expression sets.
-Bit 0 of the set is used for the SCRATCH property of registers,
-bit 1 upto NREG are for the corresponding registers
-and bit NREG+1 upto the end are for corresponding tokens.
-.ti -0.5i
-inst_t tokeninstances[]
-.br
-List of descriptions for building tokens.
-Contains type of rule for building one,
-plus operands depending on the type.
-.ti -0.5i
-move_t moves[]
-.br
-List of move rules.
-Contains token expressions for source and destination
-plus cost and index for code rule.
-.ti -0.5i
-byte pattern[]
-.br
-EM patterns.
-This is structured internally as chains of patterns,
-each chain pointed at by pathash[].
-After each pattern the list of possible code rules is given.
-.ti -0.5i
-int pathash[256]
-.br
-Indices into pattern[] for all patterns with a certain low order
-byte of the hashing function.
-.ti -0.5i
-c1_t c1coercs[]
-.br
-List of rules to stack tokens.
-Contains token expressions,
-register needed,
-cost
-and code rule.
-.ti -0.5i
-c2_t c2coercs[]
-.br
-List of splitting coercions.
-Token expressions,
-split factor,
-replacements
-and code rule.
-.ti -0.5i
-c3_t c3coercs[]
-.br
-List of one to one coercions.
-Token expressions,
-register needed,
-replacement
-and code rule.
-.ti -0.5i
-struct reginfo **reglist[]
-.br
-List of lists of pointers to register information.
-For every property the list is here
-to find the registers corresponding to it.
-.in 0
-.NH 3
-tables.h
-.PP
-In tables.h various derived constants for the tables are
-given.
-They are then used to determine array sizes in the actual code generator,
-plus loop termination in some cases.
-.NH 2
-Other important data structures
-.PP
-During code generation some other data structures are used
-and here is a short description of some of the important ones.
-.PP
-Tokens are kept in the code generator as a struct consisting of
-one integer
-.I t_token
-which is -1 if the token is a register,
-and the number of the token otherwise,
-plus an array of
-.I TOKENSIZE
-unions
-.I t_att
-of which the first is the register number in case of a register.
-.PP
-The fakestack is an array of these tokens,
-there is a global variable
-.I stackheight .
-.PP
-The results of expressions are kept in a struct
-.I result
-with elements
-.I e_typ ,
-giving the type of the expression:
-.I EV_INT ,
-.I EV_REG
-or
-.I EV_STR ,
-and a union
-.I e_v
-which contains the real result.
-.NH 2
-A tour through the sources
-.NH 3
-codegen.c
-.PP
-The file codegen.c contains one large function consisting
-of one giant switch statement.
-It is the interpreter for the code generator pseudo code
-as contained in code rules[].
-This function can call itself recursively when doing lookahead.
-Arguments are:
-.IP codep 10
-Pointer into code rules, pseudo program counter.
-.IP ply
-Number of EM pattern lookahead allowed.
-.IP toplevel
-Boolean telling whether this is the toplevel codegen() or
-a deeper incarnation.
-.IP costlimit
-A cutoff value to limit searches.
-If the cost crosses costlimit the incarnation can terminate.
-.IP forced
-A register number if nonzero.
-This is used inside coercions to force the allocate() call to allocate
-a register determined by earlier lookahead.
-.PP
-The instructions inplemented in the switch:
-.NH 4
-DO_NEXTEM
-.PP
-Matches the next EM pattern and does lookahead if necessary to find the best
-code rule associated with this pattern.
-Heuristics are used to determine best code rule when possible.
-This is done by calling the distance() function.
-.NH 4
-DO_COERC
-.PP
-This sets the code generator in the state to do a from stack coercion.
-.NH 4
-DO_XMATCH
-.PP
-This is done when a match no longer has to be checked.
-Used when the nocoercions: trick is used in the table.
-.NH 4
-DO_MATCH
-.PP
-This is the big one inside this function.
-It has the task to transform the contents of the current
-fakestack to match the pattern given after it.
-.PP
-Since the code generator does not know combining coercions,
-i.e. there is no way to make a big token out of two smaller ones,
-the first thing done is to stack every token that is too small.
-After that all tokens too big are split if possible to the right size.
-.PP
-Next the coercions are sought that would transform tokens in place to
-the right one, plus the coercions that would pop tokens of the stack.
-Each of those might need a register, so a list of registers is generated
-and at the end of looking for coercions the function
-.I tuples()
-is called to generate the list of all possible \fIn\fP-tuples,
-where
-.I n
-equals the number of registers needed.
-.PP
-Lookahead is now performed if the number of tuples is greater than one.
-If no possibility is found within the costlimit,
-the fakestack is made smaller by pushing the bottom token,
-and this process is repeated until either a way is found or
-the fakestack is completely empty and there is still no way
-to make the match.
-.PP
-If there is a way the corresponding coercions are executed
-and the code is finished.
-.NH 4
-DO_REMOVE
-.PP
-Here the remove() call is executed, all tokens matched by the
-token expression plus boolean expression are pushed.
-In the current implementation there is no attempt to move those
-tokens to registers, but that is a possible future extension.
-.NH 4
-DO_DEALLOCATE
-.PP
-This one temporarily decrements by one the reference count of all registers
-contained in the token given as argument.
-.NH 4
-DO_REALLOCATE
-.PP
-Here all temporary deallocates are made undone.
-.NH 4
-DO_ALLOCATE
-.PP
-This is the part that allocates a register and decides which one to use.
-If the
-.I forced
-argument was given its task is simple,
-otherwise some work must be done.
-First the list of possible registers is scanned,
-all free registers noted and it is noted whether any of those
-registers is already
-containing the initialization.
-If no registers are available some fakestack token is stacked and the
-process is repeated.
-.PP
-After that if an exact match was found,
-the list of registers is reduced to one register matching exactly
-out of every register class.
-Now lookahead is performed if necessary and the register chosen.
-If an initialization was given the corresponding move is performed,
-otherwise the register is marked empty.
-.NH 4
-DO_LOUTPUT
-.PP
-This prints a string and an expression.
-Only done on toplevel.
-.NH 4
-DO_ROUTPUT
-.PP
-Prints a string and a new line.
-Only on toplevel.
-.NH 4
-DO_MOVE
-.PP
-Calls the move() function in the code generator to implement the move()
-function in the table.
-.NH 4
-DO_ERASE
-.PP
-Marks the register that is its argument as empty.
-.NH 4
-DO_TOKREPLACE
-.PP
-This is the token replacement part.
-It is also called if there is no token replacement because it has
-some other functions as well.
-.PP
-First the tokens that will be pushed on the fakestack are computed
-and stored in a temporary array.
-Then the tokens that were matched in this rule are popped
-and their embedded registers have their reference count
-decremented.
-After that the replacement tokens are pushed.
-.PP
-Finally all registers allocated in this rule have their reference count
-decremented.
-If they were not pushed on the fakestack they will be available again
-in the next code rule.
-.NH 4
-DO_EMREPLACE
-.PP
-Places replacement EM instructions back into the instruction stream.
-.NH 4
-DO_COST
-.PP
-Accounts for cost as given in the code rule.
-.NH 4
-DO_RETURN
-.PP
-Returns from this level of codegen().
-Is used at the end of coercions,
-move rules etc..
-.NH 3
-compute.c
-.PP
-This module computes the various expressions as given
-in the enodes[] array.
-Nothing very special happens here,
-it is just a recursive function computing leaves
-of expressions and applying the operator.
-.NH 3
-equiv.c
-.PP
-In this module the tuples() function is implemented.
-It is given the number of registers needed and
-a list of register lists and it constructs a list of tuples
-where the \fIn\fP'th register comes from the \fIn\fP'th list.
-Before the list is constructed however
-the dynamic register classes are computed.
-Two registers are in the same dynamic class if they are in the
-same static class and their contents is the same.
-.PP
-After that the permute() recursive function is called to
-generate the list of tuples.
-After construction a generated tuple is added to the list
-if it is not already pairwise in the same class
-or if the register relations are not the same,
-i.e. if the first and second register share a common
-subregister in one tuple and not in the other they are considered different.
-.NH 3
-fillem.c
-.PP
-This is the routine that does the reading of EM instructions
-and the handling of pseudos.
-The mach.c module provided by the table writer is included
-at the end of this module.
-The routine fillemlines() is called by nextem() at toplevel
-to make sure there are enough instruction to match.
-It fills the EM instruction buffer up to 5 places from the end to
-keep room for EM replacement instructions,
-or up to a pseudo.
-.PP
-The dopseudo() function performs the function of the pseudo last
-encountered.
-If the pseudo is a
-.B rom
-the corresponding label is saved with the contents of the
-.B rom
-to be available to the code generator later.
-The rest of the routines are small service routines for either
-input or data output.
-.NH 3
-gencode.c
-.PP
-This module contains routines called by codegen() to generate the real
-code to the codefile.
-The function gencode() gets a string as argument and copies it to codefile
-while processing certain embedded control characters implementing
-the $2 and [1.reg] escapes.
-The function genexpr() prints the expression given as argument.
-It is used to implement the %(\ expr\ %) escape.
-The prtoken() function interprets the tokenformat as given in
-the tokens[] array.
-.NH 3
-glosym.c
-.PP
-This module maintains a list of global symbols that have a
-.B rom
-pseudo associated.
-There are functions to enter a symbol and to find a symbol.
-.NH 3
-main.c
-.PP
-Main routine of the code generator.
-Processes arguments and flags.
-Flags available are:
-.IP -d
-Sets debug mode if the code generator was not compiled with
-the NDEBUG macro defined.
-Debug mode gives very long output on stderr indicating
-all steps of the code generation process including nesting
-of the codegen() function.
-.IP -p\fIn\fP
-Sets the lookahead depth to
-.I n ,
-the
-.I p
-stands for ply,
-a well known word in chess playing programs.
-.IP -w\fIn\fP
-Sets the weight percentage for size in the cost function to
-.I n
-percent.
-Uses Euclides algorithm to simplify rationals.
-.NH 3
-move.c
-.PP
-Function to implement the move() pseudo function in the tables,
-register initialization and the setcc and test pseudo functions.
-First tests are made to try to prevent the move from really happening.
-The condition code register is treated special here.
-After that, if there is an after that,
-the move rule is found and the code executed.
-.NH 3
-nextem.c
-.PP
-The entry point of this module is nextem().
-It hashes the next three EM instructions,
-and uses the low order byte of the hash
-as an index into the array pathash[],
-to find a chain of patterns in the array
-pattern[],
-that are all tried for a match.
-.PP
-The function trypat() does most of the work
-checking patterns.
-When a pattern is found to match all instructions
-the operands of the instruction are placed into the dollar[] array.
-Then the boolean expression is tried.
-If it matches the function can return,
-leaving the operands still in the dollar[] array,
-so later in the code rule they can still be used.
-.NH 3
-reg.c
-.PP
-Collection of routines to handle registers.
-Reference count routines are here,
-chrefcount() and getrefcount(),
-plus routines to erase a single register or all of them,
-erasereg() and cleanregs().
-.PP
-If NDEBUG hasn't been defined, here is also the routine that checks
-if the reference count kept with the register information is in
-agreement with the number of times it occurs on the fakestack.
-.NH 3
-salloc.c
-.PP
-Module for string allocation and garbage collection.
-Contains entry points myalloc(),
-a routine calling malloc() and checking whether room is left,
-myfree(), just free(),
-popstr() a function called from state.c to free all strings
-made since the last saved status.
-Furthermore there is salloc() which has the size of the string as parameter
-and returns a pointer to the allocated space,
-while keeping a copy of the pointer for garbage allocation purposes.
-.PP
-The function garbage_collect is called from codegen() at toplevel
-every now and then,
-and checks all places where strings may reside to mark strings
-as being in use.
-Strings not in use are returned to the pool of free space.
-.NH 3
-state.c
-.PP
-Set of routines called to save current status,
-restore a previous saved state and to free the room
-occupied by a saved state.
-A list of structs is kept here to save the state.
-If this is not done,
-small allocates will take space
-from the holes big enough for state saves,
-and as a result every new state save will need a new struct.
-The code generator runs out of room very rapidly under these conditions.
-.NH 3
-subr.c
-.PP
-Random set of leftover routines.
-.NH 4
-match
-.PP
-Computes whether a certain token matches a certain token expression.
-Just computes a bitnumber according to the algorithm explained with
-machsets[],
-and tests the bit and the boolean expression if it is there.
-.NH 4
-instance,cinstance
-.PP
-These two functions compute a token from a description.
-They differ very slight, cinstance() is used to compute
-the result of a coercion in a certain context
-and therefore has more arguments, which it uses instead of
-the global information instance() works on.
-.NH 4
-eqtoken
-.PP
-eqtoken computes whether two tokens can be considered identical.
-Used to check register contents during moves mainly.
-.NH 4
-distance
-.PP
-This is the heuristic function that computes a distance from
-the current fakestack contents to the token pattern in the table.
-It likes exact matches most, then matches where at least the sizes are correct
-and if the sizes are not correct it likes too large sizes more than too
-small, since splitting a token is easier than combining one.
-.NH 4
-split
-.PP
-This function tries to find a splitting coercion
-and executes it immediately when found.
-The fakestack is shuffled thoroughly when this happens,
-so pieces below the token that must be split are saved first.
-.NH 4
-docoerc
-.PP
-This function executes a coercion that was found.
-The same shuffling is done, so the top of the stack is again saved.
-.NH 4
-stackupto
-.PP
-This function gets a pointer into the fakestack and must stack
-every token including the one pointed at up to the bottom of the fakestack.
-The first stacking rule possible is used,
-so rules using registers must come first.
-.NH 4
-findcoerc
-.PP
-Looks for a one to one coercion, if found it returns a pointer
-to it and leaves a list of possible registers to use in the global
-variable curreglist.
-This is used by codegen().
-.NH 3
-var.c
-.PP
-Global variables used by more than one module.
-External definitions are in extern.h.
+++ /dev/null
-.ll 72
-.nr ID 4
-.de hd
-'sp 2
-'tl ''-%-''
-'sp 3
-..
-.de fo
-'bp
-..
-.tr ~
-. TITLE
-.de TL
-.sp 15
-.ce
-\\fB\\$1\\fR
-..
-. AUTHOR
-.de AU
-.sp 15
-.ce
-by
-.sp 2
-.ce
-\\$1
-..
-. DATE
-.de DA
-.sp 3
-.ce
-( Dated \\$1 )
-..
-. INSTITUTE
-.de VU
-.sp 3
-.ce 4
-Wiskundig Seminarium
-Vrije Universteit
-De Boelelaan 1081
-Amsterdam
-..
-. PARAGRAPH
-.de PP
-.sp
-.ti +\n(ID
-..
-.nr CH 0 1
-. CHAPTER
-.de CH
-.nr SH 0 1
-.bp
-.in 0
-\\fB\\n+(CH.~\\$1\\fR
-.PP
-..
-. SUBCHAPTER
-.de SH
-.sp 3
-.in 0
-\\fB\\n(CH.\\n+(SH.~\\$1\\fR
-.PP
-..
-. INDENT START
-.de IS
-.sp
-.in +\n(ID
-..
-. INDENT END
-.de IE
-.in -\n(ID
-.sp
-..
-.de PT
-.ti -\n(ID
-.ta \n(ID
-.fc " @
-"\\$1@"\c
-.fc
-..
-. DOUBLE INDENT START
-.de DS
-.sp
-.in +\n(ID
-.ll -\n(ID
-..
-. DOUBLE INDENT END
-.de DE
-.ll +\n(ID
-.in -\n(ID
-.sp
-..
-. EQUATION START
-.de EQ
-.sp
-.nf
-..
-. EQUATION END
-.de EN
-.fi
-.sp
-..
-. ITEM
-.de IT
-.sp
-.in 0
-\\fB~\\$1\\fR
-.ti +5
-..
-.de CS
-.br
-~-~\\
-..
-.br
-.fi
-.TL "Ack-C reference manual"
-.AU "Ed Keizer"
-.DA "September 12, 1983"
-.VU
-.wh 0 hd
-.wh 60 fo
-.CH "Introduction"
-The C frontend included in the Amsterdam Compiler Kit
-translates UNIX-V7 C into compact EM code [1].
-The language accepted is described in [2] and [3].
-This document describes which implementation dependent choices were
-made in the Ack-C frontend and
-some restrictions and additions.
-.CH "The language"
-.PP
-Under the same heading as used in [2] we describe the
-properties of the Ack-C frontend.
-.IT "2.2 Identifiers"
-External identifiers are unique up to 7 characters and allow
-both upper and lower case.
-.IT "2.4.3 Character constants"
-The ASCII-mapping is used when a character is converted to an
-integer.
-.IT "2.4.4 Floating constants"
-To prevent loss of precision the compiler does not perform
-floating point constant folding.
-.IT "2.6 Hardware characteristics"
-The size of objects of the several arithmetic types and the two
-pointer types depend on the EM-implementation used.
-The ranges of the arithmetic types depend on the size used,
-the C-frontend assumes two's complement representation for the
-integral types. All sizes are multiples of bytes.
-The calling program \fIack\fP[4] passes information about the
-size of the types to the compiler proper.
-.br
-However, a few general remarks must be made:
-.sp 1
-.IS
-.PT (a)
-Two different pointer types exist: pointers to data and
-pointers to functions.
-The latter type is twice as large as the former.
-Pointers to functions use the same format as Pascal procedure
-parameters, thereby allowing C to use Pascal procedure
-parameters and vice-versa.
-The extra information passed indicates the scope level of the
-procedure.
-.PT (b)
-The size of pointers to data is a multiple of
-(or equal to) the size of an \fIint\fP.
-.PT (c)
-The following relations exist for the sizes of the types
-mentioned:
-.br
-.ti +5
-\fIchar<=short<=int<=long\fP
-.PT (d)
-Objects of type \fIchar\fP use one 8-bit byte of storage,
-although several bytes are allocated sometimes.
-.PT (e)
-All sizes are in multiples of bytes.
-.PT (f)
-Most EM implementations use 4 bytes for floats and 8 bytes
-for doubles, but exceptions to this rule occur.
-.IE
-.IT "6.1 Characters and integers"
-Objects of type \fIchar\fP are unsigned and do not cause
-sign-extension when converted to \fIint\fP.
-The range of characters values is from 0 to 255.
-.IT "6.3 Floating and integral"
-Floating point numbers are truncated towards zero when
-converted to the integral types.
-.IT "6.4 Pointers and integers"
-When a \fIlong\fP is added to or subtracted from a pointer and
-longs are larger then data pointers the \fIlong\fP is converted to an
-\fIint\fP before the operation is performed.
-.IT "8.5 Structure and union declarations"
-The only type allowed for fields is \fIint\fP.
-Fields with exactly the size of \fIint\fP are signed,
-all other fields are unsigned.
-.br
-The size of any single structure must be less then 4096 bytes.
-.IT "8.6 Initialization"
-Initialization of structures containing bit fields is not
-allowed.
-There is one restriction when using an 'address expression' to initialize
-an integral variable.
-The integral variable must have the size of a data pointer.
-Conversions altering the size of the address expression are not allowed.
-.IT "10.1 External function definitions"
-The total amount for storage used for parameters
-in any function must be less then 4096 bytes.
-The same holds for the total amount of storage occupied by the
-automatic variables declared inside any function.
-.sp
-Using formal parameters whose size is smaller the the size of an int
-is less efficient on several machines.
-At procedure entry these parameters are converted from integer to the
-declared type, because the compiler doesn't know where the least
-significant bytes are stored in the int.
-.IT "11.2 Scope of externals"
-Most C compilers are rather lax in enforcing the restriction
-that only one external definition without the keyword
-\fIextern\fP is allowed in a program.
-The Ack-C frontend is very strict in this.
-The only exception is that declarations of arrays with a
-missing first array bounds expression are regarded to have an
-explicit keyword \fIextern\fP.
-.IT "14.4 Explicit pointer conversions"
-Pointers may be larger the ints, thus assigning a pointer to an
-int and back will not always result in the same pointer.
-The process mentioned above works with integrals
-of the same size or larger as pointers in all EM implementations
-having such integrals.
-Note that pointers to functions have
-twice the size of pointers to data.
-When converting data pointers to an integral type or vice-versa,
-the pointers is seen as an unsigned with the same size a data-pointer.
-When converting function pointers to anything else the static link part
-of the pointer is discarded,
-the resulting value is treated as if it were a data pointer.
-When converting a data pointer or object of integral type to a function pointer
-a static link with the value 0 is added to complete the function pointer.
-.br
-EM guarantees that any object can be placed at a word boundary,
-this allows the C-programs to use \fIint\fP pointers
-as pointers to objects of any type not smaller than an \fIint\fP.
-.CH "Frontend options"
-The C-frontend has a few options, these are controlled
-by flags:
-.IS
-.PT -V
-This flag is followed by a sequence of letters each followed by
-positive integers. Each letter indicates a
-certain type, the integer following it specifies the size of
-objects of that type. One letter indicates the wordsize used.
-.IS
-.sp 1
-.TS
-center tab(:);
-l l16 l l.
-letter:type:letter:type
-
-w:wordsize:i:int
-s:short:l:long
-f:float:d:double
-p:pointer::
-.TE
-.sp 1
-All existing implementations use an integer size equal to the
-wordsize.
-.IE
-The calling program \fIack\fP[4] provides the frontend with
-this flag, with values depending on the machine used.
-.sp 1
-.PT -l
-The frontend normally generates code to keep track of the line
-number and source file name at runtime for debugging purposes.
-Currently a pointer to a
-string containing the filename is stored at a fixed place in
-memory at each function
-entry and the line number at the start of every expression.
-At the return from a function these memory locations are not reset to
-the values they had before the call.
-Most library routines do not use this feature and thus do not
-ruin the current line number and filename when called.
-However, you are really unlucky when your program crashes due
-to a bug in such a library function, because the line number
-and filename do not indicate that something went wrong inside
-the library function.
-.br
-Providing the flag -l to the frontend tells it not to generate
-the code updating line number and file name.
-This is, for example, used when translating the stdio library.
-.br
-When the \fIack\fP[4] is called with the -L flag it provides
-the frontend with this flag.
-.sp 1
-.PT -Xp
-When this flag is present the frontend generates a call to
-the function \fBprocentry\fP at each function entry and a
-call to \fBprocexit\fP at each function exit.
-Both functions are provided with one parameter,
-a pointer to a string containing the function name.
-.br
-When \fIack\fP is called with the -p flag it provides the
-frontend with this flag.
-.IE
-.CH References
-.IS
-.PT [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson \fIDescription of a machine architecture for use with
-block structured languages\fP Informatica report IR-81.
-.sp 1
-.PT [2]
-B.W. Kernighan and D.M. Ritchie, \fIThe C Programming
-language\fP, Prentice-Hall, 1978
-.PT [3]
-D.M. Ritchie, \fIC Reference Manual\fP
-.sp
-.PT [4]
-UNIX manual ack(I).
+++ /dev/null
-head: doc.pr
-
-NROFF=nroff
-FILES = macr.nr title.nr intro.nr mem.nr ispace.nr dspace.nr mapping.nr types.nr descr.nr iotrap.nr mach.nr assem.nr app.nr
-IOP=../../util/ass/ip_spec.t
-
-doc.pr: $(FILES) itables em.i
- tbl $(FILES) | $(NROFF) >doc.pr
-
-opr: doc.pr
- make pr | opr
-
-pr:
- @make "NROFF="$NROFF doc.pr >makepr.out 2>&1
- @cat doc.pr
-
-app.t: itables em.i
-
-em.i: int/em.p
- @echo Sorry, this copy was edited by hand from int/em.p
-
-itables: $(IOP)
- awk -f ip.awk $(IOP) | tbl >itables
-
-.SUFFIXES : .pr .nr
-.nr.pr: ; tbl macr.nr $*.nr | $(NROFF) >$@
-
-cont.t intro.t mem.t ispace.t dspace.t mapping.t succ.t descr.t iotrap.t mach.t assem.t kern.t app.t: macr.nr
+++ /dev/null
-Sorry, the kun macro package is not ours to distribute.
+++ /dev/null
-.lg 0
-.ta 8 16 24 32 40 48 56 64 72 80
-.hw iden-ti-fi-er
-.nr a 0 1
-.nr f 1 1
-.de x1
-'sp 2
-'tl '''%'
-'sp 2
-.ns
-..
-.wh 0 x1
-.de fo
-'bp
-..
-.wh 60 fo
-.ll 79
-.lt 79
-.de HT
-.ti -4
-..
-.de PP
-.sp
-.ne 2
-.ti +5
-..
-.de SE
-.bp
-\fB\\n+a. \\$1\fR
-.nr b 0 1
-..
-.de SB
-.br
-.ne 10
-.sp 5
-\fB\\na.\\n+b. \\$1\fR
-..
-.de DC
-.ti -14
-DECISION~\\$1:
-..
-.de IN
-.in +6
-..
-.de OU
-.in -6
-..
-.tr ~
-.sp 5
-.rs
-.sp 10
-.ce 3
-Changes in EM-1
-
-Addendum to Informatica Rapport IR-54
-.sp 5
-.PP
-This document describes a revision of EM-1.
-A list of differences is presented roughly in the order IR-54
-describes the original architecture.
-A complete list of EM-1 pseudo's and instructions is also included.
-.SE Introduction
-.PP
-EM is a family of intermediate languages, resembling assembly
-language for a stack machine.
-EM defines the layout of data memory and a partitioning
-of instruction memory.
-EM has can do operations on five basic types:
-pointers, signed integers, unsigned integers, floating point numbers
-and sets of bits.
-The size of pointers is fixed in each member,
-in contrast to the sizes of the other types.
-Each member has one more fixed size: the word size.
-This is the mimimum size of any object on the stack.
-The sizes of all objects on the stack are assumed to
-multiples of the word size.
-We assume that pointer and word-sizes are both powers of two.
-.PP
-It is possible to load objects smaller then the word size from memory.
-These objects are converted to objects of the word size by
-clearing the most significant bytes.
-(A separate conversion instruction can do sign extension).
-While storing objects smaller then the word size are stored in memory,
-the most significant bytes are ignored.
-The size of such objects has to be a divisor of the word size.
-.PP
-Put in other terms, instructions such as LOC, LOL, LOE, STF, etc.
-manipulate WORDS. Up until now, a word was defined as 16 bits.
-It is now possible to define a word size other than 16 bits. For
-example, MES 2,1,2 defines a word to be 8 bits and a pointer to be
-16 bits. As another example, MES 2,4,4 defines a word to be 32 bits
-and a pointer to be 32 bits.
-.PP
-If a compiler receives flags telling it to use 32 bit integers, it now
-has a choice of setting the word length to 16 bits and using LDL etc
-for dealing with integers, or setting the word length to 32 bits and using
-\1fLOL etc for integers.
-For example, x:=a+b for 32-bit integers would become:
-
- MES 2,2,4 MES 2,4,4
- LDL a LOL a
- LDL b LOL b
- ADI 4 ADI 4
- SDL x STL x
-
-In many cases, the target machine code that is finally produced from either
-of the above sequences will not show any traces of the stack machine, however
-for some instructions actual pushes and pops at run time will be necessary.
-Choosing a wider EM word will usually produce fewer stack operations than
-a narrower word, but it eliminates the possibility of doing arithmetic on
-quantities smaller than a word. If, for example, a compiler chooses a 32-bit
-EM word, it will be difficult to add two 16 bit integers with ADI, since
-the argument must be multiple of the word size.
-(The operation can be done by converting the operands to 32 bits using CII,
-adding the 32-bit numbers, and reconverting the result.)
-On the other hand, choosing a 16-bit EM word makes it possible to do both
-16-bit adds (ADI 2) and 32-bit adds (ADI 4),
-but the price paid is that 32-bit operations will be viewed as double
-precision, and may be slightly less efficient on target machines with a
-32-bit word, i.e. the EM to target translator may not take full advantage
-of the 32 bit facilities.
-.PP
-Note that since LOC pushes a WORD on the stack, the argument of LOC
-must fit ina word. LOC 256 on an EM machine with a 1-byte word length
-is not allowed. LDC 256 is allowed, however.
-.PP
-A general rule of thumb is that the compiler should choose an EM word
-length equal to the width of a single precision integer.
-Obviously, compilers should be well parameterized to allow the integer
-size(s) and word size(s) to be changed by just changing a few constants.
-.PP
-The size of a instruction space pointer in is the same
-as the size of a data space pointer.
-.PP
-EM assumes two's complement arithmetic on signed integers,
-but does not define an ordering of the bytes in a integer.
-The lowest numbered byte of a two-byte object can contain
-either the most or the least significant part.
-.SE Memory
-.PP
-EM has two separate addressing spaces, instruction and data.
-The sizes of these spaces are not specified.
-The layout of instruction space in not defined.
-Any interpreter or translator may assume a layout fitting his/her needs.
-The layout of data memory is specified by EM.
-EM data memory consists of a sequence of 8-bit bytes each separately
-addressable.
-Certain alignment restrictions exist for object consisting of multiple bytes.
-Objects smaller then the word size can only be addressed
-at multiples of the object size.
-For example: in a member with a four-byte word size, two-byte integers
-can only be accessed from even addresses.
-Objects larger then the word size can only be placed at multiples
-of the word size.
-For example: in a member with a four-byte word size,
-eight-byte floating point numbers can be fetched at addresses
-0, 4, 8, 12, etc.
-.SB "Procedure identifiers"
-.PP
-Procedure identifiers in EM have the same size
-as pointers.
-Any implementation of EM is free to use any method of identifying procedures.
-Common methods are indices into tables containing further information
-and addresses of the first instructions of procedures.
-.SB "Heap and Stack in global data"
-.PP
-The stack grows downward, the heap grows upward.
-The stack pointer points to the lowest occupied word on the stack.
-The heap pointer marks the first free word in the heap area.
-.br
-.ne 39
-.sp 1
-.nf
- 65534 -> |-------------------------------|
- |///////////////////////////////|
- |//// unimplemented memory /////|
- |///////////////////////////////|
- SB -> |-------------------------------|
- | |
- | stack and local area | <- LB
- | |
- | |
- |-------------------------------| <- SP
- |///////////////////////////////|
- |// implementation dependent //|
- |///////////////////////////////|
- |-------------------------------| <- HP
- | |
- | heap area |
- | |
- | |
- |-------------------------------|
- | |
- | global area |
- | |
- EB -> |-------------------------------|
- | |
- | |
- | program text | <- PC
- | |
- | |
- PB -> |-------------------------------|
- |///////////////////////////////|
- |////////// undefined //////////|
- |///////////////////////////////|
- 0 -> |-------------------------------|
-
- Fig. \nf. Example of memory layout showing typical register
- positions during execution of an EM program.
-.fi
-.SB "Data addresses as arguments"
-.PP
-Anywhere previous versions of the EM assembly language
-allowed identifiers of objects in
-data space,
-it is also possible to use 'identifier+constant' or 'identifier-constant'.
-For example, both "CON LABEL+4" and "LAE SAVED+3" are allowed.
-More complicated expressions are illegal.
-.SB "Local data area"
-.PP
-The mark block has been banished.
-When calling a procedure,
-the calling routine first has to push the actual parameters.
-All language implementations currently push their arguments
-in reverse order, to be compatible with C.
-Then the procedure is called using a CAL or CAI instruction.
-Either the call or the procedure prolog somehow has to save
-the return address and dynamic link.
-The prolog allocates the space needed for locals and is free to
-surround this space with saved registers and other information it
-deems necessary.
-.PP
-The locals are now accessed using negative offsets in LOL, LDL, SDL, LAL,
-LIL, SIL and STL instructions.
-The parameters are accessed using positive offsets in LOL, LDL, SDL, LAL,
-LIL, STL and
-STL instructions.
-The prolog might have stored information in the area between parameters and
-locals.
-As a consequence there are two bases, AB(virtual) and LB.
-AB stands for Argument Base and LB stands for Local Base.
-Positive arguments to LOL etc ... are interpreted as offsets from AB,
-negative arguments as offsets from LB.
-.PP
-The BEG instruction is not needed to allocate the locals because
-storage for locals is set aside in the prolog.
-The instruction still exists under the name ASP (Adjust Stack Pointer).
-.PP
-Procedures return using the RET instruction.
-The RET pops the function result from the stack and
-brings the stack pointer and other relevant registers to the state
-they had just before the procedure was called.
-The RET instruction expects that - aside from possible function results -
-the stack pointer has the value it had after execution of the prolog.
-RET finally returns control to the calling routine.
-The actual parameters have to be removed from the stack by the calling routine,
-and not by the called procedure.
-.sp 1
-.ne 38
-.nf
-
-
-
- |===============================|
- | actual argument n |
- |-------------------------------|
- | . |
- | . |
- | . |
- |-------------------------------|
- | actual argument 1 | ( <- AB )
- |===============================|
- |///////////////////////////////|
- |// implementation dependent //|
- |///////////////////////////////| <- LB
- |===============================|
- | |
- | local variables |
- | |
- |-------------------------------|
- | |
- | compiler temporaries |
- | |
- |===============================|
- |///////////////////////////////|
- |// implementation dependent //|
- |///////////////////////////////|
- |===============================|
- | |
- | dynamic local generators |
- | |
- |===============================|
- | operand |
- |-------------------------------|
- | operand | <- SP
- |===============================|
-
- A sample procedure frame.
-
-.fi
-.sp 1
-This scheme allows procedures to be called with a variable number
-of parameters.
-The parameters have to be pushed in reverse order,
-because the called procedure has to be able to locate the first one.
-.PP
-.PP
-Since the mark block has disappeared, a new mechanism for static
-links had to be created.
-All compilers use the convention that EM procedures needing
-a static link will find a link in their zero'th parameter,
-i.e. the last one pushed on the stack.
-This parameter should be invisible to users of the compiler.
-The link needs to be in a fixed place because the lexical instructions
-have to locate it.
-The LEX instruction is replaced by two instructions: LXL and LXA.
-\&"LXL~n" finds the LB of a procedure n static levels removed.
-\&"LXA~n" finds the (virtual) AB.
-The value used for static link is LB.
-.PP
-When a procedure needing a static link is called, first the actual
-parameters are pushed, then the static link is pushed using LXL
-and finally the procedure is called with a CAL with the procedure's
-name as argument.
-.br
-.ne 40
-.nf
-
-
-
- |===============================|
- | actual argument n |
- |-------------------------------|
- | . |
- | . |
- | . |
- |-------------------------------|
- | actual argument 1 |
- |-------------------------------|
- | static link | ( <- AB )
- |===============================|
- |///////////////////////////////|
- |// implementation dependent //|
- |///////////////////////////////| <- LB
- |===============================|
- | |
- | local variables |
- | |
- |-------------------------------|
- | |
- | compiler temporaries |
- | |
- |===============================|
- |///////////////////////////////|
- |// implementation dependent //|
- |///////////////////////////////|
- |===============================|
- | |
- | dynamic local generators |
- | |
- |===============================|
- | operand |
- |-------------------------------|
- | operand | <- SP
- |===============================|
-
- A procedure frame with static link.
-
-.fi
-.sp 1
-.sp 1
-.PP
-Pascal and other languages have to use procedure
-instance identifiers containing
-the procedure identifier
-'ul
-and
-the static link the procedure has to be called with.
-A static link having a value of zero signals
-that the called procedure does not need a static link.
-C uses the same convention for pointers to C-routines.
-In pointers to C-routines the static link is set to zero.
-.PP
-Note: The distance from LB to AB must be known for each procedure, otherwise
-LXA can not be implemented.
-Most implementations will have a fixed size area between
-the parameter and local storage.
-The zone between the compiler temporaries and the dynamic
-local generators can be used
-to save a variable number of registers.
-.PP
-.ne 11
-Prolog examples:
-.sp 2
-.nf
-
- proc1 proc2
-
- mov lb,-(sp) mov lb,-(sp)
- mov sp,lb mov sp,lb
- sub $loc_size,sp sub $loc_size,sp
- mov r2,-(sp) ; save r2 mov r2,-(sp)
- mov r4,-(sp) ; save r4
-
-.fi
-.SB "Return values"
-.PP
-The return value popped by RET is stored in an unnamed 'function return area'.
-This area can be different for different sized objects returned,
-e.g. one register for two byte objects,
-two registers for four byte objects,
-memory for larger objects.
-The area is available for 'READ-ONCE' access using the LFR instruction.
-The result of a LFR is only defined if the sizes used to store and
-fetch are identical.
-The only instructions guaranteed not to destroy the contents of
-any 'function return area' are ASP and BRA.
-Thus parameters can be popped before fetching the function result.
-The maximum size of all function return areas is
-implementation dependant,
-but allows procedure instance identifiers and all
-implemented objects of type integer, unsigned, float
-and pointer to be returned.
-
-.SE "EM Assembly Language"
-.nr b 0 1
-.SB "Object types and instructions"
-.PP
-EM knows five basic object types:
-pointers,
-signed integers,
-unsigned integers,
-floating point numbers and
-sets of bits.
-Operations on objects of the last four types do not assume
-a specific size.
-Pointers (including procedure identifiers) have a fixed size in each
-implementation.
-Instructions acting on one or more objects of the last four types need
-explicit size information.
-This information can be given either as the argument of the
-instruction or on top of the stack.
-.sp 1
-For example:
-.nf
-addition of integers LOL a, LOL b, ADI 2
-subtraction of two floats LDL a, LDL b, SBF 4
-integer to float LOL a, LOC 2, LOC 4, CIF, SDL b
-.fi
-.sp
-Note that conversion instructions always expect size
-before and size after conversion on the stack.
-.sp
-No obligation exists to implement all operations on all possible sizes.
-.PP
-The EM assembly language
-allows constants as instruction arguments up to a size of four bytes.
-In all EM's it is possible to initialize any type and size object.
-BSS, HOL, CON and ROM allow type and size indication in initializers.
-.SB "Conversion instructions"
-.PP
-The conversion operators can convert from any type and size to any
-type and size.
-The types are specified by the instruction,
-the sizes should be in words on top of the stack.
-Normally the sizes are multiples of the word size,
-There is one exception: the CII instructions sign-extends if the
-size of the source is a divisor of the word size.
-.SB "CSA and CSB"
-.PP
-The tables used by these instructions do not contain the procedure
-identifier any more.
-See also "Descriptors".
-.SB EXG
-.PP
-The EXG instruction is deleted from the EM instruction set.
-If future applications show any need for this instruction,
-it will be added again.
-.SB "FIL"
-.PP
-A FIL instruction has been introduced.
-When using separate compilation,
-the LIN feature of EM was insufficient.
-FIL expects as argument an address in global data.
-This address is stored in a fixed place in memory,
-where it can be used by any implementation for diagnostics etc.
-Like LIN, it provides access to the ABS fragment at the start
-of external data.
-.SB "LAI and SAI"
-.PP
-LAI and SAI have been dropped, they thwarted register optimization.
-.SB LNC
-.PP
-The LNC instruction is deleted from the instruction set.
-LOC -n wil do what it is supposed to.
-.SB "Branch instructions"
-.PP
-The branch instructions are allowed to branch both forward and backward.
-Consequently BRF and BRB are deleted and a BRA instruction is added.
-BRA branches unconditionally in any direction.
-.SB LDC
-.PP
-Loads a double word constant on the stack.
-.SB LEX
-.PP
-LXA and LXL replace LEX.
-.SB LFR
-.PP
-LFR loads the function result stored by RET.
-.SB "LIL and SIL"
-.PP
-They replace LOP and STP. (Name change only)
-.SB "Traps and Interrupts"
-.PP
-The numbers used for distinguishing the various types
-of traps and interrupts have been reassigned.
-The new instructions LIM and SIM
-allow setting and clearing of bits in a mask.
-The bits in the mask control the action taken upon encountering certain
-errors at runtime.
-A 1 bit causes the corresponding error to be ignored,
-a 0 bit causes the run-time system to trap.
-.SB LPI
-.PP
-Loads a procedure identifier on the stack.
-LOC cannot be used to do this anymore.
-.SB "ZER and ZRF"
-.PP
-ZER loads S zero bytes on the stack.
-ZRF loads a floating point zero of size S.
-.SB "Descriptors"
-.PP
-All instructions using descriptors have the size of the integer used
-in the descriptor as argument.
-The descriptors are: case descriptors (CSA and CSB),
-range check descriptors (RCK) and
-array descriptors ( LAR, SAR, AAR).
-.SB "Case descriptors"
-.PP
-The value used in a case descriptor to indicate the absence of a label
-is zero instead of -1.
-.SE "EM assembly language"
-.SB "Instruction arguments"
-.PP
-The previous EM had different instructions for distinguishing
-between operand on the stack and explicit argument in the instruction.
-For example, LOI and LOS.
-This distinction has been removed.
-Several instructions have two possible forms:
-with explicit argument and with implicit argument on top of the stack.
-The size of the implicit argument is the word size.
-The implicit argument is always popped before all other operands.
-Appendix 1 shows what is allowed for each instruction.
-.SB Notation
-.PP
-First the notation used for the arguments of
-instructions and pseudo instructions.
-.in +12
-.ti -11
-<num>~~=~~an integer number in the range -32768..32767
-.ti -11
-<off>~~=~~an offset -2**31..2**31~-~1
-.ti -11
-<sym>~~=~~an identifier
-.ti -11
-<arg>~~=~~<off> or <sym> or <sym>+<off> or <sym>-<off>
-.ti -11
-<con>~~=~~integer constant,
-unsigned constant,
-floating point constant
-.ti -11
-<str>~~=~~string constant (surrounded by double quotes),
-.ti -11
-<lab>~~=~~instruction label ('*' followed by an integer in the range
-0..32767).
-.ti -11
-<pro>~~=~~procedure number ('$' followed by a procedure name)
-.ti -11
-<val>~~=~~<arg>,
-<con>,
-<pro> or
-<lab>.
-.ti -11
-<...>*~=~~zero or more of <...>
-.ti -11
-<...>+~=~~one or more of <...>
-.ti -11
-[...]~~=~~optional ...
-.in -12
-.SB Labels
-.PP
-No label, instruction or data, can have a (pseudo) instruction
-on the same line.
-.SB Constants
-.PP
-All constants in EM are interpreted in the decimal base.
-.PP
-In BSS, HOL, CON and ROM pseudo-instructions
-numbers must be followed by I, U or F
-indicating Integer, Unsigned or Float.
-If no character is present I is assumed.
-This character can be followed by an even positive number or a 1.
-The number indicates the size in bytes of the object to be initialized,
-up to 32766.
-Double precision integers can no longer be indicated by a trailing L.
-As said before CON and ROM also allow expressions of the form:
-\&"LABEL+offset" and "LABEL-offset".
-The offset must be an unsigned decimal number.
-The 'IUF' indicators cannot be used with the offsets.
-.PP
-Areas reserved in the global data area by HOL or BSS can be
-initialized.
-BSS and HOL have a third parameter indicating whether the initialization
-is mandatory or optional.
-.PP
-Since EM needs aligment of objects, this alignment is enforced by the
-pseudo instructions.
-All objects are aligned on a multiple of their size or the word size
-whichever is smaller.
-Switching to another type of fragment or placing a label forces word-alignment.
-There are three types of fragments in global data space: CON, ROM and BSS-HOL.
-.sp
-.SB "Pseudo instructions"
-.PP
-The LET, IMC and FWC pseudo's have disappeared.
-The only application of these pseudo's was in postponing the
-specification of the size of the local storage to just before
-the END of the procedure.
-A new mechanism has been introduced to handle this problem.
-.ti +5
-The pseudos involved in separate compilation and linking have
-been reorganized.
-.ti +5
-PRO and END are altered and reflect the new calling sequence.
-EOF has disappeared.
-.ti +5
-BSS and HOL allow initialization of the requested data areas.
-.sp 2
-Four pseudo instructions request global data:
-.sp 2
- BSS <off>,<val>,<num>
-.IN
-Reserve <off> bytes.
-<val> is the value used to initialize the area.
-<off> must be a multiple of the size of <val>.
-<num> is 0 if the initialization is not strictly necessary,
-1 otherwise.
-.OU
-.sp
- HOL <off>,<val>,<num>
-.IN
-Idem, but all following absolute global data references will
-refer to this block.
-Only one HOL is allowed per procedure,
-it has to be placed before the first instruction.
-.OU
-.sp
- CON <val>+
-.IN
-Assemble global data words initialized with the <val> constants.
-.OU
-.sp
- ROM <val>+
-.IN
-Idem, but the initialized data will never be changed by the program.
-.OU
-.sp 2
-Two pseudo instructions partition the input into procedures:
-.sp 2
- PRO <sym>[,<off>]
-.IN
-Start of procedure.
-<sym> is the procedure name.
-<off> is the number of bytes for locals.
-The number of bytes for locals must be specified in the PRO or
-END pseudo-instruction.
-When specified in both, they must be identical.
-.OU
-.sp
- END [<off>]
-.IN
-End of Procedure.
-<off> is the number of bytes for locals.
-The number of bytes for locals must be specified in either the PRO or
-END pseudo-instruction or both.
-.OU
-.PP
-Names of data and procedures in a EM module can either be
-internal or external.
-External names are known outside the module and are used to link
-several pieces of a program.
-Internal names are not known outside the modules they are used in.
-Other modules will not 'see' an internal name.
-.ti +5
-In order to reduce the number of passes needed,
-it must be known at the first occurrence whether
-a name is internal or external.
-If the first occurrence of a name is in a definition,
-the name is considered to be internal.
-If the first occurrence of a name is a reference,
-the name is considered to be external.
-If the first occurrence is in one of the following pseudo instructions,
-the effect of the pseudo has precedence.
-.sp 2
- EXA <sym>
-.IN
-External name.
-<sym> is external to this module.
-Note that <sym> may be defined in the same module.
-.OU
-.sp
- EXP <pro>
-.IN
-External procedure identifier.
-Note that <sym> may be defined in the same module.
-.OU
-.sp
- INA <sym>
-.IN
-Internal name.
-<sym> is internal to this module and must be defined in this module.
-.OU
-.sp
- INP <pro>
-.IN
-Internal procedure.
-<sym> is internal to this module and must be defined in this module.
-.OU
-.sp 2
-Two other pseudo instructions provide miscellaneous features:
-.sp 2
- EXC <num1>,<num2>
-.IN
-Two blocks of instructions preceding this one are
-interchanged before being processed.
-<num1> gives the number of lines of the first block.
-<num2> gives the number of lines of the second one.
-Blank and pure comment lines do not count.
-.OU
-.sp
- MES <num>,<val>*
-.IN
-A special type of comment. Used by compilers to communicate with the
-optimizer, assembler, etc. as follows:
-.br
- MES 0 -
-.IN
-An error has occurred, stop further processing.
-.OU
-.br
- MES 1 -
-.IN
-Suppress optimization
-.OU
-.br
- MES 2,<num1>,<num2>
-.IN
-Use word-size <num1> and pointer size <num2>.
-.OU
-.br
- MES 3,<off>,<num1>,<num2> -
-.IN
-Indicates that a local variable is never referenced indirectly.
-<off> is offset in bytes from LB if positive
-and offset from AB if negative.
-<num1> gives the size of the variable.
-<num2> indicates the class of the variable.
-.OU
-.br
- MES 4,<num>,<str>
-.IN
-Number of source lines in file <str> (for profiler).
-.OU
-.br
- MES 5 -
-.IN
-Floating point used.
-.OU
-.br
- MES 6,<val>* -
-.IN
-Comment. Used to provide comments in compact assembly language (see below).
-.OU
-.sp 1
-Each back end is free to skip irrelevant MES pseudos.
-.OU
-.SB "The Compact Assembly Language"
-.PP
-The assembler accepts input in a highly encoded form. This
-form is intended to reduce the amount of file transport between the compiler
-and assembler, and also reduce the amount of storage required for storing
-libraries.
-Libraries are stored as archived compact assembly language, not machine language.
-.PP
-When beginning to read the input, the assembler is in neutral state, and
-expects either a label or an instruction (including the pseudoinstructions).
-The meaning of the next byte(s) when in neutral state is as follows, where b1, b2
-etc. represent the succeeding bytes.
-.sp
- 0 Reserved for future use
- 1-129 Machine instructions, see Appendix 2, alphabetical list
- 130-149 Reserved for future use
- 150-161 BSS,CON,END,EXC,EXA,EXP,HOL,INA,INP,MES,PRO,ROM
- 162-179 Reserved for future pseudoinstructions
- 180-239 Instruction labels 0 - 59 (180 is local label 0 etc.)
- 240-244 See the Common Table below
- 245-255 Not used
-
-After a label, the assembler is back in neutral state; it can immediately
-accept another label or an instruction in the very next byte. There are
-no linefeeds used to separate lines.
-.PP
-If an opcode expects no arguments,
-the assembler is back in neutral state after
-reading the one byte containing the instruction number. If it has one or
-more arguments (only pseudos have more than 1), the arguments follow directly,
-encoded as follows:
-.sp
- 0-239 Offsets from -120 to 119
-.br
- 240-255 See the Common Table below
-.sp 2
-If an opcode has one optional argument,
-a special byte is used to announce that the argument is not present.
-.ce 1
-Common Table for Neutral State and Arguments
-.sp
-.nf
-<lab> 240 b1 Instruction label b1 (Not used for branches)
-<lab> 241 b1 b2 16 bit instruction label (256*b2 + b1)
-<sym> 242 b1 Global label .0-.255, with b1 being the label
-<sym> 243 b1 b2 Global label .0-.32767
- with 256*b2+b1 being the label
-<sym> 244 <string> Global symbol not of the form .nnn
-. \" Only the previous can occur in neutral state.
-<num> 245 b1 b2 (16 bit constant) 256*b2+b1
-<off> 246 b1 b2 b3 b4 (32 bit constant) (256*(256*(256*b4)+b3)+b2)+b1
-<arg> 247 <sym><off> Global label + (possibly negative) constant
-<pro> 248 <string> Procedure name (not including $)
-<str> 249 <string> String used in CON or ROM (no quotes)
-<con> 250 <num><string> Integer constant, size <num> bytes
-<con> 251 <num><string> Unsigned constant, size <num> bytes
-<con> 252 <num><string> Floating constant, size <num> bytes
-<end> 255 Delimiter for argument lists or
- indicates absence of optional argument
-
-.fi
-.PP
-The notation <string> consists first of a length field, and then an
-arbitrary string of bytes.
-The length is specified by a <num>.
-.PP
-.ne 8
-The pseudoinstructions fall into several categories, depending on their
-arguments:
-.sp
- Group 1 -- EXC, BSS, HOL have a known number of arguments
- Group 2 -- EXA, EXP, INA, INP start with a string
- Group 3 -- CON, MES, ROM have a variable number of various things
- Group 4 -- END, PRO have a trailing optional argument.
-
-Groups 1 and 2
-use the encoding described above.
-Group 3 also uses the encoding listed above, with a <end> byte after the
-last argument to indicate the end of the list.
-Group 4 uses
-a <end> byte if the trailing argument is not present.
-
-.ad
-.fi
-.sp 2
-.ne 12
-.nf
-Example ASCII Example compact
-(LOC = 66, BRA = 18 here):
-
- 2 182
- 1 181
- LOC 10 66 130
- LOC -10 66 110
- LOC 300 66 245 44 1
- BRA 19 18 139
- 300 241 44 1
- .3 242 3
- CON 4,9,*2,$foo 151 124 130 240 2 248 3 102 111 111 255
- LOC .35 66 242 35
-.fi
-.nr a 0 1
-.SE "ASSEMBLY LANGUAGE INSTRUCTION LIST"
-.PP
-For each instruction in the list the range of operand values
-in the assembly language is given.
-All constants, offsets and sizes are in the range -2**31~..~2**31-1.
-The column headed \fIassem\fP contains the mnemonics defined
-in 4.1.
-The following column indicates restrictions in the range of the operand.
-Addresses have to obey the restrictions mentioned in chapter 2 - Memory -.
-The size parameter of most instructions has to be a multiple
-of the word size.
-The classes of operands
-are indicated by letters:
-.ds b \fBb\fP
-.ds c \fBc\fP
-.ds d \fBd\fP
-.ds g \fBg\fP
-.ds f \fBf\fP
-.ds l \fBl\fP
-.ds n \fBn\fP
-.ds i \fBi\fP
-.ds p \fBp\fP
-.ds r \fBr\fP
-.ds s \fBs\fP
-.ds z \fBz\fP
-.ds - \fB-\fP
-.nf
-
- \fIassem\fP constraints rationale
-
-\&\*c off 1-word constant
-\&\*d off 2-word constant
-\&\*l off local offset
-\&\*g arg >= 0 global offset
-\&\*f off fragment offset
-\&\*n num >= 0 counter
-\&\*s off > 0 object size
-\&\*z off >= 0 object size
-\&\*i off > 0 object size *
-\&\*p pro pro identifier
-\&\*b lab >= 0 label number
-\&\*r num 0,1,2 register number
-\&\*- no operand
-
-.fi
-.PP
-The * at the rationale for \*i indicates that the operand
-can either be given as argument or on top of the stack.
-If the operand has to be fetched from the stack,
-it is assumed to be a word-sized unsigned integer.
-.PP
-Instructions that check for undefined operands and underflow or overflow
-are indicated by (*).
-.nf
-
-GROUP 1 - LOAD
-
- LOC \*c : Load constant (i.e. push one word onto the stack)
- LDC \*d : Load double constant ( push two words )
- LOL \*l : Load word at \*l-th local (l<0) or parameter (l>=0)
- LOE \*g : Load external word \*g
- LIL \*l : Load word pointed to by \*l-th local or parameter
- LOF \*f : Load offsetted. (top of stack + \*f yield address)
- LAL \*l : Load address of local or parameter
- LAE \*g : Load address of external
- LXL \*n : Load lexical. (address of LB \*n static levels back)
- LXA \*n : Load lexical. (address of AB \*n static levels back)
- LOI \*s : Load indirect \*s bytes (address is popped from the stack)
- LOS \*i : Load indirect. \*i-byte integer on top of stack gives object size
- LDL \*l : Load double local or parameter (two consecutive words are stacked)
- LDE \*g : Load double external (two consecutive externals are stacked)
- LDF \*f : Load double offsetted (top of stack + \*f yield address)
- LPI \*p : Load procedure identifier
-
-GROUP 2 - STORE
-
- STL \*l : Store local or parameter
- STE \*g : Store external
- SIL \*l : Store into word pointed to by \*l-th local or parameter
- STF \*f : Store offsetted
- STI \*s : Store indirect \*s bytes (pop address, then data)
- STS \*i : Store indirect. \*i-byte integer on top of stack gives object size
- SDL \*l : Store double local or parameter
- SDE \*g : Store double external
- SDF \*f : Store double offsetted
-
-GROUP 3 - INTEGER ARITHMETIC
-
- ADI \*i : Addition (*)
- SBI \*i : Subtraction (*)
- MLI \*i : Multiplication (*)
- DVI \*i : Division (*)
- RMI \*i : Remainder (*)
- NGI \*i : Negate (two's complement) (*)
- SLI \*i : Shift left (*)
- SRI \*i : Shift right (*)
-
-GROUP 4 - UNSIGNED ARITHMETIC
-
- ADU \*i : Addition
- SBU \*i : Subtraction
- MLU \*i : Multiplication
- DVU \*i : Division
- RMU \*i : Remainder
- SLU \*i : Shift left
- SRU \*i : Shift right
-
-GROUP 5 - FLOATING POINT ARITHMETIC (Format not defined)
-
- ADF \*i : Floating add (*)
- SBF \*i : Floating subtract (*)
- MLF \*i : Floating multiply (*)
- DVF \*i : Floating divide (*)
- NGF \*i : Floating negate (*)
- FIF \*i : Floating multiply and split integer and fraction part (*)
- FEF \*i : Split floating number in exponent and fraction part (*)
-
-GROUP 6 - POINTER ARITHMETIC
-
- ADP \*f : Add \*c to pointer on top of stack
- ADS \*i : Add \*i-byte value and pointer
- SBS \*i : Subtract pointers in same fragment and push diff as size \*i integer
-
-GROUP 7 - INCREMENT/DECREMENT/ZERO
-
- INC \*- : Increment top of stack by 1 (*)
- INL \*l : Increment local or parameter (*)
- INE \*g : Increment external (*)
- DEC \*- : Decrement top of stack by 1 (*)
- DEL \*l : Decrement local or parameter (*)
- DEE \*g : Decrement external (*)
- ZRL \*l : Zero local or parameter
- ZRE \*g : Zero external
- ZRF \*i : Load a floating zero of size \*i
- ZER \*i : Load \*i zero bytes
-
-GROUP 8 - CONVERT ( stack: source, source size, dest. size (top) )
-
- CII \*- : Convert integer to integer (*)
- CUI \*- : Convert unsigned to integer (*)
- CFI \*- : Convert floating to integer (*)
- CIF \*- : Convert integer to floating (*)
- CUF \*- : Convert unsigned to floating (*)
- CFF \*- : Convert floating to floating (*)
- CIU \*- : Convert integer to unsigned
- CUU \*- : Convert unsigned to unsigned
- CFU \*- : Convert floating to unsigned
-
-GROUP 9 - LOGICAL
-
- AND \*i : Boolean and on two groups of \*i bytes
- IOR \*i : Boolean inclusive or on two groups of \*i bytes
- XOR \*i : Boolean exclusive or on two groups of \*i bytes
- COM \*i : Complement (one's complement of top \*i bytes)
- ROL \*i : Rotate left a group of \*i bytes
- ROR \*i : Rotate right a group of \*i bytes
-
-GROUP 10 - SETS
-
- INN \*i : Bit test on \*i byte set (bit number on top of stack)
- SET \*i : Create singleton \*i byte set with bit n on (n is top of stack)
-
-GROUP 11 - ARRAY
-
- LAR \*i : Load array element, descriptor contains integers of size \*i
- SAR \*i : Store array element
- AAR \*i : Load address of array element
-
-GROUP 12 - COMPARE
-
- CMI \*i : Compare \*i byte integers. Push negative, zero, positive for <, = or >
- CMF \*i : Compare \*i byte reals
- CMU \*i : Compare \*i byte unsigneds
- CMS \*i : Compare \*i byte sets. can only be used for equality test.
- CMP \*- : Compare pointers
-
- TLT \*- : True if less, i.e. iff top of stack < 0
- TLE \*- : True if less or equal, i.e. iff top of stack <= 0
- TEQ \*- : True if equal, i.e. iff top of stack = 0
- TNE \*- : True if not equal, i.e. iff top of stack non zero
- TGE \*- : True if greater or equal, i.e. iff top of stack >= 0
- TGT \*- : True if greater, i.e. iff top of stack > 0
-
-GROUP 13 - BRANCH
-
- BRA \*b : Branch unconditionally to label \*b
-
- BLT \*b : Branch less (pop 2 words, branch if top > second)
- BLE \*b : Branch less or equal
- BEQ \*b : Branch equal
- BNE \*b : Branch not equal
- BGE \*b : Branch greater or equal
- BGT \*b : Branch greater
-
- ZLT \*b : Branch less than zero (pop 1 word, branch negative)
- ZLE \*b : Branch less or equal to zero
- ZEQ \*b : Branch equal zero
- ZNE \*b : Branch not zero
- ZGE \*b : Branch greater or equal zero
- ZGT \*b : Branch greater than zero
-
-GROUP 14 - PROCEDURE CALL
-
- CAI \*- : Call procedure (procedure instance identifier on stack)
- CAL \*p : Call procedure (with name \*p)
- LFR \*s : Load function result
- RET \*z : Return (function result consists of top \*z bytes)
-
-GROUP 15 - MISCELLANEOUS
-
- ASP \*f : Adjust the stack pointer by \*f
- ASS \*i : Adjust the stack pointer by \*i-byte integer
- BLM \*z : Block move \*z bytes; first pop destination addr, then source addr
- BLS \*i : Block move, size is in \*i-byte integer on top of stack
- CSA \*i : Case jump; address of jump table at top of stack
- CSB \*i : Table lookup jump; address of jump table at top of stack
- DUP \*s : Duplicate top \*s bytes
- DUS \*i : Duplicate top \*i bytes
- FIL \*g : File name (external 4 := \*g)
- LIM \*- : Load 16 bit ignore mask
- LIN \*n : Line number (external 0 := \*n)
- LNI \*- : Line number increment
- LOR \*r : Load register (0=LB, 1=SP, 2=HP)
- MON \*- : Monitor call
- NOP \*- : No operation
- RCK \*i : Range check; trap on error
- RTT \*- : Return from trap
- SIG \*- : Trap errors to proc nr on top of stack (-2 resets default). Static
- link of procedure is below procedure number. Old values returned
- SIM \*- : Store 16 bit ignore mask
- STR \*r : Store register (0=LB, 1=SP, 2=HP)
- TRP \*- : Cause trap to occur (Error number on stack)
-.fi
+++ /dev/null
-.BP
-.AP "EM INTERPRETER"
-.nf
-.ta 8 16 24 32 40 48 56 64 72 80
-.so em.i
-.fi
-.BP
-.AP "EM CODE TABLES"
-The following table is used by the assembler for EM machine
-language.
-It specifies the opcodes used for each instruction and
-how arguments are mapped to machine language arguments.
-The table is presented in three columns,
-each line in each column contains three or four fields.
-Each line describes a range of interpreter opcodes by
-specifying for which instruction the range is used, the type of the
-opcodes (mini, shortie, etc..) and range for the instruction
-argument.
-.A
-The first field on each line gives the EM instruction mnemonic,
-the second field gives some flags.
-If the opcodes are minis or shorties the third field specifies
-how many minis/shorties are used.
-The last field gives the number of the (first) interpreter
-opcode.
-.N 1
-Flags :
-.IS 3
-.N 1
-Opcode type, only one of the following may be specified.
-.PS - 5 " "
-.PT -
-opcode without argument
-.PT m
-mini
-.PT s
-shortie
-.PT 2
-opcode with 2-byte signed argument
-.PT 4
-opcode with 4-byte signed argument
-.PT 8
-opcode with 8-byte signed argument
-.PE
-Secondary (escaped) opcodes.
-.PS - 5 " "
-.PT e
-The opcode thus marked is in the secondary opcode group instead
-of the primary
-.PE
-restrictions on arguments
-.PS - 5 " "
-.PT N
-Negative arguments only
-.PT P
-Positive and zero arguments only
-.PE
-mapping of arguments
-.PS - 5 " "
-.PT w
-argument must be divisible by the wordsize and is divided by the
-wordsize before use as opcode argument.
-.PT o
-argument ( possibly after division ) must be >= 1 and is
-decremented before use as opcode argument
-.PE
-.IE
-If the opcode type is 2,4 or 8 the resulting argument is used as
-opcode argument (least significant byte first).
-.N
-If the opcode type is mini, the argument is added
-to the first opcode - if in range - .
-If the argument is negative, the absolute value minus one is
-used in the algorithm above.
-.N
-For shorties with positive arguments the first opcode is used
-for arguments in the range 0..255, the second for the range
-256..511, etc..
-For shorties with negative arguments the first opcode is used
-for arguments in the range -1..-256, the second for the range
--257..-512, etc..
-The byte following the opcode contains the least significant
-byte of the argument.
-First some examples of these specifications.
-.PS - 5
-.PT "aar mwPo 1 34"
-Indicates that opcode 34 is used as a mini for Positive
-instruction arguments only.
-The w and o indicate division and decrementing of the
-instruction argument.
-Because the resulting argument must be zero ( only opcode 34 may be used
-), this mini can only be used for instruction argument 2.
-Conclusion: opcode 34 is for "AAR 2".
-.PT "adp sP 1 41"
-Opcode 41 is used as shortie for ADP with arguments in the range
-0..255.
-.PT "bra sN 2 60"
-Opcode 60 is used as shortie for BRA with arguments -1..-256,
-61 is used for arguments -257..-512.
-.PT "zer e- 145"
-Escaped opcode 145 is used for ZER.
-.PE
-The interpreter opcode table:
-.N 1
-.IS 3
-.DS B
-.so itables
-.DE 0
-.IE
-.P
-The table above results in the following dispatch tables.
-Dispatch tables are used by interpreters to jump to the
-routines implementing the EM instructions, indexed by the next opcode.
-Each line of the dispatch tables gives the routine names
-of eight consecutive opcodes, preceded by the first opcode number
-on that line.
-Routine names consist of an EM mnemonic followed by a suffix.
-The suffices show the encoding used for each opcode.
-.N
-The following suffices exist:
-.N 1
-.VS 1 0
-.IS 4
-.PS - 11
-.PT .z
-no arguments
-.PT .l
-16-bit argument
-.PT .lw
-16-bit argument divided by the wordsize
-.PT .p
-positive 16-bit argument
-.PT .pw
-positive 16-bit argument divided by the wordsize
-.PT .n
-negative 16-bit argument
-.PT .nw
-negative 16-bit argument divided by the wordsize
-.PT .s<num>
-shortie with <num> as high order argument byte
-.PT .sw<num>
-shortie with argument divided by the wordsize
-.PT .<num>
-mini with <num> as argument
-.PT .<num>W
-mini with <num>*wordsize as argument
-.PE 3
-<num> is a possibly negative integer.
-.VS 1 1
-.IE
-The dispatch table for the 256 primary opcodes:
-.DS B
- 0 loc.0 loc.1 loc.2 loc.3 loc.4 loc.5 loc.6 loc.7
- 8 loc.8 loc.9 loc.10 loc.11 loc.12 loc.13 loc.14 loc.15
- 16 loc.16 loc.17 loc.18 loc.19 loc.20 loc.21 loc.22 loc.23
- 24 loc.24 loc.25 loc.26 loc.27 loc.28 loc.29 loc.30 loc.31
- 32 loc.32 loc.33 aar.1W adf.s0 adi.1W adi.2W adp.l adp.1
- 40 adp.2 adp.s0 adp.s-1 ads.1W and.1W asp.1W asp.2W asp.3W
- 48 asp.4W asp.5W asp.w0 beq.l beq.s0 bge.s0 bgt.s0 ble.s0
- 56 blm.s0 blt.s0 bne.s0 bra.l bra.s-1 bra.s-2 bra.s0 bra.s1
- 64 cal.1 cal.2 cal.3 cal.4 cal.5 cal.6 cal.7 cal.8
- 72 cal.9 cal.10 cal.11 cal.12 cal.13 cal.14 cal.15 cal.16
- 80 cal.17 cal.18 cal.19 cal.20 cal.21 cal.22 cal.23 cal.24
- 88 cal.25 cal.26 cal.27 cal.28 cal.s0 cff.z cif.z cii.z
- 96 cmf.s0 cmi.1W cmi.2W cmp.z cms.s0 csa.1W csb.1W dec.z
- 104 dee.w0 del.w-1 dup.1W dvf.s0 dvi.1W fil.l inc.z ine.lw
- 112 ine.w0 inl.-1W inl.-2W inl.-3W inl.w-1 inn.s0 ior.1W ior.s0
- 120 lae.l lae.w0 lae.w1 lae.w2 lae.w3 lae.w4 lae.w5 lae.w6
- 128 lal.p lal.n lal.0 lal.-1 lal.w0 lal.w-1 lal.w-2 lar.W
- 136 ldc.0 lde.lw lde.w0 ldl.0 ldl.w-1 lfr.1W lfr.2W lfr.s0
- 144 lil.w-1 lil.w0 lil.0 lil.1W lin.l lin.s0 lni.z loc.l
- 152 loc.-1 loc.s0 loc.s-1 loe.lw loe.w0 loe.w1 loe.w2 loe.w3
- 160 loe.w4 lof.l lof.1W lof.2W lof.3W lof.4W lof.s0 loi.l
- 168 loi.1 loi.1W loi.2W loi.3W loi.4W loi.s0 lol.pw lol.nw
- 176 lol.0 lol.1W lol.2W lol.3W lol.-1W lol.-2W lol.-3W lol.-4W
- 184 lol.-5W lol.-6W lol.-7W lol.-8W lol.w0 lol.w-1 lxa.1 lxl.1
- 192 lxl.2 mlf.s0 mli.1W mli.2W rck.1W ret.0 ret.1W ret.s0
- 200 rmi.1W sar.1W sbf.s0 sbi.1W sbi.2W sdl.w-1 set.s0 sil.w-1
- 208 sil.w0 sli.1W ste.lw ste.w0 ste.w1 ste.w2 stf.l stf.W
- 216 stf.2W stf.s0 sti.1 sti.1W sti.2W sti.3W sti.4W sti.s0
- 224 stl.pw stl.nw stl.0 stl.1W stl.-1W stl.-2W stl.-3W stl.-4W
- 232 stl.-5W stl.w-1 teq.z tgt.z tlt.z tne.z zeq.l zeq.s0
- 240 zeq.s1 zer.s0 zge.s0 zgt.s0 zle.s0 zlt.s0 zne.s0 zne.s-1
- 248 zre.lw zre.w0 zrl.-1W zrl.-2W zrl.w-1 zrl.nw escape1 escape2
-.DE 2
-The list of secondary opcodes (escape1):
-.N 1
-.DS B
- 0 aar.l aar.z adf.l adf.z adi.l adi.z ads.l ads.z
- 8 adu.l adu.z and.l and.z asp.lw ass.l ass.z bge.l
- 16 bgt.l ble.l blm.l bls.l bls.z blt.l bne.l cai.z
- 24 cal.l cfi.z cfu.z ciu.z cmf.l cmf.z cmi.l cmi.z
- 32 cms.l cms.z cmu.l cmu.z com.l com.z csa.l csa.z
- 40 csb.l csb.z cuf.z cui.z cuu.z dee.lw del.pw del.nw
- 48 dup.l dus.l dus.z dvf.l dvf.z dvi.l dvi.z dvu.l
- 56 dvu.z fef.l fef.z fif.l fif.z inl.pw inl.nw inn.l
- 64 inn.z ior.l ior.z lar.l lar.z ldc.l ldf.l ldl.pw
- 72 ldl.nw lfr.l lil.pw lil.nw lim.z los.l los.z lor.s0
- 80 lpi.l lxa.l lxl.l mlf.l mlf.z mli.l mli.z mlu.l
- 88 mlu.z mon.z ngf.l ngf.z ngi.l ngi.z nop.z rck.l
- 96 rck.z ret.l rmi.l rmi.z rmu.l rmu.z rol.l rol.z
- 104 ror.l ror.z rtt.z sar.l sar.z sbf.l sbf.z sbi.l
- 112 sbi.z sbs.l sbs.z sbu.l sbu.z sde.l sdf.l sdl.pw
- 120 sdl.nw set.l set.z sig.z sil.pw sil.nw sim.z sli.l
- 128 sli.z slu.l slu.z sri.l sri.z sru.l sru.z sti.l
- 136 sts.l sts.z str.s0 tge.z tle.z trp.z xor.l xor.z
- 144 zer.l zer.z zge.l zgt.l zle.l zlt.l zne.l zrf.l
- 152 zrf.z zrl.pw dch.z exg.s0 exg.l exg.z lpb.z gto.l
-.DE 2
-Finally, the list of opcodes with four byte arguments (escape2).
-.DS
-
- 0 loc
-.DE 0
-.BP
-.AP "AN EXAMPLE PROGRAM"
-.DS B
- 1 program example(output);
- 2 {This program just demonstrates typical EM code.}
- 3 type rec = record r1: integer; r2:real; r3: boolean end;
- 4 var mi: integer; mx:real; r:rec;
- 5
- 6 function sum(a,b:integer):integer;
- 7 begin
- 8 sum := a + b
- 9 end;
-10
-11 procedure test(var r: rec);
-12 label 1;
-13 var i,j: integer;
-14 x,y: real;
-15 b: boolean;
-16 c: char;
-17 a: array[1..100] of integer;
-18
-19 begin
-20 j := 1;
-21 i := 3 * j + 6;
-22 x := 4.8;
-23 y := x/0.5;
-24 b := true;
-25 c := 'z';
-26 for i:= 1 to 100 do a[i] := i * i;
-27 r.r1 := j+27;
-28 r.r3 := b;
-29 r.r2 := x+y;
-30 i := sum(r.r1, a[j]);
-31 while i > 0 do begin j := j + r.r1; i := i - 1 end;
-32 with r do begin r3 := b; r2 := x+y; r1 := 0 end;
-33 goto 1;
-34 1: writeln(j, i:6, x:9:3, b)
-35 end; {test}
-36 begin {main program}
-37 mx := 15.96;
-38 mi := 99;
-39 test(r)
-40 end.
-.DE 0
-.BP
-The EM code as produced by the Pascal-VU compiler is given below. Comments
-have been added manually. Note that this code has already been optimized.
-.DS B
- mes 2,2,2 ; wordsize 2, pointersize 2
- .1
- rom 't.p\e000' ; the name of the source file
- hol 552,-32768,0 ; externals and buf occupy 552 bytes
- exp $sum ; sum can be called from other modules
- pro $sum,2 ; procedure sum; 2 bytes local storage
- lin 8 ; code from source line 8
- ldl 0 ; load two locals ( a and b )
- adi 2 ; add them
- ret 2 ; return the result
- end 2 ; end of procedure ( still two bytes local storage )
- .2
- rom 1,99,2 ; descriptor of array a[]
- exp $test ; the compiler exports all level 0 procedures
- pro $test,226 ; procedure test, 226 bytes local storage
- .3
- rom 4.8F8 ; assemble Floating point 4.8 (8 bytes) in
- .4 ; global storage
- rom 0.5F8 ; same for 0.5
- mes 3,-226,2,2 ; compiler temporary not referenced by address
- mes 3,-24,2,0 ; the same is true for i, j, b and c in test
- mes 3,-22,2,0
- mes 3,-4,2,0
- mes 3,-2,2,0
- mes 3,-20,8,0 ; and for x and y
- mes 3,-12,8,0
- lin 20 ; maintain source line number
- loc 1
- stl -4 ; j := 1
- lni ; lin 21 prior to optimization
- lol -4
- loc 3
- mli 2
- loc 6
- adi 2
- stl -2 ; i := 3 * j + 6
- lni ; lin 22 prior to optimization
- lae .3
- loi 8
- lal -12
- sti 8 ; x := 4.8
- lni ; lin 23 prior to optimization
- lal -12
- loi 8
- lae .4
- loi 8
- dvf 8
- lal -20
- sti 8 ; y := x / 0.5
- lni ; lin 24 prior to optimization
- loc 1
- stl -22 ; b := true
- lni ; lin 25 prior to optimization
- loc 122
- stl -24 ; c := 'z'
- lni ; lin 26 prior to optimization
- loc 1
- stl -2 ; for i:= 1
- 2
- lol -2
- dup 2
- mli 2 ; i*i
- lal -224
- lol -2
- lae .2
- sar 2 ; a[i] :=
- lol -2
- loc 100
- beq *3 ; to 100 do
- inl -2 ; increment i and loop
- bra *2
- 3
- lin 27
- lol -4
- loc 27
- adi 2 ; j + 27
- sil 0 ; r.r1 :=
- lni ; lin 28 prior to optimization
- lol -22 ; b
- lol 0
- stf 10 ; r.r3 :=
- lni ; lin 29 prior to optimization
- lal -20
- loi 16
- adf 8 ; x + y
- lol 0
- adp 2
- sti 8 ; r.r2 :=
- lni ; lin 23 prior to optimization
- lal -224
- lol -4
- lae .2
- lar 2 ; a[j]
- lil 0 ; r.r1
- cal $sum ; call now
- asp 4 ; remove parameters from stack
- lfr 2 ; get function result
- stl -2 ; i :=
- 4
- lin 31
- lol -2
- zle *5 ; while i > 0 do
- lol -4
- lil 0
- adi 2
- stl -4 ; j := j + r.r1
- del -2 ; i := i - 1
- bra *4 ; loop
- 5
- lin 32
- lol 0
- stl -226 ; make copy of address of r
- lol -22
- lol -226
- stf 10 ; r3 := b
- lal -20
- loi 16
- adf 8
- lol -226
- adp 2
- sti 8 ; r2 := x + y
- loc 0
- sil -226 ; r1 := 0
- lin 34 ; note the abscence of the unnecesary jump
- lae 22 ; address of output structure
- lol -4
- cal $_wri ; write integer with default width
- asp 4 ; pop parameters
- lae 22
- lol -2
- loc 6
- cal $_wsi ; write integer width 6
- asp 6
- lae 22
- lal -12
- loi 8
- loc 9
- loc 3
- cal $_wrf ; write fixed format real, width 9, precision 3
- asp 14
- lae 22
- lol -22
- cal $_wrb ; write boolean, default width
- asp 4
- lae 22
- cal $_wln ; writeln
- asp 2
- ret 0 ; return, no result
- end 226
- exp $_main
- pro $_main,0 ; main program
- .6
- con 2,-1,22 ; description of external files
- .5
- rom 15.96F8
- fil .1 ; maintain source file name
- lae .6 ; description of external files
- lae 0 ; base of hol area to relocate buffer addresses
- cal $_ini ; initialize files, etc...
- asp 4
- lin 37
- lae .5
- loi 8
- lae 2
- sti 8 ; mx := 15.96
- lni ; lin 38 prior to optimization
- loc 99
- ste 0 ; mi := 99
- lni ; lin 39 prior to optimization
- lae 10 ; address of r
- cal $test
- asp 2
- loc 0 ; normal exit
- cal $_hlt ; cleanup and finish
- asp 2
- end 0
- mes 5 ; reals were used
-.DE 0
-The compact code corresponding to the above program is listed below.
-Read it horizontally, line by line, not column by column.
-Each number represents a byte of compact code, printed in decimal.
-The first two bytes form the magic word.
-.N 1
-.IS 3
-.DS B
-173 0 159 122 122 122 255 242 1 161 250 124 116 46 112 0
-255 156 245 40 2 245 0 128 120 155 249 123 115 117 109 160
-249 123 115 117 109 122 67 128 63 120 3 122 88 122 152 122
-242 2 161 121 219 122 255 155 249 124 116 101 115 116 160 249
-124 116 101 115 116 245 226 0 242 3 161 253 128 123 52 46
- 56 255 242 4 161 253 128 123 48 46 53 255 159 123 245 30
-255 122 122 255 159 123 96 122 120 255 159 123 98 122 120 255
-159 123 116 122 120 255 159 123 118 122 120 255 159 123 100 128
-120 255 159 123 108 128 120 255 67 140 69 121 113 116 68 73
-116 69 123 81 122 69 126 3 122 113 118 68 57 242 3 72
-128 58 108 112 128 68 58 108 72 128 57 242 4 72 128 44
-128 58 100 112 128 68 69 121 113 98 68 69 245 122 0 113
- 96 68 69 121 113 118 182 73 118 42 122 81 122 58 245 32
-255 73 118 57 242 2 94 122 73 118 69 220 10 123 54 118
- 18 122 183 67 147 73 116 69 147 3 122 104 120 68 73 98
- 73 120 111 130 68 58 100 72 136 2 128 73 120 4 122 112
-128 68 58 245 32 255 73 116 57 242 2 59 122 65 120 20
-249 123 115 117 109 8 124 64 122 113 118 184 67 151 73 118
-128 125 73 116 65 120 3 122 113 116 41 118 18 124 185 67
-152 73 120 113 245 30 255 73 98 73 245 30 255 111 130 58
-100 72 136 2 128 73 245 30 255 4 122 112 128 69 120 104
-245 30 255 67 154 57 142 73 116 20 249 124 95 119 114 105
- 8 124 57 142 73 118 69 126 20 249 124 95 119 115 105 8
-126 57 142 58 108 72 128 69 129 69 123 20 249 124 95 119
-114 102 8 134 57 142 73 98 20 249 124 95 119 114 98 8
-124 57 142 20 249 124 95 119 108 110 8 122 88 120 152 245
-226 0 155 249 125 95 109 97 105 110 160 249 125 95 109 97
-105 110 120 242 6 151 122 119 142 255 242 5 161 253 128 125
- 49 53 46 57 54 255 50 242 1 57 242 6 57 120 20 249
-124 95 105 110 105 8 124 67 157 57 242 5 72 128 57 122
-112 128 68 69 219 110 120 68 57 130 20 249 124 116 101 115
-116 8 122 69 120 20 249 124 95 104 108 116 8 122 152 120
-159 124 160 255 159 125 255
-.DE 0
-.IE
-.MS T A 0
-.ME
-.BP
-.MS B A 0
-.ME
-.CT
+++ /dev/null
-.BP
-.SN 11
-.S1 "EM ASSEMBLY LANGUAGE"
-We use two representations for assembly language programs,
-one is in ASCII and the other is the compact assembly language.
-The latter needs less space than the first for the same program
-and therefore allows faster processing.
-Our only program accepting ASCII assembly
-language converts it to the compact form.
-All other programs expect compact assembly input.
-The first part of the chapter describes the ASCII assembly
-language and its semantics.
-The second part describes the syntax of the compact assembly
-language.
-The last part lists the EM instructions with the type of
-arguments allowed and an indication of the function.
-Appendix A gives a detailed description of the effect of all
-instructions in the form of a Pascal program.
-.S2 "ASCII assembly language"
-An assembly language program consists of a series of lines, each
-line may be blank, contain one (pseudo)instruction or contain one
-label.
-Input to the assembler is in lower case.
-Upper case is used in this
-document merely to distinguish keywords from the surrounding prose.
-Comment is allowed at the end of each line and starts with a semicolon ";".
-This kind of comment does not exist in the compact form.
-.A
-Labels must be placed all by themselves on a line and start in
-column 1.
-There are two kinds of labels, instruction and data labels.
-Instruction labels are unsigned positive integers.
-The scope of an instruction label is its procedure.
-.A
-The pseudoinstructions CON, ROM and BSS may be preceded by a
-line containing a
-1-8 character data label, the first character of which is a
-letter, period or underscore.
-The period may only be followed by
-digits, the others may be followed by letters, digits and underscores.
-The use of the character "." followed by a constant,
-which must be in the range 1 to 32767 (e.g. ".40") is recommended
-for compiler
-generated programs.
-These labels are considered as a special case and handled
-more efficiently in compact assembly language (see below).
-Note that a data label on its own or two consecutive labels are not
-allowed.
-.P
-Each statement may contain an instruction mnemonic or pseudoinstruction.
-These must begin in column 2 or later (not column 1) and must be followed
-by a space, tab, semicolon or LF.
-Everything on the line following a semicolon is
-taken as a comment.
-.P
-Each input file contains one module.
-A module may contain many procedures,
-which may be nested.
-A procedure consists of
-a PRO statement, a (possibly empty)
-collection of instructions and pseudoinstructions and finally an END
-statement.
-Pseudoinstructions are also allowed between procedures.
-They do not belong to a specific procedure.
-.P
-All constants in EM are interpreted in the decimal base.
-The ASCII assembly language accepts constant expressions
-wherever constants are allowed.
-The operators recognized are: +, -, *, % and / with the usual
-precedence order.
-Use of the parentheses ( and ) to alter the precedence order is allowed.
-.S3 "Instruction arguments"
-Unlike many other assembly languages, the EM assembly
-language requires all arguments of normal and pseudoinstructions
-to be either a constant or an identifier, but not a combination
-of these two.
-There is one exception to this rule: when a data label is used
-for initialization or as an instruction argument,
-expressions of the form 'label+constant' and 'label-constant'
-are allowed.
-This makes it possible to address, for example, the
-third word of a ten word BSS block
-directly.
-Thus LOE LABEL+4 is permitted and so is CON LABEL+3.
-The resulting address is must be in the same fragment as the label.
-It is not allowed to add or subtract from instruction labels or procedure
-identifiers,
-which certainly is not a severe restriction and greatly aids
-optimization.
-.P
-Instruction arguments can be constants,
-data labels, data labels offsetted by a constant, instruction
-labels and procedure identifiers.
-The range of integers allowed depends on the instruction.
-Most instructions allow only integers
-(signed or unsigned)
-that fit in a word.
-Arguments used as offsets to pointers should fit in a
-pointer-sized integer.
-Finally, arguments to LDC should fit in a double-word integer.
-.P
-Several instructions have two possible forms:
-with an explicit argument and with an implicit argument on top of the stack.
-The size of the implicit argument is the wordsize.
-The implicit argument is always popped before all other operands.
-For example: 'CMI 4' specifies that two four-byte signed
-integers on top of the stack are to be compared.
-\&'CMI' without an argument expects a wordsized integer
-on top of the stack that specifies the size of the integers to
-be compared.
-Thus the following two sequences are equivalent:
-.N 2
-.TS
-center, tab(:) ;
-l r 30 l r.
-LDL:-10:LDL:-10
-LDL:-14:LDL:-14
-::LOC:4
-CMI:4:CMI:
-ZEQ:*1:ZEQ:*1
-.TE 2
-Section 11.1.6 shows the arguments allowed for each instruction.
-.S3 "Pseudoinstruction arguments"
-Pseudoinstruction arguments can be divided in two classes:
-Initializers and others.
-The following initializers are allowed: signed integer constants,
-unsigned integer constants, floating-point constants, strings,
-data labels, data labels offsetted by a constant, instruction
-labels and procedure identifiers.
-.P
-Constant initializers in BSS, HOL, CON and ROM pseudoinstructions
-can be followed by a letter I, U or F.
-This indicator
-specifies the type of the initializer: Integer, Unsigned or Float.
-If no indicator is present I is assumed.
-The size of the object is the wordsize unless
-the indicator is followed by an integer specifying the
-object's size.
-This integer is governed by the same restrictions as for
-transfer of objects to/from memory.
-As in instruction arguments, initializers include expressions of the form:
-\&"LABEL+offset" and "LABEL-offset".
-The offset must be an unsigned decimal constant.
-The 'IUF' indicators cannot be used in the offsets.
-.P
-Data labels are referred to by their name.
-.P
-Strings are surrounded by double quotes (").
-Semecolon's in string do not indicate the start of comment.
-In the ASCII representation the escape character \e (backslash)
-alters the meaning of subsequent character(s).
-This feature allows inclusion of zeroes, graphic characters and
-the double quote in the string.
-The following escape sequences exist:
-.DS
-.TS
-center, tab(:);
-l l l.
-newline:NL\|(LF):\en
-horizontal tab:HT:\et
-backspace:BS:\eb
-carriage return:CR:\er
-form feed:FF:\ef
-backslash:\e:\e\e
-double quote:":\e"
-bit pattern:\fBddd\fP:\e\fBddd\fP
-.TE
-.DE
-The escape \fBddd\fP consists of the backslash followed by 1,
-2, or 3 octal digits specifing the value of
-the desired character.
-If the character following a backslash is not one of those
-specified,
-the backslash is ignored.
-Example: CON "hello\e012\e0".
-Each string element initializes a single byte.
-The ASCII character set is used to map characters onto values.
-Strings are padded with zeroes up to a multiple of the wordsize.
-.P
-Instruction labels are referred to as *1, *2, etc. in both branch
-instructions and as initializers.
-.P
-The notation $procname means the identifier for the procedure
-with the specified name.
-This identifier has the size of a pointer.
-.S3 Notation
-First, the notation used for the arguments, classes of
-instructions and pseudoinstructions.
-.IS 2
-.TS
-tab(:);
-l l l.
-<cst>:\&=:integer constant (current range -2**31..2**31-1)
-<dlb>:\&=:data label
-<arg>:\&=:<cst> or <dlb> or <dlb>+<cst> or <dlb>-<cst>
-<con>:\&=:integer constant, unsigned constant, floating-point constant
-<str>:\&=:string constant (surrounded by double quotes),
-<ilb>:\&=:instruction label
-::'*' followed by an integer in the range 0..32767.
-<pro>:\&=:procedure number ('$' followed by a procedure name)
-<val>:\&=:<arg>, <con>, <pro> or <ilb>.
-<par>:\&=:<val> or <str>
-<...>*:\&=:zero or more of <...>
-<...>+:\&=:one or more of <...>
-[...]:\&=:optional ...
-.TE
-.IE
-.S3 "Pseudoinstructions"
-.S4 Storage declaration
-Initialized global data is allocated by the pseudoinstruction CON,
-which needs at least one argument.
-For each argument, an integral number of words,
-determined by the argument type, is allocated and initialized.
-.P
-The pseudoinstruction ROM is the same as CON,
-except that it guarantees that the initialized words
-will not change during the execution of the program.
-This information allows optimizers to do
-certain calculations such as array indexing and
-subrange checking at compile time instead
-of at run time.
-.P
-The pseudoinstruction BSS allocates
-uninitialized global data or large blocks of data initialized
-by the same value.
-The first argument to this pseudo is the number
-of bytes required, which must be a multiple of the wordsize.
-The other arguments specify the value used for initialization and
-whether the initialization is only for convenience or a strict necessity.
-The pseudoinstruction HOL is similar to BSS in that it requests an
-(un)initialized global data block.
-Addressing of a HOL block, however, is quasi absolute.
-The first byte is addressed by 0,
-the second byte by 1 etc. in assembly language.
-The assembler/loader adds the base address of
-the HOL block to these numbers to obtain the
-absolute address in the machine language.
-.P
-The scope of a HOL block starts at the HOL pseudo and
-ends at the next HOL pseudo or at the end of a module
-whatever comes first.
-Each instruction falls in the scope of at most one
-HOL block, the current HOL block.
-It is not allowed to have more than one HOL block per procedure.
-.P
-The alignment restrictions are enforced by the
-pseudoinstructions.
-All objects are aligned on a multiple of their size or the wordsize
-whichever is smaller.
-Switching to another type of fragment or placing a label forces
-word-alignment.
-There are three types of fragments in global data space: CON, ROM and
-BSS/HOL.
-.N 2
-.IS 2
-.PS - 4
-.PT "BSS <cst1>,<val>,<cst2>"
-Reserve <cst1> bytes.
-<val> is the value used to initialize the area.
-<cst1> must be a multiple of the size of <val>.
-<cst2> is 0 if the initialization is not strictly necessary,
-1 if it is.
-.PT "HOL <cst1>,<val>,<cst2>"
-Idem, but all following absolute global data references will
-refer to this block.
-Only one HOL is allowed per procedure,
-it has to be placed before the first instruction.
-.PT "CON <val>+"
-Assemble global data words initialized with the <val> constants.
-.PT "ROM <val>+"
-Idem, but the initialized data will never be changed by the program.
-.PE
-.IE
-.S4 Partitioning
-Two pseudoinstructions partition the input into procedures:
-.IS 2
-.PS - 4
-.PT "PRO <pro>[,<cst>]"
-Start of procedure.
-<pro> is the procedure name.
-<cst> is the number of bytes for locals.
-The number of bytes for locals must be specified in the PRO or
-END pseudoinstruction.
-When specified in both, they must be identical.
-.PT "END [<cst>]"
-End of Procedure.
-<cst> is the number of bytes for locals.
-The number of bytes for locals must be specified in either the PRO or
-END pseudoinstruction or both.
-.PE
-.IE
-.S4 Visibility
-Names of data and procedures in an EM module can either be
-internal or external.
-External names are known outside the module and are used to link
-several pieces of a program.
-Internal names are not known outside the modules they are used in.
-Other modules will not 'see' an internal name.
-.A
-To reduce the number of passes needed,
-it must be known at the first occurrence whether
-a name is internal or external.
-If the first occurrence of a name is in a definition,
-the name is considered to be internal.
-If the first occurrence of a name is a reference,
-the name is considered to be external.
-If the first occurrence is in one of the following pseudoinstructions,
-the effect of the pseudo has precedence.
-.IS 2
-.PS - 4
-.PT "EXA <dlb>"
-External name.
-<dlb> is known, possibly defined, outside this module.
-Note that <dlb> may be defined in the same module.
-.PT "EXP <pro>"
-External procedure identifier.
-Note that <pro> may be defined in the same module.
-.PT "INA <dlb>"
-Internal name.
-<dlb> is internal to this module and must be defined in this module.
-.PT "INP <pro>"
-Internal procedure.
-<pro> is internal to this module and must be defined in this module.
-.PE
-.IE
-.S4 Miscellaneous
-Two other pseudoinstructions provide miscellaneous features:
-.IS 2
-.PS - 4
-.PT "EXC <cst1>,<cst2>"
-Two blocks of instructions preceding this one are
-interchanged before being processed.
-<cst1> gives the number of lines of the first block.
-<cst2> gives the number of lines of the second one.
-Blank and pure comment lines do not count.
-.PT "MES <cst>[,<par>]*"
-A special type of comment.
-Used by compilers to communicate with the
-optimizer, assembler, etc. as follows:
-.VS 1 0
-.PS - 4
-.PT "MES 0"
-An error has occurred, stop further processing.
-.PT "MES 1"
-Suppress optimization.
-.PT "MES 2,<cst1>,<cst2>"
-Use wordsize <cst1> and pointer size <cst2>.
-.PT "MES 3,<cst1>,<cst2>,<cst3>,<cst4>"
-Indicates that a local variable is never referenced indirectly.
-Used to indicate that a register may be used for a specific
-variable.
-<cst1> is offset in bytes from AB if positive
-and offset from LB if negative.
-<cst2> gives the size of the variable.
-<cst3> indicates the class of the variable.
-The following values are currently recognized:
-.PS
-.PT 0
-The variable can be used for anything.
-.PT 1
-The variable is used as a loopindex.
-.PT 2
-The variable is used as a pointer.
-.PT 3
-The variable is used as a floating point number.
-.PE 0
-<cst4> gives the priority of the variable,
-higher numbers indicate better candidates.
-.PT "MES 4,<cst>,<str>"
-Number of source lines in file <str> (for profiler).
-.PT "MES 5"
-Floating point used.
-.PT "MES 6,<val>*"
-Comment. Used to provide comments in compact assembly language.
-.PT "MES 7,....."
-Reserved.
-.PT "MES 8,<pro>[,<dlb>]..."
-Library module. Indicates that the module may only be loaded
-if it is useful, that is, if it can satisfy any unresolved
-references during the loading process.
-May not be preceded by any other pseudo, except MES's.
-.PT "MES 9,<cst>"
-Guarantees that no more than <cst> bytes of parameters are
-accessed, either directly or indirectly.
-.PE 1
-.VS 1 1
-Each backend is free to skip irrelevant MES pseudos.
-.PE
-.IE
-.S2 "The Compact Assembly Language"
-The assembler accepts input in a highly encoded form.
-This
-form is intended to reduce the amount of file transport between the
-front ends, optimizers
-and back ends, and also reduces the amount of storage required for storing
-libraries.
-Libraries are stored as archived compact assembly language, not machine
-language.
-.P
-When beginning to read the input, the assembler is in neutral state, and
-expects either a label or an instruction (including the pseudoinstructions).
-The meaning of the next byte(s) when in neutral state is as follows, where
-b1, b2
-etc. represent the succeeding bytes.
-.N 1
-.DS
-.TS
-tab(:) ;
-rw17 4 l.
-0:Reserved for future use
-1-129:Machine instructions, see Appendix A, alphabetical list
-130-149:Reserved for future use
-150-161:BSS,CON,END,EXA,EXC,EXP,HOL,INA,INP,MES,PRO,ROM
-162-179:Reserved for future pseudoinstructions
-180-239:Instruction labels 0 - 59 (180 is local label 0 etc.)
-240-244:See the Common Table below
-245-255:Not used
-.TE 1
-.DE 0
-After a label, the assembler is back in neutral state; it can immediately
-accept another label or an instruction in the next byte.
-No linefeeds are used to separate lines.
-.P
-If an opcode expects no arguments,
-the assembler is back in neutral state after
-reading the one byte containing the instruction number.
-If it has one or
-more arguments (only pseudos have more than 1), the arguments follow directly,
-encoded as follows:
-.N 1
-.IS 2
-.TS
-tab(:);
-r l.
-0-239:Offsets from -120 to 119
-
-240-255:See the Common Table below
-.TE 1
-Absence of an optional argument is indicated by a special
-byte.
-.IE 2
-.CS
-Common Table for Neutral State and Arguments
-.CE
-.TS
-tab(:);
-c c s c
-l8 l l8 l.
-class:bytes:description
-
-<ilb>:240:b1:Instruction label b1 (Not used for branches)
-<ilb>:241:b1 b2:16 bit instruction label (256*b2 + b1)
-<dlb>:242:b1:Global label .0-.255, with b1 being the label
-<dlb>:243:b1 b2:Global label .0-.32767
-:::with 256*b2+b1 being the label
-<dlb>:244:<string>:Global symbol not of the form .nnn
-<cst>:245:b1 b2:16 bit constant
-<cst>:246:b1 b2 b3 b4:32 bit constant
-<cst>:247:b1 .. b8:64 bit constant
-<arg>:248:<dlb><cst>:Global label + (possibly negative) constant
-<pro>:249:<string>:Procedure name (not including $)
-<str>:250:<string>:String used in CON or ROM (no quotes-no escapes)
-<con>:251:<cst><string>:Integer constant, size <cst> bytes
-<con>:252:<cst><string>:Unsigned constant, size <cst> bytes
-<con>:253:<cst><string>:Floating constant, size <cst> bytes
-:254::unused
-<end>:255::Delimiter for argument lists or
-:::indicates absence of optional argument
-.TE 1
-.P
-The bytes specifying the value of a 16, 32 or 64 bit constant
-are presented in two's complement notation, with the least
-significant byte first. For example: the value of a 32 bit
-constant is ((s4*256+b3)*256+b2)*256+b1, where s4 is b4-256 if
-b4 is greater than 128 else s4 takes the value of b4.
-A <string> consists of a <cst> inmediatly followed by
-a sequence of bytes with length <cst>.
-.P
-.ne 8
-The pseudoinstructions fall into several categories, depending on their
-arguments:
-.N 1
-.DS
- Group 1 -- EXC, BSS, HOL have a known number of arguments
- Group 2 -- EXA, EXP, INA, INP have a string as argument
- Group 3 -- CON, MES, ROM have a variable number of various things
- Group 4 -- END, PRO have a trailing optional argument.
-.DE 1
-Groups 1 and 2
-use the encoding described above.
-Group 3 also uses the encoding listed above, with an <end> byte after the
-last argument to indicate the end of the list.
-Group 4 uses
-an <end> byte if the trailing argument is not present.
-.N 2
-.IS 2
-.TS
-tab(|);
-l s l
-l s s
-l 2 lw(46) l.
-Example ASCII|Example compact
-(LOC = 69, BRA = 18 here):
-
-2||182
-1||181
- LOC|10|69 130
- LOC|-10|69 110
- LOC|300|69 245 44 1
- BRA|*19|18 139
-300||241 44 1
-.3||242 3
- CON|4,9,*2,$foo|151 124 129 240 2 249 123 102 111 111 255
- CON|.35|151 242 35 255
-.TE 0
-.IE 0
-.BP
-.S2 "Assembly language instruction list"
-.P
-For each instruction in the list the range of argument values
-in the assembly language is given.
-The column headed \fIassem\fP contains the mnemonics defined
-in 11.1.3.
-The following column specifies restrictions of the argument
-value.
-Addresses have to obey the restrictions mentioned in chapter 2.
-The classes of arguments
-are indicated by letters:
-.ds b \fBb\fP
-.ds c \fBc\fP
-.ds d \fBd\fP
-.ds g \fBg\fP
-.ds f \fBf\fP
-.ds l \fBl\fP
-.ds n \fBn\fP
-.ds w \fBw\fP
-.ds p \fBp\fP
-.ds r \fBr\fP
-.ds s \fBs\fP
-.ds z \fBz\fP
-.ds o \fBo\fP
-.ds - \fB-\fP
-.N 1
-.TS
-tab(:);
-c s l l
-l l 15 l l.
-\fIassem\fP:constraints:rationale
-
-\&\*c:cst:fits word:constant
-\&\*d:cst:fits double word:constant
-\&\*l:cst::local offset
-\&\*g:arg:>= 0:global offset
-\&\*f:cst::fragment offset
-\&\*n:cst:>= 0:counter
-\&\*s:cst:>0 , word multiple:object size
-\&\*z:cst:>= 0 , zero or word multiple:object size
-\&\*o:cst:>= 0 , word multiple or fraction:object size
-\&\*w:cst:> 0 , word multiple:object size *
-\&\*p:pro::pro identifier
-\&\*b:ilb:>= 0:label number
-\&\*r:cst:0,1,2:register number
-\&\*-:::no argument
-.TE 1
-.P
-The * at the rationale for \*w indicates that the argument
-can either be given as argument or on top of the stack.
-If the argument is omitted, the argument is fetched from the
-stack;
-it is assumed to be a wordsized unsigned integer.
-Instructions that check for undefined integer or floating-point
-values and underflow or overflow
-are indicated below by (*).
-.N 1
-.DS B
-GROUP 1 - LOAD
-
- LOC \*c : Load constant (i.e. push one word onto the stack)
- LDC \*d : Load double constant ( push two words )
- LOL \*l : Load word at \*l-th local (\*l<0) or parameter (\*l>=0)
- LOE \*g : Load external word \*g
- LIL \*l : Load word pointed to by \*l-th local or parameter
- LOF \*f : Load offsetted (top of stack + \*f yield address)
- LAL \*l : Load address of local or parameter
- LAE \*g : Load address of external
- LXL \*n : Load lexical (address of LB \*n static levels back)
- LXA \*n : Load lexical (address of AB \*n static levels back)
- LOI \*o : Load indirect \*o bytes (address is popped from the stack)
- LOS \*w : Load indirect, \*w-byte integer on top of stack gives object size
- LDL \*l : Load double local or parameter (two consecutive words are stacked)
- LDE \*g : Load double external (two consecutive externals are stacked)
- LDF \*f : Load double offsetted (top of stack + \*f yield address)
- LPI \*p : Load procedure identifier
-
-GROUP 2 - STORE
-
- STL \*l : Store local or parameter
- STE \*g : Store external
- SIL \*l : Store into word pointed to by \*l-th local or parameter
- STF \*f : Store offsetted
- STI \*o : Store indirect \*o bytes (pop address, then data)
- STS \*w : Store indirect, \*w-byte integer on top of stack gives object size
- SDL \*l : Store double local or parameter
- SDE \*g : Store double external
- SDF \*f : Store double offsetted
-
-GROUP 3 - INTEGER ARITHMETIC
-
- ADI \*w : Addition (*)
- SBI \*w : Subtraction (*)
- MLI \*w : Multiplication (*)
- DVI \*w : Division (*)
- RMI \*w : Remainder (*)
- NGI \*w : Negate (two's complement) (*)
- SLI \*w : Shift left (*)
- SRI \*w : Shift right (*)
-
-GROUP 4 - UNSIGNED ARITHMETIC
-
- ADU \*w : Addition
- SBU \*w : Subtraction
- MLU \*w : Multiplication
- DVU \*w : Division
- RMU \*w : Remainder
- SLU \*w : Shift left
- SRU \*w : Shift right
-
-GROUP 5 - FLOATING POINT ARITHMETIC
-
- ADF \*w : Floating add (*)
- SBF \*w : Floating subtract (*)
- MLF \*w : Floating multiply (*)
- DVF \*w : Floating divide (*)
- NGF \*w : Floating negate (*)
- FIF \*w : Floating multiply and split integer and fraction part (*)
- FEF \*w : Split floating number in exponent and fraction part (*)
-
-GROUP 6 - POINTER ARITHMETIC
-
- ADP \*f : Add \*f to pointer on top of stack
- ADS \*w : Add \*w-byte value and pointer
- SBS \*w : Subtract pointers in same fragment and push diff as size \*w integer
-
-GROUP 7 - INCREMENT/DECREMENT/ZERO
-
- INC \*- : Increment word on top of stack by 1 (*)
- INL \*l : Increment local or parameter (*)
- INE \*g : Increment external (*)
- DEC \*- : Decrement word on top of stack by 1 (*)
- DEL \*l : Decrement local or parameter (*)
- DEE \*g : Decrement external (*)
- ZRL \*l : Zero local or parameter
- ZRE \*g : Zero external
- ZRF \*w : Load a floating zero of size \*w
- ZER \*w : Load \*w zero bytes
-
-GROUP 8 - CONVERT (stack: source, source size, dest. size (top))
-
- CII \*- : Convert integer to integer (*)
- CUI \*- : Convert unsigned to integer (*)
- CFI \*- : Convert floating to integer (*)
- CIF \*- : Convert integer to floating (*)
- CUF \*- : Convert unsigned to floating (*)
- CFF \*- : Convert floating to floating (*)
- CIU \*- : Convert integer to unsigned
- CUU \*- : Convert unsigned to unsigned
- CFU \*- : Convert floating to unsigned
-
-GROUP 9 - LOGICAL
-
- AND \*w : Boolean and on two groups of \*w bytes
- IOR \*w : Boolean inclusive or on two groups of \*w bytes
- XOR \*w : Boolean exclusive or on two groups of \*w bytes
- COM \*w : Complement (one's complement of top \*w bytes)
- ROL \*w : Rotate left a group of \*w bytes
- ROR \*w : Rotate right a group of \*w bytes
-
-GROUP 10 - SETS
-
- INN \*w : Bit test on \*w byte set (bit number on top of stack)
- SET \*w : Create singleton \*w byte set with bit n on (n is top of stack)
-
-GROUP 11 - ARRAY
-
- LAR \*w : Load array element, descriptor contains integers of size \*w
- SAR \*w : Store array element
- AAR \*w : Load address of array element
-
-GROUP 12 - COMPARE
-
- CMI \*w : Compare \*w byte integers, Push negative, zero, positive for <, = or >
- CMF \*w : Compare \*w byte reals
- CMU \*w : Compare \*w byte unsigneds
- CMS \*w : Compare \*w byte values, can only be used for bit for bit equality test
- CMP \*- : Compare pointers
-
- TLT \*- : True if less, i.e. iff top of stack < 0
- TLE \*- : True if less or equal, i.e. iff top of stack <= 0
- TEQ \*- : True if equal, i.e. iff top of stack = 0
- TNE \*- : True if not equal, i.e. iff top of stack non zero
- TGE \*- : True if greater or equal, i.e. iff top of stack >= 0
- TGT \*- : True if greater, i.e. iff top of stack > 0
-
-GROUP 13 - BRANCH
-
- BRA \*b : Branch unconditionally to label \*b
-
- BLT \*b : Branch less (pop 2 words, branch if top > second)
- BLE \*b : Branch less or equal
- BEQ \*b : Branch equal
- BNE \*b : Branch not equal
- BGE \*b : Branch greater or equal
- BGT \*b : Branch greater
-
- ZLT \*b : Branch less than zero (pop 1 word, branch negative)
- ZLE \*b : Branch less or equal to zero
- ZEQ \*b : Branch equal zero
- ZNE \*b : Branch not zero
- ZGE \*b : Branch greater or equal zero
- ZGT \*b : Branch greater than zero
-
-GROUP 14 - PROCEDURE CALL
-
- CAI \*- : Call procedure (procedure identifier on stack)
- CAL \*p : Call procedure (with identifier \*p)
- LFR \*s : Load function result
- RET \*z : Return (function result consists of top \*z bytes)
-
-GROUP 15 - MISCELLANEOUS
-
- ASP \*f : Adjust the stack pointer by \*f
- ASS \*w : Adjust the stack pointer by \*w-byte integer
- BLM \*z : Block move \*z bytes; first pop destination addr, then source addr
- BLS \*w : Block move, size is in \*w-byte integer on top of stack
- CSA \*w : Case jump; address of jump table at top of stack
- CSB \*w : Table lookup jump; address of jump table at top of stack
- DCH \*- : Follow dynamic chain, convert LB to LB of caller
- DUP \*s : Duplicate top \*s bytes
- DUS \*w : Duplicate top \*w bytes
- EXG \*w : Exchange top \*w bytes
- FIL \*g : File name (external 4 := \*g)
- GTO \*g : Non-local goto, descriptor at \*g
- LIM \*- : Load 16 bit ignore mask
- LIN \*n : Line number (external 0 := \*n)
- LNI \*- : Line number increment
- LOR \*r : Load register (0=LB, 1=SP, 2=HP)
- LPB \*- : Convert local base to argument base
- MON \*- : Monitor call
- NOP \*- : No operation
- RCK \*w : Range check; trap on error
- RTT \*- : Return from trap
- SIG \*- : Trap errors to proc identifier on top of stack, -2 resets default
- SIM \*- : Store 16 bit ignore mask
- STR \*r : Store register (0=LB, 1=SP, 2=HP)
- TRP \*- : Cause trap to occur (Error number on stack)
-.DE 0
+++ /dev/null
-.SN 7
-.BP
-.S1 "DESCRIPTORS"
-Several instructions use descriptors, notably the range check instruction,
-the array instructions, the goto instruction and the case jump instructions.
-Descriptors reside in data space.
-They may be constructed at run time, but
-more often they are fixed and allocated in ROM data.
-.P
-All instructions using descriptors, except GTO, have as argument
-the size of the integers in the descriptor.
-All implementations have to allow integers of the size of a
-word in descriptors.
-All integers popped from the stack and used for indexing or comparing
-must have the same size as the integers in the descriptor.
-.S2 "Range check descriptors"
-Range check descriptors consist of two integers:
-.IS 2
-.PS 1 4 "" .
-.PT
-lower bound~~~~~~~signed
-.PT
-upper bound~~~~~~~signed
-.PE
-.IE
-The range check instruction checks an integer on the stack against
-these bounds and causes a trap if the value is outside the interval.
-The value itself is neither changed nor removed from the stack.
-.S2 "Array descriptors"
-Each array descriptor describes a single dimension.
-For multi-dimensional arrays, several array instructions are
-needed to access a single element.
-Array descriptors contain the following three integers:
-.IS 2
-.PS 1 4 "" .
-.PT
-lower bound~~~~~~~~~~~~~~~~~~~~~signed
-.PT
-upper bound - lower bound~~~~~~~unsigned
-.PT
-number of bytes per element~~~~~unsigned
-.PE
-.IE
-The array instructions LAR, SAR and AAR have the pointer to the start
-of the descriptor as operand on the stack.
-.sp
-The element A[I] is fetched as follows:
-.IS 2
-.PS 1 4 "" .
-.PT
-Stack the address of A (e.g., using LAE or LAL)
-.PT
-Stack the value of I (n-byte integer)
-.PT
-Stack the pointer to the descriptor (e.g., using LAE)
-.PT
-LAR n (n is the size of the integers in the descriptor and I)
-.PE
-.IE
-All array instructions first pop the address of the descriptor
-and the index.
-If the index is not within the bounds specified, a trap occurs.
-If ok, (I~-~lower bound) is multiplied
-by the number of bytes per element (the third word). The result is added
-to the address of A and replaces A on the stack.
-.A
-At this point LAR, SAR and AAR diverge.
-AAR is finished. LAR pops the address and fetches the data
-item,
-the size being specified by the descriptor.
-The usual restrictions for memory access must be obeyed.
-SAR pops the address and stores the
-data item now exposed.
-.S2 "Non-local goto descriptors"
-The GTO instruction provides a way of returning directly to any
-active procedure invocation.
-The argument of the instruction is the address of a descriptor
-containing three pointers:
-.IS 2
-.PS 1 4 "" .
-.PT
-value of PC after the jump
-.PT
-value of SP after the jump
-.PT
-value of LB after the jump
-.PE
-.IE
-GTO replaces the loads PC, SP and LB from the descriptor,
-thereby jumping to a procedure
-and removing zeor or more frames from the stack.
-The LB, SP and PC in the descriptor must belong to a
-dynamically enclosing procedure,
-because some EM implementations will need to backtrack through
-the dynamic chain and use the implementation dependent data
-in frames to restore registers etc.
-.S2 "Case descriptors"
-The case jump instructions CSA and CSB both
-provide multiway branches selected by a case index.
-Both fetch two operands from the stack:
-first a pointer to the low address of the case descriptor
-and then the case index.
-CSA uses the case index as index in the descriptor table, but CSB searches
-the table for an occurrence of the case index.
-Therefore, the descriptors for CSA and CSB,
-as shown in figure 4, are different.
-All pointers in the table must be addresses of instructions in the
-procedure executing the case instruction.
-.P
-CSA selects the new PC by indexing.
-If the index, a signed integer, is greater than or equal to
-the lower bound and less than or equal to the upper bound,
-then fetch the new PC from the list of instruction pointers by indexing with
-index-lower.
-The table does not contain the value of the upper bound,
-but the value of upper-lower as an unsigned integer.
-If the index is out of bounds or if the fetched pointer is 0,
-then fetch the default instruction pointer.
-If the resulting PC is 0, then trap.
-.P
-CSB selects the new PC by searching.
-The table is searched for an entry with index value equal to the case index.
-That entry or, if none is found, the default entry contains the
-new PC.
-When the resulting PC is 0, a trap is performed.
-.P
-The choice of which case instruction to use for
-each source language case statement
-is up to the front end.
-If the range of the index value is dense, i.e
-.DS
-(highest value - lowest value) / number of cases
-.DE 1
-is less than some threshold, then CSA is the obvious choice.
-If the range is sparse, CSB is better.
-.N 2
-.DS
- |--------------------| |--------------------| high address
- | pointer for upb | | pointer n-1 |
- |--------------------| |- - - - - - - |
- | . | | index n-1 |
- | . | |--------------------|
- | . | | . |
- | . | | . |
- | . | | . |
- | . | |--------------------|
- | . | | pointer 1 |
- |--------------------| |- - - - - - - |
- | pointer for lwb+1 | | index 1 |
- |--------------------| |--------------------|
- | pointer for lwb | | pointer 0 |
- |--------------------| |- - - - - - - |
- | upper - lower | | index 0 |
- |--------------------| |--------------------|
- | lower bound | | number of entries |
- |--------------------| |--------------------|
- | default pointer | | default pointer | low address
- |--------------------| |--------------------|
-
- CSA descriptor CSB descriptor
-
-
- Figure 4. Descriptor layout for CSA and CSB
-.DE
+++ /dev/null
-.BP
-.SN 4
-.S1 "DATA ADDRESS SPACE"
-The data address space is divided into three parts, called 'areas',
-each with its own addressing method:
-global data area,
-local data area (including the stack),
-and heap data area.
-These data areas must be part of the same
-address space because all data is accessed by
-the same type of pointers.
-.P
-Space for global data is reserved using several pseudoinstructions in the
-assembly language, as described in
-the next paragraph and chapter 11.
-The size of the global data area is fixed per program.
-.A
-Global data is addressed absolutely in the machine language.
-Many instructions are available to address global data.
-They all have an absolute address as argument.
-Examples are LOE, LAE and STE.
-.P
-Part of the global data area is initialized by the
-compiler, the
-rest is not initialized at all or is initialized
-with a value, typically -32768 or 0.
-Part of the initialized global data may be made read-only
-if the implementation supports protection.
-.P
-The local data area is used as a stack,
-which grows from high to low addresses
-and contains some data for each active procedure
-invocation, called a 'frame'.
-The size of the local data area varies dynamically during
-execution.
-Below the current procedure frame resides the operand stack.
-The stack pointer SP always points to the bottom of
-the local data area.
-Local data is addressed by offsetting from the local base pointer LB.
-LB always points to the frame of the current procedure.
-Only the words of the current frame and the parameters
-can be addressed directly.
-Variables in other active procedures are addressed by following
-the chain of statically enclosing procedures using the LXL or LXA instruction.
-The variables in dynamically enclosing procedures can be
-addressed with the use of the DCH instruction.
-.A
-Many instructions have offsets to LB as argument,
-for instance LOL, LAL and STL.
-The arguments of these instructions range from -1 to some
-(negative) minimum
-for the access of local storage and from 0 to some (positive)
-maximum for parameter access.
-.P
-The procedure call instructions CAL and CAI each create a new frame
-on the stack.
-Each procedure has an assembly-time parameter specifying
-the number of bytes needed for local storage.
-This storage is allocated each time the procedure is called and
-must be a multiple of the wordsize.
-Each procedure, therefore, starts with a stack with the local variables
-already allocated.
-The return instructions RET and RTT remove a frame.
-The actual parameters must be removed by the calling procedure.
-.P
-RET may copy some words from the stack of
-the returning procedure to an unnamed 'function return area'.
-This area is available for 'READ-ONCE' access using the LFR instruction.
-The result of a LFR is only defined if the size used to fetch
-is identical to the size used in the last return.
-The instruction ASP, used to remove the parameters from the
-stack, the branch instruction BRA and the non-local goto
-instrucion GTO are the only ones that leave the contents of
-the 'function return area' intact.
-All other instructions are allowed to destroy the function
-return area.
-Thus parameters can be popped before fetching the function result.
-The maximum size of all function return areas is
-implementation dependent,
-but should allow procedure instance identifiers and all
-implemented objects of type integer, unsigned, float
-and pointer to be returned.
-In most implementations
-the maximum size of the function return
-area is twice the pointer size,
-because we want to be able to handle 'procedure instance
-identifiers' which consist of a procedure identifier and the LB
-of a frame belonging to that procedure.
-.P
-The heap data area grows upwards, to higher numbered
-addresses.
-It is initially empty.
-The initial value of the heap pointer HP
-marks the low end.
-The heap pointer may be manipulated
-by the LOR and STR instructions.
-The heap can only be addressed indirectly,
-by pointers derived from previous values of HP.
-.S2 "Global data area"
-The initial size of the global data area is determined at assembly time.
-Global data is allocated by several
-pseudoinstructions in the EM assembly
-language.
-Each pseudoinstruction allocates one or more bytes.
-The bytes allocated for a single pseudo form
-a 'block'.
-A block differs from a fragment, because,
-under certain conditions, several blocks are allocated
-in a single fragment.
-This guarantees that the bytes of these blocks
-are consecutive.
-.P
-Global data is addressed absolutely in binary
-machine language.
-Most compilers, however,
-cannot assign absolute addresses to their global variables,
-especially not if the language
-allows programs to be composed of several separately compiled modules.
-The assembly language therefore allows the compiler to name
-the first address of a global data block with an alphanumeric label.
-Moreover, the only way to address such a named global data block
-in the assembly language is by using its name.
-It is the task of the assembler/loader to
-translate these labels into absolute addresses.
-These labels may also be used
-in CON and ROM pseudoinstructions to initialize pointers.
-.P
-The pseudoinstruction CON allocates initialized data.
-ROM acts like CON but indicates that the initialized data will
-not change during execution of the program.
-The pseudoinstruction BSS allocates a block of uninitialized
-or identically initialized
-data.
-The pseudoinstruction HOL is similar to BSS,
-but it alters the meaning of subsequent absolute addressing in
-the assembly language.
-.P
-Another type of global data is a small block,
-called the ABS block, with an implementation defined size.
-Storage in this type of block can only be addressed
-absolutely in assembly language.
-The first word has address 0 and is used to maintain the
-source line number.
-Special instructions LIN and LNI are provided to
-update this counter.
-A pointer at location 4 points to a string containing the
-current source file name.
-The instruction FIL can be used to update the pointer.
-.P
-All numeric arguments of the instructions that address
-the global data area refer to locations in the
-ABS block unless
-they are preceded by at least one HOL pseudo in the same
-module,
-in which case they refer to the storage area allocated by the
-last HOL pseudoinstruction.
-Thus LOE 0 loads the zeroth word of the most recent HOL, unless no HOL has
-appeared in the current file so
-far, in which case it loads the zeroth word of the
-ABS fragment.
-.P
-The global data area is highly fragmented.
-The ABS block and each HOL and BSS block are separate fragments.
-The way fragments are formed from CON and ROM blocks is more complex.
-The assemblers group several blocks into a single fragment.
-A fragment only contains blocks of the same type: CON or ROM.
-It is guaranteed that the bytes allocated for two consecutive CON pseudos are
-allocated consecutively in a single fragment, unless
-these CON pseudos are separated in the assembly language program
-by a data label definition or one or more of the following pseudos:
-.DS
-
- ROM, BSS, HOL and END
-
-.DE
-An analogous rule holds for ROM pseudos.
-.S2 "Local data area"
-The local data area consists of a sequence of frames, one for
-each active procedure.
-Below the frame of the current procedure resides the
-expression stack.
-Frames are generated by procedure calls and are
-removed by procedure returns.
-A procedure frame consists of six 'zones':
-.DS
-
- 1. The return status block
- 2. The local variables and compiler temporaries
- 3. The register save block
- 4. The dynamic local generators
- 5. The operand stack.
- 6. The parameters of a procedure one level deeper
-
-.DE
-A sample frame is shown in Figure 1.
-.P
-Before a procedure call is performed the actual
-parameters are pushed onto the stack of the calling procedure.
-The exact details are compiler dependent.
-EM allows procedures to be called with a variable number of
-parameters.
-The implementation of the C-language almost forces its runtime
-system to push the parameters in reverse order, that is,
-the first positional parameter last.
-Most compilers use the C calling convention to be compatible.
-The parameters of a procedure belong to the frame of the
-calling procedure.
-Note that the evaluation of the actual parameters may imply
-the calling of procedures.
-The parameters can be accessed with certain instructions using
-offsets of 0 and greater.
-The first byte of the last parameter pushed has offset 0.
-Note that the parameter at offset 0 has a special use in the
-instructions following the static chain (LXL and LXA).
-These instructions assume that this parameter contains the LB of
-the statically enclosing procedure.
-Procedures that do not have a dynamically enclosing procedure
-do not need a static link at offset 0.
-.P
-Two instructions are available to perform procedure calls, CAL
-and CAI.
-Several tasks are performed by these call instructions.
-.A
-First, a part of the status of the calling procedure is
-saved on the stack in the return status block.
-This block should contain the return address of the calling
-procedure, its LB and other implementation dependent data.
-The size of this block is fixed for any given implementation
-because the lexical instructions LPB, LXL and LXA must be able to
-obtain the base addresses of the procedure parameters \fBand\fP local
-variables.
-An alternative solution can be used on machines with a highly
-segmented address space.
-The stack frames need not be contiguous then and the first
-status save area can contain the parameter base AB,
-which has the value of SP just after the last parameter has
-been pushed.
-.A
-Second, the LB is changed to point to the
-first word above the local variables.
-The new LB is a copy of the SP after the return status
-block has been pushed.
-.A
-Third, the amount of local storage needed by the procedure is
-reserved.
-The parameters and local storage are accessed by the same instructions.
-Negative offsets are used for access to local variables.
-The highest byte, that is the byte nearest
-to LB, has to be accessed with offset -1.
-The pseudoinstruction specifying the entry point of a
-procedure, has an argument that specifies the amount of local
-storage needed.
-The local variables allocated by the CAI or CAL instructions
-are the only ones that can be accessed with a fixed negative offset.
-The initial value of the allocated words is
-not defined, but implementations that check for undefined
-values will probably initialize them with a
-special 'undefined' pattern, typically -32768.
-.A
-Fourth, any EM implementation is allowed to reserve a variable size
-block beneath the local variables.
-This block could, for example, be used to save a variable number
-of registers.
-.A
-Finally, the address of the entry point of the called procedure
-is loaded into the Program Counter.
-.P
-The ASP instruction can be used to allocate further (dynamic)
-local storage.
-The base address of such storage must be obtained with a LOR~SP
-instruction.
-This same instruction ASP may also be used
-to remove some words from the stack.
-.P
-There is a version of ASP, called ASS, which fetches the number
-of bytes to allocate from the stack.
-It can be used to allocate space for local
-objects whose size is unknown at compile time,
-so called 'dynamic local generators'.
-.P
-Control is returned to the calling procedure with a RET instruction.
-Any return value is then copied to the 'function return area'.
-The frame created by the call is deallocated and the status of
-the calling procedure is restored.
-The value of SP just after the return value has been popped must
-be the same as the
-value of SP just before executing the first instruction of this
-invocation.
-This means that when a RET is executed the operand stack can
-only contain the return value and all dynamically generated locals must be
-deallocated.
-Violating this restriction might result in hard to detect
-errors.
-The calling procedure has to remove the parameters from the stack.
-This can be done with the aforementioned ASP instruction.
-.P
-Each procedure frame is a separate fragment.
-Because any fragment may be placed anywhere in memory,
-procedure frames need not be contiguous.
-.DS
- |===============================|
- | actual parameter n-1 |
- |-------------------------------|
- | . |
- | . |
- | . |
- |-------------------------------|
- | actual parameter 0 | ( <- AB )
- |===============================|
-
-
- |===============================|
- |///////////////////////////////|
- |///// return status block /////|
- |///////////////////////////////| <- LB
- |===============================|
- | |
- | local variables |
- | |
- |-------------------------------|
- | |
- | compiler temporaries |
- | |
- |===============================|
- |///////////////////////////////|
- |///// register save block /////|
- |///////////////////////////////|
- |===============================|
- | |
- | dynamic local generators |
- | |
- |===============================|
- | operand |
- |-------------------------------|
- | operand |
- |===============================|
- | parameter m-1 |
- |-------------------------------|
- | . |
- | . |
- | . |
- |-------------------------------|
- | parameter 0 | <- SP
- |===============================|
-
- Figure 1. A sample procedure frame and parameters.
-.DE
-.S2 "Heap data area"
-The heap area starts empty, with HP
-pointing to the low end of it.
-HP always contains a word address.
-A copy of HP can always be obtained with the LOR instruction.
-A new value may be stored in the heap pointer using the STR instruction.
-If the new value is greater than the old one,
-then the heap grows.
-If it is smaller, then the heap shrinks.
-HP may never point below its original value.
-All words between the current HP and the original HP
-are allocated to the heap.
-The heap may not grow into a part of memory that is already allocated
-for the stack.
-When this is attempted, the STR instruction will cause a trap to occur.
-.P
-The only way to address the heap is indirectly.
-Whenever an object is allocated by increasing HP,
-then the old HP value must be saved and can be used later to address
-the allocated object.
-If, in the meantime, HP is decreased so that the object
-is no longer part of the heap, then an attempt to access
-the object is not allowed.
-Furthermore, if the heap pointer is increased again to above
-the object address, then access to the old object gives undefined results.
-.P
-The heap is a single fragment.
-All bytes have consecutive addresses.
-No limits are imposed on the size of the heap as long as it fits
-in the available data address space.
+++ /dev/null
-{ This is an interpreter for EM. It serves as the official machine
- definition. This interpreter must run on a machine which supports
- arithmetic with words and memory offsets.
-
- Certain aspects of the definition are over specified. In particular:
-
- 1. The representation of an address on the stack need not be the
- numerical value of the memory location.
-
- 2. The state of the stack is not defined after a trap has aborted
- an instruction in the middle. For example, it is officially un-
- defined whether the second operand of an ADD instruction has
- been popped or not if the first one is undefined ( -32768 or
- unsigned 32768).
-
- 3. The memory layout is implementation dependent. Only the most
- basic checks are performed whenever memory is accessed.
-
- 4. The representation of an integer or set on the stack is not fixed
- in bit order.
-
- 5. The format and existence of the procedure descriptors depends on
- the implementation.
-
- 6. The result of the compare operators CMI etc. are -1, 0 and 1
- here, but other negative and positive values will do and they
- need not be the same each time.
-
- 7. The shift count for SHL, SHR, ROL and ROR must be in the range 0
- to object size in bits - 1. The effect of a count not in this
- range is undefined.
-}
-.BP
-{$i256} {$d+}
-program em(tables,prog,input,output);
-
-label 8888,9999;
-
-const
- t15 = 32768; { 2**15 }
- t15m1 = 32767; { 2**15 -1 }
- t16 = 65536; { 2**16 }
- t16m1 = 65535; { 2**16 -1 }
- t31m1 = 2147483647; { 2**31 -1 }
-
- wsize = 2; { number of bytes in a word }
- asize = 2; { number of bytes in an address }
- fsize = 4; { number of bytes in a floating point number }
- maxret =4; { number of words in the return value area }
-
- signbit = t15; { the power of two indicating the sign bit }
- negoff = t16; { the next power of two }
- maxsint = t15m1; { the maximum signed integer }
- maxuint = t16m1; { the maximum unsigned integer }
- maxdbl = t31m1; { the maximum double signed integer }
- maxadr = t16m1; { the maximum address }
- maxoffs = t15m1; { the maximum offset from an address }
- maxbitnr= 15; { the number of the highest bit }
-
- lineadr = 0; { address of the line number }
- fileadr = 4; { address of the file name }
- maxcode = 8191; { highest byte in code address space }
- maxdata = 8191; { highest byte in data address space }
-
- { format of status save area }
- statd = 4; { how far is static link from lb }
- dynd = 2; { how far is dynamic link from lb }
- reta = 0; { how far is the return address from lb }
- savsize = 4; { size of save area in bytes }
-
- { procedure descriptor format }
- pdlocs = 0; { offset for size of local variables in bytes }
- pdbase = asize; { offset for the procedure base }
- pdsize = 4; { size of procedure descriptor in bytes = 2*asize }
-
- { header words }
- NTEXT = 1;
- NDATA = 2;
- NPROC = 3;
- ENTRY = 4;
- NLINE = 5;
- SZDATA = 6;
-
- escape1 = 254; { escape to secondary opcodes }
- escape2 = 255; { escape to tertiary opcodes }
- undef = signbit; { the range of integers is -32767 to +32767 }
-
- { error codes }
- EARRAY = 0; ERANGE = 1; ESET = 2; EIOVFL = 3; EFOVFL = 4;
- EFUNFL = 5; EIDIVZ = 6; EFDIVZ = 7; EIUND = 8; EFUND = 9;
- ECONV = 10; ESTACK = 16; EHEAP = 17; EILLINS = 18; EODDZ = 19;
- ECASE = 20; EMEMFLT = 21; EBADPTR = 22; EBADPC = 23; EBADLAE = 24;
- EBADMON = 25; EBADLIN = 26; EBADGTO = 27;
-.ne 20
-.bp
-{---------------------------------------------------------------------------}
-{ Declarations }
-{---------------------------------------------------------------------------}
-
-type
- bitval= 0..1; { one bit }
- bitnr= 0..maxbitnr; { bits in machine words are numbered 0 to 15 }
- byte= 0..255; { memory is an array of bytes }
- adr= {0..maxadr} long; { the range of addresses }
- word= {0..maxuint} long;{ the range of unsigned integers }
- offs= -maxoffs..maxoffs; { the range of signed offsets from addresses }
- size= 0..maxoffs; { the range of sizes is the positive offsets }
- sword= {-signbit..maxsint} long; { the range of signed integers }
- full= {-maxuint..maxuint} long; { intermediate results need this range }
- double={-maxdbl..maxdbl} long; { double precision range }
- bftype= (andf,iorf,xorf); { tells which boolean operator needed }
- insclass=(prim,second,tert); { tells which opcode table is in use }
- instype=(implic,explic); { does opcode have implicit or explicit operand }
- iflags= (mini,short,sbit,wbit,zbit,ibit);
- ifset= set of iflags;
-
- mnem = ( NON,
- AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ,
- BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL,
- CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS,
- CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE,
- DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL,
- GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC,
- LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE,
- LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF,
- MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU,
- ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF,
- SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE,
- STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT,
- TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE,
- ZRE, ZRF, ZRL);
-
- dispatch = record
- iflag: ifset;
- instr: mnem;
- case instype of
- implic: (implicit:sword);
- explic: (ilength:byte);
- end;
-
-
-var
- code: packed array[0..maxcode] of byte; { code space }
- data: packed array[0..maxdata] of byte; { data space }
- retarea: array[1..maxret ] of word; { return area }
- pc,lb,sp,hp,pd: adr; { internal machine registers }
- i: integer; { integer scratch variable }
- s,t :word; { scratch variables }
- sz:size; { scratch variables }
- ss,st: sword; { scratch variables }
- k :double; { scratch variables }
- j:size; { scratch variable used as index }
- a,b:adr; { scratch variable used for addresses }
- dt,ds:double; { scratch variables for double precision }
- rt,rs,x,y:real; { scratch variables for real }
- found:boolean; { scratch }
- opcode: byte; { holds the opcode during execution }
- iclass: insclass; { true for escaped opcodes }
- dispat: array[insclass,byte] of dispatch;
- retsize:size; { holds size of last LFR }
- insr: mnem; { holds the instructionnumber }
- halted: boolean; { normally false }
- exitstatus:word; { parameter of MON 1 }
- ignmask:word; { ignore mask for traps }
- uerrorproc:adr; { number of user defined error procedure }
- intrap:boolean; { Set when executing trap(), to catch recursive calls}
- trapval:byte; { Set to number of last trap }
- header: array[1..8] of adr;
-
- tables: text; { description of EM instructions }
- prog: file of byte; { program and initialized data }
-.ne 20
-.sp 2
-{---------------------------------------------------------------------------}
-{ Various check routines }
-{---------------------------------------------------------------------------}
-
-{ Only the most basic checks are performed. These routines are inherently
- implementation dependent. }
-
-procedure trap(n:byte); forward;
-
-procedure memadr(a:adr);
-begin if (a>maxdata) or ((a<sp) and (a>=hp)) then trap(EMEMFLT) end;
-
-procedure wordadr(a:adr);
-begin memadr(a); if (a mod wsize<>0) then trap(EBADPTR) end;
-
-procedure chkadr(a:adr; s:size);
-begin memadr(a); memadr(a+s-1); { assumption: size is ok }
- if s<wsize
- then begin if a mod s<>0 then trap(EBADPTR) end
- else if a mod wsize<>0 then trap(EBADPTR)
-end;
-
-procedure newpc(a:double);
-begin if (a<0) or (a>maxcode) then trap(EBADPC); pc:=a end;
-
-procedure newsp(a:adr);
-begin if (a>lb) or (a<hp) or (a mod wsize<>0) then trap(ESTACK); sp:=a end;
-
-procedure newlb(a:adr);
-begin if (a<sp) or (a mod wsize<>0) then trap(ESTACK); lb:=a end;
-
-procedure newhp(a:adr);
-begin if (a>sp) or (a>maxdata+1) or (a mod wsize<>0)
- then trap(EHEAP); hp:=a
-end;
-
-function argc(a:double):sword;
-begin if (a<-signbit) or (a>maxsint) then trap(EILLINS); argc:=a end;
-
-function argd(a:double):double;
-begin if (a<-maxdbl) or (a>maxdbl) then trap(EILLINS); argd:=a end;
-
-function argl(a:double):offs;
-begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argl:=a end;
-
-function argg(k:double):adr;
-begin if (k<0) or (k>maxadr) then trap(EILLINS); argg:=k end;
-
-function argf(a:double):offs;
-begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argf:=a end;
-
-function argn(a:double):word;
-begin if (a<0) or (a>maxuint) then trap(EILLINS); argn:=a end;
-
-function args(a:double):size;
-begin if (a<=0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- args:=a ;
-end;
-
-function argz(a:double):size;
-begin if (a<0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- argz:=a ;
-end;
-
-function argo(a:double):size;
-begin if (a<0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize<>0) and (wsize mod a<>0) then trap(EODDZ);
- argo:=a ;
-end;
-
-function argw(a:double):size;
-begin if (a<=0) or (a>maxoffs) or (a>maxuint)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- argw:=a ;
-end;
-
-function argp(a:double):size;
-begin if (a<0) or (a>=header[NPROC]) then trap(EILLINS); argp:=a end;
-
-function argr(a:double):word;
-begin if (a<0) or (a>2) then trap(EILLINS); argr:=a end;
-
-procedure argwf(s:double);
-begin if argw(s)<>fsize then trap(EILLINS) end;
-
-function szindex(s:double):integer;
-begin s:=argw(s); if (s mod wsize <> 0) or (s>2*wsize) then trap(EILLINS);
- szindex:=s div wsize
-end;
-
-function locadr(l:double):adr;
-begin l:=argl(l); if l<0 then locadr:=lb+l else locadr:=lb+l+savsize end;
-
-function signwd(w:word):sword;
-begin if w = undef then trap(EIUND);
- if w >= signbit then signwd:=w-negoff else signwd:=w
-end;
-
-function dosign(w:word):sword;
-begin if w >= signbit then dosign:=w-negoff else dosign:=w end;
-
-function unsign(w:sword):word;
-begin if w<0 then unsign:=w+negoff else unsign:=w end;
-
-function chopw(dw:double):word;
-begin chopw:=dw mod negoff end;
-
-function fitsw(w:full;trapno:byte):word;
-{ checks whether value fits in signed word, returns unsigned representation}
-begin
- if (w>maxsint) or (w<-signbit) then
- begin trap(trapno);
- if w<0 then fitsw:=negoff- (-w)mod negoff
- else fitsw:=w mod negoff;
- end
- else fitsw:=unsign(w)
-end;
-
-function fitd(w:full):double;
-begin
- if abs(w) > maxdbl then trap(ECONV);
- fitd:=w
-end;
-.ne 20
-.sp 2
-{---------------------------------------------------------------------------}
-{ Memory access routines }
-{---------------------------------------------------------------------------}
-
-{ memw returns a machine word as an unsigned integer
- memb returns a single byte as a positive integer: 0 <= memb <= 255
- mems(a,s) fetches an object smaller than a word and returns a word
- store(a,v) stores the word v at machine address a
- storea(a,v) stores the address v at machine address a
- storeb(a,b) stores the byte b at machine address a
- stores(a,s,v) stores the s least significant bytes of a word at address a
- memi returns an offset from the instruction space
- Note that the procedure descriptors are part of instruction space.
- nextpc returns the next byte addressed by pc, incrementing pc
-
- lino changes the line number word.
- filna changes the pointer to the file name.
-
- All routines check to make sure the address is within range and valid for
- the size of the object. If an addressing error is found, a trap occurs.
-}
-
-
-function memw(a:adr):word;
-var b:word; i:integer;
-begin wordadr(a); b:=0;
- for i:=wsize-1 downto 0 do b:=256*b + data[a+i] ;
- memw:=b
-end;
-
-function memd(a:adr):double; { Always signed }
-var b:double; i:integer;
-begin wordadr(a); b:=data[a+2*wsize-1];
- if b>=128 then b:=b-256;
- for i:=2*wsize-2 downto 0 do b:=256*b + data[a+i] ;
- memd:=b
-end;
-
-function mema(a:adr):adr;
-var b:adr; i:integer;
-begin wordadr(a); b:=0;
- for i:=asize-1 downto 0 do b:=256*b + data[a+i] ;
- mema:=b
-end;
-
-function mems(a:adr;s:size):word;
-var i:integer; b:word;
-begin chkadr(a,s); b:=0; for i:=1 to s do b:=b*256+data[a+s-i]; mems:=b end;
-
-function memb(a:adr):byte;
-begin memadr(a); memb:=data[a] end;
-
-procedure store(a:adr; x:word);
-var i:integer;
-begin wordadr(a);
- for i:=0 to wsize-1 do
- begin data[a+i]:=x mod 256; x:=x div 256 end
-end;
-
-procedure storea(a:adr; x:adr);
-var i:integer;
-begin wordadr(a);
- for i:=0 to asize-1 do
- begin data[a+i]:=x mod 256; x:=x div 256 end
-end;
-
-procedure stores(a:adr;s:size;v:word);
-var i:integer;
-begin chkadr(a,s);
- for i:=0 to s-1 do begin data[a+i]:=v mod 256; v:=v div 256 end;
-end;
-
-procedure storeb(a:adr; b:byte);
-begin memadr(a); data[a]:=b end;
-
-function memi(a:adr):adr;
-var b:adr; i:integer;
-begin if (a mod wsize<>0) or (a+asize-1>maxcode) then trap(EBADPTR); b:=0;
- for i:=asize-1 downto 0 do b:=256*b + code[a+i] ;
- memi:=b
-end;
-
-function nextpc:byte;
-begin if pc>=pd then trap(EBADPC); nextpc:=code[pc]; newpc(pc+1) end;
-
-procedure lino(w:word);
-begin store(lineadr,w) end;
-
-procedure filna(a:adr);
-begin storea(fileadr,a) end;
-.ne 20
-.sp 2
-{---------------------------------------------------------------------------}
-{ Stack Manipulation Routines }
-{---------------------------------------------------------------------------}
-
-{ push puts a word on the stack
- pushsw takes a signed one word integer and pushes it on the stack
- pop removes a machine word from the stack and delivers it as a word
- popsw removes a machine word from the stack and delivers a signed integer
- pusha pushes an address on the stack
- popa removes a machine word from the stack and delivers it as an address
- pushd pushes a double precision number on the stack
- popd removes two machine words and returns a double precision integer
- pushr pushes a float (floating point) number on the stack
- popr removes several machine words and returns a float number
- pushx puts an object of arbitrary size on the stack
- popx removes an object of arbitrary size
- }
-
-procedure push(x:word);
-begin newsp(sp-wsize); store(sp,x) end;
-
-procedure pushsw(x:sword);
-begin newsp(sp-wsize); store(sp,unsign(x)) end;
-
-function pop:word;
-begin pop:=memw(sp); newsp(sp+wsize) end;
-
-function popsw:sword;
-begin popsw:=signwd(pop) end;
-
-procedure pusha(x:adr);
-begin newsp(sp-asize); storea(sp,x) end;
-
-function popa:adr;
-begin popa:=mema(sp); newsp(sp+asize) end;
-
-procedure pushd(y:double);
-begin { push double integer onto the stack } newsp(sp-2*wsize) end;
-
-function popd:double;
-begin { pop double integer from the stack } newsp(sp+2*wsize); popd:=0 end;
-
-procedure pushr(z:real);
-begin { Push a float onto the stack } newsp(sp-fsize) end;
-
-function popr:real;
-begin { pop float from the stack } newsp(sp+fsize); popr:=0.0 end;
-
-procedure pushx(objsize:size; a:adr);
-var i:integer;
-begin
- if objsize<wsize
- then push(mems(a,objsize))
- else for i:=1 to objsize div wsize do push(memw(a+objsize-wsize*i))
-end;
-
-procedure popx(objsize:size; a:adr);
-var i:integer;
-begin
- if objsize<wsize
- then stores(a,objsize,pop)
- else for i:=1 to objsize div wsize do store(a-wsize+wsize*i,pop)
-end;
-.ne 20
-.sp 2
-{---------------------------------------------------------------------------}
-{ Bit manipulation routines (extract, shift, rotate) }
-{---------------------------------------------------------------------------}
-
-procedure sleft(var w:sword); { 1 bit left shift }
-begin w:= dosign(fitsw(2*w,EIOVFL)) end;
-
-procedure suleft(var w:word); { 1 bit left shift }
-begin w := chopw(2*w) end;
-
-procedure sdleft(var d:double); { 1 bit left shift }
-begin { shift two word signed integer } end;
-
-procedure sright(var w:sword); { 1 bit right shift with sign extension }
-begin if w >= 0 then w := w div 2 else w := (w-1) div 2 end;
-
-procedure suright(var w:word); { 1 bit right shift without sign extension }
-begin w := w div 2 end;
-
-procedure sdright(var d:double); { 1 bit right shift }
-begin { shift two word signed integer } end;
-
-procedure rleft(var w:word); { 1 bit left rotate }
-begin if w >= t15
- then w:=(w-t15)*2 + 1
- else w:=w*2
-end;
-
-procedure rright(var w:word); { 1 bit right rotate }
-begin if w mod 2 = 1
- then w:=w div 2 + t15
- else w:=w div 2
-end;
-
-function sextend(w:word;s:size):word;
-var i:size;
-begin
- for i:=1 to (wsize-s)*8 do rleft(w);
- for i:=1 to (wsize-s)*8 do sright(w);
- sextend:=w;
-end;
-
-function bit(b:bitnr; w:word):bitval; { return bit b of the word w }
-var i:bitnr;
-begin for i:= 1 to b do rright(w); bit:= w mod 2 end;
-
-function bf(ty:bftype; w1,w2:word):word; { return boolean fcn of 2 words }
-var i:bitnr; j:word;
-begin j:=0;
- for i:= maxbitnr downto 0 do
- begin j := 2*j;
- case ty of
- andf: if bit(i,w1)+bit(i,w2) = 2 then j:=j+1;
- iorf: if bit(i,w1)+bit(i,w2) > 0 then j:=j+1;
- xorf: if bit(i,w1)+bit(i,w2) = 1 then j:=j+1
- end
- end;
- bf:=j
-end;
-
-{---------------------------------------------------------------------------}
-{ Array indexing
-{---------------------------------------------------------------------------}
-
-function arraycalc(c:adr):adr; { subscript calculation }
-var j:full; objsize:size; a:adr;
-begin j:= popsw - signwd(memw(c));
- if (j<0) or (j>memw(c+wsize)) then trap(EARRAY);
- objsize := argo(memw(c+wsize+wsize));
- a := j*objsize+popa; chkadr(a,objsize);
- arraycalc:=a
-end;
-.ne 20
-.sp 2
-{---------------------------------------------------------------------------}
-{ Double and Real Arithmetic }
-{---------------------------------------------------------------------------}
-
-{ All routines for doubles and floats are dummy routines, since the format of
- doubles and floats is not defined in EM.
-}
-
-function doadi(ds,dt:double):double;
-begin { add two doubles } doadi:=0 end;
-
-function dosbi(ds,dt:double):double;
-begin { subtract two doubles } dosbi:=0 end;
-
-function domli(ds,dt:double):double;
-begin { multiply two doubles } domli:=0 end;
-
-function dodvi(ds,dt:double):double;
-begin { divide two doubles } dodvi:=0 end;
-
-function dormi(ds,dt:double):double;
-begin { modulo of two doubles } dormi:=0 end;
-
-function dongi(ds:double):double;
-begin { negative of a double } dongi:=0 end;
-
-function doadf(x,y:real):real;
-begin { add two floats } doadf:=0.0 end;
-
-function dosbf(x,y:real):real;
-begin { subtract two floats } dosbf:=0.0 end;
-
-function domlf(x,y:real):real;
-begin { multiply two floats } domlf:=0.0 end;
-
-function dodvf(x,y:real):real;
-begin { divide two floats } dodvf:=0.0 end;
-
-function dongf(x:real):real;
-begin { negate a float } dongf:=0.0 end;
-
-procedure dofif(x,y:real;var intpart,fraction:real);
-begin { dismember x*y into integer and fractional parts }
- intpart:=0.0; { integer part of x*y, same sign as x*y }
- fraction:=0.0;
- { fractional part of x*y, 0<=abs(fraction)<1 and same sign as x*y }
-end;
-
-procedure dofef(x:real;var mantissa:real;var exponent:sword);
-begin { dismember x into mantissa and exponent parts }
- mantissa:=0.0; { mantissa of x , >= 1/2 and <1 }
- exponent:=0; { base 2 exponent of x }
-end;
-.bp
-{---------------------------------------------------------------------------}
-{ Trap and Call }
-{---------------------------------------------------------------------------}
-
-procedure call(p:adr); { Perform the call }
-begin
- pusha(lb);pusha(pc);
- newlb(sp);newsp(sp - memi(pd + pdsize*p + pdlocs));
- newpc(memi(pd + pdsize*p+ pdbase))
-end;
-
-procedure dotrap(n:byte);
-var i:size;
-begin
- if (uerrorproc=0) or intrap then
- begin
- if intrap then
- writeln('Recursive trap, first trap number was ', trapval:1);
- writeln('Error ', n:1);
- writeln('With',ord(insr):4,' arg ',k:1);
- goto 9999
- end;
- { Deposit all interpreter variables that need to be saved on
- the stack. This includes all scratch variables that can
- be in use at the moment and ( not possible in this interpreter )
- the internal address of the interpreter where the error occurred.
- This would make it possible to execute an RTT instruction totally
- transparent to the user program.
- It can, for example, occur within an ADD instruction that both
- operands are undefined and that the result overflows.
- Although this will generate 3 error traps it must be possible
- to ignore them all.
-}
- intrap:=true; trapval:=n;
- for i:=retsize div wsize downto 1 do push(retarea[i]);
- push(retsize); { saved return area }
- pusha(mema(fileadr)); { saved current file name pointer }
- push(memw(lineadr)); { saved line number }
- push(n); { push error number }
- a:=argp(uerrorproc);
- uerrorproc:=0; { reset signal }
- call(a); { call the routine }
- intrap:=false; { Don't catch recursive traps anymore }
- goto 8888; { reenter main loop }
-end;
-
-procedure trap;
-{ This routine is invoked for overflow, and other run time errors.
- For non-fatal errors, trap returns to the calling routine
-}
-begin
- if n>=16 then dotrap(n) else if bit(n,ignmask)=0 then dotrap(n);
-end;
-
-procedure dortt;
-{ The restoration of file address and line number is not essential.
- The restoration of the return save area is.
-}
-var i:size;
- n:word;
-begin
- newsp(lb); lb:=maxdata+1 ; { to circumvent ESTACK for the popa + pop }
- newpc(popa); newlb(popa); { So far a plain RET 0 }
- n:=pop; if (n>=16) and (n<64) then goto 9999 ;
- lino(pop); filna(popa); retsize:=pop;
- for i:=1 to retsize div wsize do retarea[i]:=pop ;
-end;
-.sp 2
-{---------------------------------------------------------------------------}
-{ monitor calls }
-{---------------------------------------------------------------------------}
-
-
-procedure domon(entry:word);
-var index: 1..63;
- dummy: double;
- count,rwptr: adr;
- token: byte;
- i: integer;
-begin
- if (entry<=0) or (entry>63) then entry:=63 ;
- index:=entry;
- case index of
- 1: begin { exit } exitstatus:=pop; halted:=true end;
- 3: begin { read } dummy:=pop; { All input is from stdin }
- rwptr:=popa; count:=popa;
- i:=0 ;
- while (not eof(input)) and (i<count) do
- begin
- if eoln(input) then begin storeb(rwptr,10) ; count:=i end
- else storeb(rwptr,ord(input^)) ;
- get(input); rwptr:=rwptr+1 ; i:=i+1 ;
- end;
- pusha(i); push(0)
- end;
- 4: begin { write } dummy:=pop; { All output is to stdout }
- rwptr:=popa; count:=popa;
- for i:=1 to count do
- begin token:=memb(rwptr); rwptr:=rwptr+1 ;
- if token=10 then writeln else write(chr(token))
- end ;
- pusha(count);
- push(0)
- end;
- 54: begin { ioctl, faked } dummy:=popa;dummy:=popa;dummy:=pop;push(0) end ;
- 2, 5, 6, 7, 8, 9, 10,
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
- 51, 52, 53, 55, 56, 57, 58, 59, 60,
- 61, 62:
- begin push(22); push(22) end;
- 63: { exists only for the trap }
- trap(EBADMON)
- end
-end;
-.bp
-{---------------------------------------------------------------------------}
-{ Initialization and debugging }
-{---------------------------------------------------------------------------}
-
-procedure doident; { print line number and file name }
-var a:adr; i,c:integer; found:boolean;
-begin
- write('at line ',memw(lineadr):1,' ');
- a:=mema(fileadr); if a<>0 then
- begin i:=20; found:=false;
- while (i<>0) and not found do
- begin c:=memb(a); a:=a+1; found:=true; i:=i-1;
- if (c>=48) and (c<=57) then
- begin found:=false; write(chr(ord('0')+c-48)) end;
- if (c>=65) and (c<=90) then
- begin found:=false; write(chr(ord('A')+c-65)) end;
- if (c>=97) and (c<=122) then
- begin found:=false; write(chr(ord('a')+c-97)) end;
- end;
- end;
- writeln;
-end;
-
-procedure initialize; { start the ball rolling }
-{ This is not part of the machine definition }
-var cset:set of char;
- f:ifset;
- iclass:insclass;
- insno:byte;
- nops:integer;
- opcode:byte;
- i,j,n:integer;
- wtemp:sword;
- count:integer;
- repc:adr;
- nexta,firsta:adr;
- elem:byte;
- amount,ofst:size;
- c:char;
-
- function readb(n:integer):double;
- var b:byte;
- begin read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b end;
-
- function readbyte:byte;
- begin readbyte:=readb(1) end;
-
- function readword:word;
- begin readword:=readb(wsize) end;
-
- function readadr:adr;
- begin readadr:=readb(asize) end;
-
- function ifind(ordinal:byte):mnem;
- var loopvar:mnem;
- found:boolean;
- begin ifind:=NON;
- loopvar:=insr; found:=false;
- repeat
- if ordinal=ord(loopvar) then
- begin found:=true; ifind:=loopvar end;
- if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON;
- until found or (loopvar=insr) ;
- end;
-
- procedure readhdr;
- type hdrw=0..32767 ; { 16 bit header words }
- var hdr: hdrw;
- i: integer;
- begin
- for i:=0 to 7 do
- begin hdr:=readb(2);
- case i of
- 0: if hdr<>3757 then { 07255 }
- begin writeln('Not an em load file'); halt end;
- 2: if hdr<>0 then
- begin writeln('Unsolved references'); halt end;
- 3: if hdr<>3 then
- begin writeln('Incorrect load file version'); halt end;
- 4: if hdr<>wsize then
- begin writeln('Incorrect word size'); halt end;
- 5: if hdr<>asize then
- begin writeln('Incorrect pointer size'); halt end;
- 1,6,7:;
- end
- end
- end;
-
- procedure noinit;
- begin writeln('Illegal initialization'); halt end;
-
- procedure readint(a:adr;s:size);
- var i:size;
- begin { construct integer out of byte sequence }
- for i:=1 to s do { construct the value and initialize at a }
- begin storeb(a,readbyte); a:=a+1 end
- end;
-
- procedure readuns(a:adr;s:size);
- begin { construct unsigned out of byte sequence }
- readint(a,s) { identical to readint }
- end;
-
- procedure readfloat(a:adr;s:size);
- var i:size; b:byte;
- begin { construct float out of string}
- if (s<>4) and (s<>8) then noinit; i:=0;
- repeat { eat the bytes, construct the value and intialize at a }
- b:=readbyte; i:=i+1;
- until b=0 ;
- end;
-
-begin
- halted:=false;
- exitstatus:=undef;
- uerrorproc:=0; intrap:=false;
-
- { initialize tables }
- for i:=0 to maxcode do code[i]:=0;
- for i:=0 to maxdata do data[i]:=0;
- for iclass:=prim to tert do
- for i:=0 to 255 do
- with dispat[iclass][i] do
- begin instr:=NON; iflag:=[zbit] end;
-
- { read instruction table file. see appendix B }
- { The table read here is a simple transformation of the table on page xx }
- { - instruction names were transformed to numbers }
- { - the '-' flag was transformed to an 'i' flag for 'w' type instructions }
- { - the 'S' flag was added for instructions having signed operands }
- reset(tables);
- insr:=NON;
- repeat
- read(tables,insno) ; cset:=[]; f:=[];
- insr:=ifind(insno);
- if insr=NON then begin writeln('Incorrect table'); halt end;
- repeat read(tables,c) until c<>' ' ;
- repeat
- cset:=cset+[c];
- read(tables,c)
- until c=' ' ;
- if 'm' in cset then f:=f+[mini];
- if 's' in cset then f:=f+[short];
- if '-' in cset then f:=f+[zbit];
- if 'i' in cset then f:=f+[ibit];
- if 'S' in cset then f:=f+[sbit];
- if 'w' in cset then f:=f+[wbit];
- if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ;
- readln(tables,opcode);
- if ('4' in cset) or ('8' in cset) then
- begin iclass:=tert end
- else if 'e' in cset then
- begin iclass:=second end
- else iclass:=prim;
- for i:=0 to nops-1 do
- begin
- with dispat[iclass,opcode+i] do
- begin
- iflag:=f; instr:=insr;
- if '2' in cset then ilength:=2
- else if '4' in cset then ilength:=4
- else if '8' in cset then ilength:=8
- else if (mini in f) or (short in f) then
- begin
- if 'N' in cset then wtemp:=-1-i else wtemp:=i ;
- if 'o' in cset then wtemp:=wtemp+1 ;
- if short in f then wtemp:=wtemp*256 ;
- implicit:=wtemp
- end
- end
- end
- until eof(tables);
-
- { read in program text, data and procedure descriptors }
- reset(prog);
- readhdr; { verify first header }
- for i:=1 to 8 do header[i]:=readadr; { read second header }
- hp:=maxdata+1; sp:=maxdata+1; lino(0);
- { read program text }
- if header[NTEXT]+header[NPROC]*pdsize>maxcode then
- begin writeln('Text size too large'); halt end;
- if header[SZDATA]>maxdata then
- begin writeln('Data size too large'); halt end;
- for i:=0 to header[NTEXT]-1 do code[i]:=readbyte;
- { read data blocks }
- nexta:=0;
- for i:=1 to header[NDATA] do
- begin
- n:=readbyte;
- if n<>0 then
- begin
- elem:=readbyte; firsta:=nexta;
- case n of
- 1: { uninitialized words }
- for j:=1 to elem do
- begin store(nexta,undef); nexta:=nexta+wsize end;
- 2: { initialized bytes }
- for j:=1 to elem do
- begin storeb(nexta,readbyte); nexta:=nexta+1 end;
- 3: { initialized words }
- for j:=1 to elem do
- begin store(nexta,readword); nexta:=nexta+wsize end;
- 4,5: { instruction and data pointers }
- for j:=1 to elem do
- begin storea(nexta,readadr); nexta:=nexta+asize end;
- 6: { signed integers }
- begin readint(nexta,elem); nexta:=nexta+elem end;
- 7: { unsigned integers }
- begin readuns(nexta,elem); nexta:=nexta+elem end;
- 8: { floating point numbers }
- begin readfloat(nexta,elem); nexta:=nexta+elem end;
- end
- end
- else
- begin
- repc:=readadr; amount:=nexta-firsta;
- for count:=1 to repc do
- begin
- for ofst:=0 to amount-1 do data[nexta+ofst]:=data[firsta+ofst];
- nexta:=nexta+amount;
- end
- end
- end;
- if header[SZDATA]<>nexta then writeln('Data initialization error');
- hp:=nexta;
- { read descriptor table }
- pd:=header[NTEXT];
- for i:=1 to header[NPROC]*pdsize do code[pd+i-1]:=readbyte;
- { call the entry point routine }
- ignmask:=0; { catch all traps, higher numbered traps cannot be ignored}
- retsize:=0;
- lb:=maxdata; { illegal dynamic link }
- pc:=maxcode; { illegal return address }
- push(0); a:=sp; { No environment }
- push(0); b:=sp; { No args }
- pusha(a); { envp }
- pusha(b); { argv }
- push(0); { argc }
- call(argp(header[ENTRY]));
-end;
-.bp
-{---------------------------------------------------------------------------}
-{ MAIN LOOP OF THE INTERPRETER }
-{---------------------------------------------------------------------------}
-{ It should be noted that the interpreter (microprogram) for an EM
- machine can be written in two fundamentally different ways: (1) the
- instruction operands are fetched in the main loop, or (2) the in-
- struction operands are fetched after the 256 way branch, by the exe-
- cution routines themselves. In this interpreter, method (1) is used
- to simplify the description of execution routines. The dispatch
- table dispat is used to determine how the operand is encoded. There
- are 4 possibilities:
-
- 0. There is no operand
- 1. The operand and instruction are together in 1 byte (mini)
- 2. The operand is one byte long and follows the opcode byte(s)
- 3. The operand is two bytes long and follows the opcode byte(s)
- 4. The operand is four bytes long and follows the opcode byte(s)
-
- In this interpreter, the main loop determines the operand type,
- fetches it, and leaves it in the global variable k for the execution
- routines to use. Consequently, instructions such as LOL, which use
- three different formats, need only be described once in the body of
- the interpreter.
- However, for a production interpreter, or a hardware EM
- machine, it is probably better to use method (2), i.e. to let the
- execution routines themselves fetch their own operands. The reason
- for this is that each opcode uniquely determines the operand format,
- so no table lookup in the dispatch table is needed. The whole table
- is not needed. Method (2) therefore executes much faster.
- However, separate execution routines will be needed for LOL with
- a one byte offset, and LOL with a two byte offset. It is to avoid
- this additional clutter that method (1) is used here. In a produc-
- tion interpreter, it is envisioned that the main loop will fetch the
- next instruction byte, and use it as an index into a 256 word table
- to find the address of the interpreter routine to jump to. The
- routine jumped to will begin by fetching its operand, if any,
- without any table lookup, since it knows which format to expect.
- After doing the work, it returns to the main loop by jumping in-
- directly to a register that contains the address of the main loop.
- A slight variation on this idea is to have the register contain
- the address of the branch table, rather than the address of the main
- loop.
- Another issue is whether the execution routines for LOL 0, LOL
- 2, LOL 4, etc. should all be have distinct execution routines. Doing
- so provides for the maximum speed, since the operand is implicit in
- the routine itself. The disadvantage is that many nearly identical
- execution routines will then be needed. Another way of doing it is
- to keep the instruction byte fetched from memory (LOL 0, LOL 2, LOL
- 4, etc.) in some register, and have all the LOL mini format instruc-
- tions branch to a common routine. This routine can then determine
- the operand by subtracting the code for LOL 0 from the register,
- leaving the true operand in the register (as a word quantity of
- course). This method makes the interpreter smaller, but is a bit
- slower.
-.bp
- To make this important point a little clearer, consider how a
- production interpreter for the PDP-11 might appear. Let us assume the
- following opcodes have been assigned:
-
- 31: LOL -2 (2 bytes, i.e. next word)
- 32: LOL -4
- 33: LOL -6
- 34: LOL b (format with a one byte offset)
- 35: LOL w (format with a one word, i.e. two byte offset)
-
- Further assume that each of the 5 opcodes will have its own execution
- routine, i.e. we are making a tradeoff in favor of fast execution and
- a slightly larger interpreter.
- Register r5 is the em program counter.
- Register r4 is the em LB register
- Register r3 is the em SP register (the stack grows toward low core)
- Register r2 contains the interpreter address of the main loop
-
- The main loop looks like this:
-
- movb (r5)+,r0 /fetch the opcode into r0 and increment r5
- asl r0 /shift r0 left 1 bit. Now: -256<=r0<=+254
- jmp *table(r0) /jump to execution routine
-
- Notice that no operand fetching has been done. The execution routines for
- the 5 sample instructions given above might be as follows:
-
- lol2: mov -2(r4),-(sp) /push local -2 onto stack
- jmp (r2) /go back to main loop
- lol4: mov -4(r4),-(sp) /push local -4 onto stack
- jmp (r2) /go back to main loop
- lol6: mov -6(r4),-(sp) /push local -6 onto stack
- jmp (r2) /go back to main loop
- lolb: mov $177400,r0 /prepare to fetch the 1 byte operand
- bisb (r5)+,r0 /operand is now in r0
- asl r0 /r0 is now offset from LB in bytes, not words
- add r4,r0 /r0 is now address of the needed local
- mov (r0),-(sp) /push the local onto the stack
- jmp (r2)
- lolw: clr r0 /prepare to fetch the 2 byte operand
- bisb (r5)+,r0 /fetch high order byte first !!!
- swab r0 /insert high order byte in place
- bisb (r5)+,r0 /insert low order byte in place
- asl r0 /convert offset to bytes, from words
- add r4,r0 /r0 is now address of needed local
- mov (r0),-(sp) /stack the local
- jmp (r2) /done
-
- The important thing to notice is where and how the operand fetch occurred:
- lol2, lol4, and lol6, (the mini's) have implicit operands
- lolb knew it had to fetch one byte, and did so without any table lookup
- lolw knew it had to fetch a word, and did so, high order byte first }
-.bp
-.sp 4
-{---------------------------------------------------------------------------}
-{ Routines for the individual instructions }
-{---------------------------------------------------------------------------}
-procedure loadops;
-var j:integer;
-begin
- case insr of
- { LOAD GROUP }
- LDC: pushd(argd(k));
- LOC: pushsw(argc(k));
- LOL: push(memw(locadr(k)));
- LOE: push(memw(argg(k)));
- LIL: push(memw(mema(locadr(k))));
- LOF: push(memw(popa+argf(k)));
- LAL: pusha(locadr(k));
- LAE: pusha(argg(k));
- LXL: begin a:=lb; for j:=1 to argn(k) do a:=mema(a+savsize); pusha(a) end;
- LXA: begin a:=lb;
- for j:=1 to argn(k) do a:= mema(a+savsize);
- pusha(a+savsize)
- end;
- LOI: pushx(argo(k),popa);
- LOS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- k:=pop; pushx(argo(k),popa)
- end;
- LDL: begin a:=locadr(k); push(memw(a+wsize)); push(memw(a)) end;
- LDE: begin k:=argg(k); push(memw(k+wsize)); push(memw(k)) end;
- LDF: begin k:=argf(k);
- a:=popa; push(memw(a+k+wsize)); push(memw(a+k))
- end;
- LPI: push(argp(k))
- end
-end;
-
-procedure storeops;
-begin
- case insr of
- { STORE GROUP }
- STL: store(locadr(k),pop);
- STE: store(argg(k),pop);
- SIL: store(mema(locadr(k)),pop);
- STF: begin a:=popa; store(a+argf(k),pop) end;
- STI: popx(argo(k),popa);
- STS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- k:=popa; popx(argo(k),popa)
- end;
- SDL: begin a:=locadr(k); store(a,pop); store(a+wsize,pop) end;
- SDE: begin k:=argg(k); store(k,pop); store(k+wsize,pop) end;
- SDF: begin k:=argf(k); a:=popa; store(a+k,pop); store(a+k+wsize,pop) end
- end
-end;
-
-procedure intarith;
-var i:integer;
-begin
- case insr of
- { SIGNED INTEGER ARITHMETIC }
- ADI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:=popsw; push(fitsw(ss+st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(doadi(ds,dt)) end;
- end ;
- SBI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:= popsw; push(fitsw(ss-st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(dosbi(ds,dt)) end;
- end ;
- MLI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:= popsw; push(fitsw(ss*st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(domli(ds,dt)) end;
- end ;
- DVI: case szindex(argw(k)) of
- 1: begin st:= popsw; ss:= popsw;
- if st=0 then trap(EIDIVZ) else pushsw(ss div st)
- end;
- 2: begin dt:=popd; ds:=popd; pushd(dodvi(ds,dt)) end;
- end;
- RMI: case szindex(argw(k)) of
- 1: begin st:= popsw; ss:=popsw;
- if st=0 then trap(EIDIVZ) else pushsw(ss - (ss div st)*st)
- end;
- 2: begin dt:=popd; ds:=popd; pushd(dormi(ds,dt)) end
- end;
- NGI: case szindex(argw(k)) of
- 1: begin st:=popsw; pushsw(-st) end;
- 2: begin ds:=popd; pushd(dongi(ds)) end
- end;
- SLI: begin t:=pop;
- case szindex(argw(k)) of
- 1: begin ss:=popsw;
- for i:= 1 to t do sleft(ss); pushsw(ss)
- end
- end
- end;
- SRI: begin t:=pop;
- case szindex(argw(k)) of
- 1: begin ss:=popsw;
- for i:= 1 to t do sright(ss); pushsw(ss)
- end;
- 2: begin ds:=popd;
- for i:= 1 to t do sdright(ss); pushd(ss)
- end
- end
- end
- end
-end;
-
-procedure unsarith;
-var i:integer;
-begin
- case insr of
- { UNSIGNED INTEGER ARITHMETIC }
- ADU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s+t)) end;
- 2: trap(EILLINS);
- end ;
- SBU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s-t)) end;
- 2: trap(EILLINS);
- end ;
- MLU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s*t)) end;
- 2: trap(EILLINS);
- end ;
- DVU: case szindex(argw(k)) of
- 1: begin t:= pop; s:= pop;
- if t=0 then trap(EIDIVZ) else push(s div t)
- end;
- 2: trap(EILLINS);
- end;
- RMU: case szindex(argw(k)) of
- 1: begin t:= pop; s:=pop;
- if t=0 then trap(EIDIVZ) else push(s - (s div t)*t)
- end;
- 2: trap(EILLINS);
- end;
- SLU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- for i:= 1 to t do suleft(s); push(s)
- end;
- 2: trap(EILLINS);
- end;
- SRU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- for i:= 1 to t do suright(s); push(s)
- end;
- 2: trap(EILLINS);
- end
- end
-end;
-
-procedure fltarith;
-begin
- case insr of
- { FLOATING POINT ARITHMETIC }
- ADF: begin argwf(k); rt:=popr; rs:=popr; pushr(doadf(rs,rt)) end;
- SBF: begin argwf(k); rt:=popr; rs:=popr; pushr(dosbf(rs,rt)) end;
- MLF: begin argwf(k); rt:=popr; rs:=popr; pushr(domlf(rs,rt)) end;
- DVF: begin argwf(k); rt:=popr; rs:=popr; pushr(dodvf(rs,rt)) end;
- NGF: begin argwf(k); rt:=popr; pushr(dongf(rt)) end;
- FIF: begin argwf(k); rt:=popr; rs:=popr;
- dofif(rt,rs,x,y); pushr(y); pushr(x)
- end;
- FEF: begin argwf(k); rt:=popr; dofef(rt,x,ss); pushr(x); pushsw(ss) end
- end
-end;
-
-procedure ptrarith;
-begin
- case insr of
- { POINTER ARITHMETIC }
- ADP: pusha(popa+argf(k));
- ADS: case szindex(argw(k)) of
- 1: begin st:=popsw; pusha(popa+st) end;
- 2: begin dt:=popd; pusha(popa+dt) end;
- end;
- SBS: begin
- a:=popa; b:=popa;
- case szindex(argw(k)) of
- 1: push(fitsw(b-a,EIOVFL));
- 2: pushd(b-a)
- end
- end
- end
-end;
-
-procedure incops;
-var j:integer;
-begin
- case insr of
- { INCREMENT/DECREMENT/ZERO }
- INC: push(fitsw(popsw+1,EIOVFL));
- INL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
- INE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
- DEC: push(fitsw(popsw-1,EIOVFL));
- DEL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
- DEE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
- ZRL: store(locadr(k),0);
- ZRE: store(argg(k),0);
- ZER: for j:=1 to argw(k) div wsize do push(0);
- ZRF: pushr(0);
- end
-end;
-
-procedure convops;
-begin
- case insr of
- { CONVERT GROUP }
- CII: begin s:=pop; t:=pop;
- if t<wsize then begin push(sextend(pop,t)); t:=wsize end;
- case szindex(argw(t)) of
- 1: if szindex(argw(s))=2 then pushd(popsw);
- 2: if szindex(argw(s))=1 then push(fitsw(popd,ECONV))
- end
- end;
- CIU: case szindex(argw(pop)) of
- 1: if szindex(argw(pop))=2 then push(unsign(popd mod negoff));
- 2: trap(EILLINS);
- end;
- CIF: begin argwf(pop);
- case szindex(argw(pop)) of 1:pushr(popsw); 2:pushr(popd) end
- end;
- CUI: case szindex(argw(pop)) of
- 1: case szindex(argw(pop)) of
- 1: begin s:=pop; if s>maxsint then trap(ECONV); push(s) end;
- 2: trap(EILLINS);
- end;
- 2: case szindex(argw(pop)) of
- 1: pushd(pop);
- 2: trap(EILLINS);
- end;
- end;
- CUU: case szindex(argw(pop)) of
- 1: if szindex(argw(pop))=2 then trap(EILLINS);
- 2: trap(EILLINS);
- end;
- CUF: begin argwf(pop);
- if szindex(argw(pop))=1 then pushr(pop) else trap(EILLINS)
- end;
- CFI: begin sz:=argw(pop); argwf(pop); rt:=popr;
- case szindex(sz) of
- 1: push(fitsw(trunc(rt),ECONV));
- 2: pushd(fitd(trunc(rt)));
- end
- end;
- CFU: begin sz:=argw(pop); argwf(pop); rt:=popr;
- case szindex(sz) of
- 1: push( chopw(trunc(abs(rt)-0.5)) );
- 2: trap(EILLINS);
- end
- end;
- CFF: begin argwf(pop); argwf(pop) end
- end
-end;
-
-procedure logops;
-var i,j:integer;
-begin
- case insr of
- { LOGICAL GROUP }
- XAND:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(andf,memw(a),t)) end;
- end;
- IOR:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(iorf,memw(a),t)) end;
- end;
- XOR:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(xorf,memw(a),t)) end;
- end;
- COM:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin
- store(sp+k-wsize*j, bf(xorf,memw(sp+k-wsize*j), negoff-1))
- end
- end;
- ROL: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- t:=pop; s:=pop; for i:= 1 to t do rleft(s); push(s)
- end;
- ROR: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- t:=pop; s:=pop; for i:= 1 to t do rright(s); push(s)
- end
- end
-end;
-
-procedure setops;
-var i,j:integer;
-begin
- case insr of
- { SET GROUP }
- INN:
- begin k:=argw(k);
- t:=pop;
- i:= t mod 8; t:= t div 8;
- if t>=k then
- begin trap(ESET); s:=0 end
- else
- begin s:=memb(sp+t) end;
- newsp(sp+k); push(bit(i,s));
- end;
- XSET:
- begin k:=argw(k);
- t:=pop;
- i:= t mod 8; t:= t div 8;
- for j:= 1 to k div wsize do push(0);
- if t>=k then
- trap(ESET)
- else
- begin s:=1; for j:= 1 to i do rleft(s); storeb(sp+t,s) end
- end
- end
-end;
-
-procedure arrops;
-begin
- case insr of
- { ARRAY GROUP }
- LAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- pushx(argo(memw(a+2*k)),arraycalc(a))
- end;
- SAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- popx(argo(memw(a+2*k)),arraycalc(a))
- end;
- AAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- push(arraycalc(a))
- end
- end
-end;
-
-procedure cmpops;
-begin
- case insr of
- { COMPARE GROUP }
- CMI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:=popsw;
- if ss<st then pushsw(-1) else if ss=st then push(0) else push(1)
- end;
- 2: begin dt:=popd; ds:=popd;
- if ds<dt then pushsw(-1) else if ds=dt then push(0) else push(1)
- end;
- end;
- CMU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- if s<t then pushsw(-1) else if s=t then push(0) else push(1)
- end;
- 2: trap(EILLINS);
- end;
- CMP: begin a:=popa; b:=popa;
- if b<a then pushsw(-1) else if b=a then push(0) else push(1)
- end;
- CMF: begin argwf(k); rt:=popr; rs:=popr;
- if rs<rt then pushsw(-1) else if rs=rt then push(0) else push(1)
- end;
- CMS: begin k:=argw(k);
- t:= 0; j:= 0;
- while (j < k) and (t=0) do
- begin if memw(sp+j) <> memw(sp+k+j) then t:=1;
- j:=j+wsize
- end;
- newsp(sp+wsize*k); push(t);
- end;
-
- TLT: if popsw < 0 then push(1) else push(0);
- TLE: if popsw <= 0 then push(1) else push(0);
- TEQ: if pop = 0 then push(1) else push(0);
- TNE: if pop <> 0 then push(1) else push(0);
- TGE: if popsw >= 0 then push(1) else push(0);
- TGT: if popsw > 0 then push(1) else push(0);
- end
-end;
-
-procedure branchops;
-begin
- case insr of
- { BRANCH GROUP }
- BRA: newpc(pc+k);
-
- BLT: begin st:=popsw; if popsw < st then newpc(pc+k) end;
- BLE: begin st:=popsw; if popsw <= st then newpc(pc+k) end;
- BEQ: begin t :=pop ; if pop = t then newpc(pc+k) end;
- BNE: begin t :=pop ; if pop <> t then newpc(pc+k) end;
- BGE: begin st:=popsw; if popsw >= st then newpc(pc+k) end;
- BGT: begin st:=popsw; if popsw > st then newpc(pc+k) end;
-
- ZLT: if popsw < 0 then newpc(pc+k);
- ZLE: if popsw <= 0 then newpc(pc+k);
- ZEQ: if pop = 0 then newpc(pc+k);
- ZNE: if pop <> 0 then newpc(pc+k);
- ZGE: if popsw >= 0 then newpc(pc+k);
- ZGT: if popsw > 0 then newpc(pc+k)
- end
-end;
-
-procedure callops;
-var j:integer;
-begin
- case insr of
- { PROCEDURE CALL GROUP }
- CAL: call(argp(k));
- CAI: begin call(argp(popa)) end;
- RET: begin k:=argz(k); if k div wsize>maxret then trap(EILLINS);
- for j:= 1 to k div wsize do retarea[j]:=pop; retsize:=k;
- newsp(lb); lb:=maxdata+1; { To circumvent stack overflow error }
- newpc(popa);
- if pc=maxcode then
- begin
- halted:=true;
- if retsize=wsize then exitstatus:=retarea[1]
- else exitstatus:=undef
- end
- else
- newlb(popa);
- end;
- LFR: begin k:=args(k); if k<>retsize then trap(EILLINS);
- for j:=k div wsize downto 1 do push(retarea[j]);
- end
- end
-end;
-
-procedure miscops;
-var i,j:integer;
-begin
- case insr of
- { MISCELLANEOUS GROUP }
- ASP,ASS:
- begin if insr=ASS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=popsw end;
- k:=argf(k);
- if k<0
- then for j:= 1 to -k div wsize do push(undef)
- else newsp(sp+k);
- end;
- BLM,BLS:
- begin if insr=BLS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
- k:=argz(k);
- b:=popa; a:=popa;
- for j := 1 to k div wsize do
- store(b-wsize+wsize*j,memw(a-wsize+wsize*j))
- end;
- CSA: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- a:=popa;
- st:= popsw - signwd(memw(a+asize)); b:=0;
- if (st>=0) and (st<=memw(a+wsize+asize)) then
- b:=mema(a+2*wsize+asize+asize*st);
- if b=0 then b:=mema(a);
- if b=0 then trap(ECASE) else newpc(b)
- end;
- CSB: begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- t:=pop; i:=1; found:=false;
- while (i<=memw(a+asize)) and not found do
- if t=memw(a+(asize+wsize)*i) then found:=true else i:=i+1;
- if found then b:=memw(a+(asize+wsize)*i+wsize) else b:=memw(a);
- if b=0 then trap(ECASE) else newpc(b);
- end;
- DCH: begin pusha(mema(popa+dynd)) end;
- DUP,DUS:
- begin if insr=DUS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
- k:=args(k);
- for i:=1 to k div wsize do push(memw(sp+k-wsize));
- end;
- EXG: begin
- k:=argw(k);
- for i:=1 to k div wsize do push(memw(sp+k-wsize));
- for i:=0 to k div wsize - 1 do
- store(sp+k+i*wsize,memw(sp+k+k+i*wsize));
- for i:=1 to k div wsize do
- begin t:=pop ; store(sp+k+k-wsize,t) end;
- end;
- FIL: filna(argg(k));
- GTO: begin k:=argg(k);
- newlb(mema(k+2*asize)); newsp(mema(k+asize)); newpc(mema(k))
- end;
- LIM: push(ignmask);
- LIN: lino(argn(k));
- LNI: lino(memw(0)+1);
- LOR: begin i:=argr(k);
- case i of 0:pusha(lb); 1:pusha(sp); 2:pusha(hp) end;
- end;
- LPB: pusha(popa+statd);
- MON: domon(pop);
- NOP: writeln('NOP at line ',memw(0):5) ;
- RCK: begin a:=popa;
- case szindex(argw(k)) of
- 1: if (signwd(memw(sp))<signwd(memw(a))) or
- (signwd(memw(sp))>signwd(memw(a+wsize))) then trap(ERANGE);
- 2: if (memd(sp)<memd(a)) or
- (memd(sp)>memd(a+2*wsize)) then trap(ERANGE);
- end
- end;
- RTT: dortt;
- SIG: begin a:=popa; pusha(uerrorproc); uerrorproc:=a end;
- SIM: ignmask:=pop;
- STR: begin i:=argr(k);
- case i of 0: newlb(popa); 1: newsp(popa); 2: newhp(popa) end;
- end;
- TRP: trap(pop)
- end
-end;
-.bp
-{---------------------------------------------------------------------------}
-{ Main Loop }
-{---------------------------------------------------------------------------}
-
-begin initialize;
-8888:
- repeat
- opcode := nextpc; { fetch the first byte of the instruction }
- if opcode=escape1 then iclass:=second
- else if opcode=escape2 then iclass:=tert
- else iclass:=prim;
- if iclass<>prim then opcode := nextpc;
- with dispat[iclass][opcode] do
- begin insr:=instr;
- if not (zbit in iflag) then
- if ibit in iflag then k:=pop else
- begin
- if mini in iflag then k:=implicit else
- begin
- if short in iflag then k:=implicit+nextpc else
- begin k:=nextpc;
- if (sbit in iflag) and (k>=128) then k:=k-256;
- for i:=2 to ilength do k:=256*k + nextpc
- end
- end;
- if wbit in iflag then k:=k*wsize;
- end
- end;
-case insr of
-
- NON: trap(EILLINS);
-
- { LOAD GROUP }
- LDC,LOC,LOL,LOE,LIL,LOF,LAL,LAE,LXL,LXA,LOI,LOS,LDL,LDE,LDF,LPI:
- loadops;
-
- { STORE GROUP }
- STL,STE,SIL,STF,STI,STS,SDL,SDE,SDF:
- storeops;
-
- { SIGNED INTEGER ARITHMETIC }
- ADI,SBI,MLI,DVI,RMI,NGI,SLI,SRI:
- intarith;
-
- { UNSIGNED INTEGER ARITHMETIC }
- ADU,SBU,MLU,DVU,RMU,SLU,SRU:
- unsarith;
-
- { FLOATING POINT ARITHMETIC }
- ADF,SBF,MLF,DVF,NGF,FIF,FEF:
- fltarith;
-
- { POINTER ARITHMETIC }
- ADP,ADS,SBS:
- ptrarith;
-
- { INCREMENT/DECREMENT/ZERO }
- INC,INL,INE,DEC,DEL,DEE,ZRL,ZRE,ZER,ZRF:
- incops;
-
- { CONVERT GROUP }
- CII,CIU,CIF,CUI,CUU,CUF,CFI,CFU,CFF:
- convops;
-
- { LOGICAL GROUP }
- XAND,IOR,XOR,COM,ROL,ROR:
- logops;
-
- { SET GROUP }
- INN,XSET:
- setops;
-
- { ARRAY GROUP }
- LAR,SAR,AAR:
- arrops;
-
- { COMPARE GROUP }
- CMI,CMU,CMP,CMF,CMS, TLT,TLE,TEQ,TNE,TGE,TGT:
- cmpops;
-
- { BRANCH GROUP }
- BRA, BLT,BLE,BEQ,BNE,BGE,BGT, ZLT,ZLE,ZEQ,ZNE,ZGE,ZGT:
- branchops;
-
- { PROCEDURE CALL GROUP }
- CAL,CAI,RET,LFR:
- callops;
-
- { MISCELLANEOUS GROUP }
- ASP,ASS,BLM,BLS,CSA,CSB,DCH,DUP,DUS,EXG,FIL,GTO,LIM,
- LIN,LNI,LOR,LPB,MON,NOP,RCK,RTT,SIG,SIM,STR,TRP:
- miscops;
-
- end; { end of case statement }
- if not ( (insr=RET) or (insr=ASP) or (insr=BRA) or (insr=GTO) ) then
- retsize:=0 ;
- until halted;
-9999:
- writeln('halt with exit status: ',exitstatus:1);
- doident;
-end.
+++ /dev/null
-main() {
- register int l,j ;
-
- for ( j=0 ; (l=getchar()) != -1 ; j++ ) {
- if ( j%16 == 15 ) printf("%3d\n",l&0377 ) ;
- else printf("%3d ",l&0377 ) ;
- }
- printf("\n") ;
-}
+++ /dev/null
- mes 2,2,2 ; wordsize 2, pointersize 2
- .1
- rom 't.p\000' ; the name of the source file
- hol 552,-32768,0 ; externals and buf occupy 552 bytes
- exp $sum ; sum can be called from other modules
- pro $sum,2 ; procedure sum; 2 bytes local storage
- lin 8 ; code from source line 8
- ldl 0 ; load two locals ( a and b )
- adi 2 ; add them
- ret 2 ; return the result
- end 2 ; end of procedure ( still two bytes local storage )
- .2
- rom 1,99,2 ; descriptor of array a[]
- exp $test ; the compiler exports all level 0 procedures
- pro $test,226 ; procedure test, 226 bytes local storage
- .3
- rom 4.8F8 ; assemble Floating point 4.8 (8 bytes) in
- .4 ; global storage
- rom 0.5F8 ; same for 0.5
- mes 3,-226,2,2 ; compiler temporary not referenced indirect
- mes 3,-24,2,0 ; the same is true for i, j, b and c in test
- mes 3,-22,2,0
- mes 3,-4,2,0
- mes 3,-2,2,0
- mes 3,-20,8,0 ; and for x and y
- mes 3,-12,8,0
- lin 20 ; maintain source line number
- loc 1
- stl -4 ; j := 1
- lni ; was lin 21 prior to optimization
- lol -4
- loc 3
- mli 2
- loc 6
- adi 2
- stl -2 ; i := 3 * j + 6
- lni ; was lin 22 prior to optimization
- lae .3
- loi 8
- lal -12
- sti 8 ; x := 4.8
- lni ; was lin 23 prior to optimization
- lal -12
- loi 8
- lae .4
- loi 8
- dvf 8
- lal -20
- sti 8 ; y := x / 0.5
- lni ; was lin 24 prior to optimization
- loc 1
- stl -22 ; b := true
- lni ; was lin 25 prior to optimization
- loc 122
- stl -24 ; c := 'z'
- lni ; was lin 26 prior to optimization
- loc 1
- stl -2 ; for i:= 1
- 2
- lol -2
- dup 2
- mli 2 ; i*i
- lal -224
- lol -2
- lae .2
- sar 2 ; a[i] :=
- lol -2
- loc 100
- beq *3 ; to 100 do
- inl -2 ; increment i and loop
- bra *2
- 3
- lin 27
- lol -4
- loc 27
- adi 2 ; j + 27
- sil 0 ; r.r1 :=
- lni ; was lin 28 prior to optimization
- lol -22 ; b
- lol 0
- stf 10 ; r.r3 :=
- lni ; was lin 29 prior to optimization
- lal -20
- loi 16
- adf 8 ; x + y
- lol 0
- adp 2
- sti 8 ; r.r2 :=
- lni ; was lin 23 prior to optimization
- lal -224
- lol -4
- lae .2
- lar 2 ; a[j]
- lil 0 ; r.r1
- cal $sum ; call now
- asp 4 ; remove parameters from stack
- lfr 2 ; get function result
- stl -2 ; i :=
- 4
- lin 31
- lol -2
- zle *5 ; while i > 0 do
- lol -4
- lil 0
- adi 2
- stl -4 ; j := j + r.r1
- del -2 ; i := i - 1
- bra *4 ; loop
- 5
- lin 32
- lol 0
- stl -226 ; make copy of address of r
- lol -22
- lol -226
- stf 10 ; r3 := b
- lal -20
- loi 16
- adf 8
- lol -226
- adp 2
- sti 8 ; r2 := x + y
- loc 0
- sil -226 ; r1 := 0
- lin 34 ; note the abscence of the unnecesary jump
- lae 22 ; address of output structure
- lol -4
- cal $_wri ; write integer with default width
- asp 4 ; pop parameters
- lae 22
- lol -2
- loc 6
- cal $_wsi ; write integer width 6
- asp 6
- lae 22
- lal -12
- loi 8
- loc 9
- loc 3
- cal $_wrf ; write fixed format real, width 9, precision 3
- asp 14
- lae 22
- lol -22
- cal $_wrb ; write boolean, default width
- asp 4
- lae 22
- cal $_wln ; writeln
- asp 2
- ret 0 ; return, no result
- end 226
- exp $_main
- pro $_main,0 ; main program
- .6
- con 2,-1,22 ; description of external files
- .5
- rom 15.96F8
- fil .1 ; maintain source file name
- lae .6 ; description of external files
- lae 0 ; base of hol area to relocate buffer addresses
- cal $_ini ; initialize files, etc...
- asp 4
- lin 37
- lae .5
- loi 8
- lae 2
- sti 8 ; x := 15.9
- lni ; was lin 38 prior to optimization
- loc 99
- ste 0 ; mi := 99
- lni ; was lin 39 prior to optimization
- lae 10 ; address of r
- cal $test
- asp 2
- loc 0 ; normal exit
- cal $_hlt ; cleanup and finish
- asp 2
- end 0
- mes 4,40 ; length of source file is 40 lines
- mes 5 ; reals were used
+++ /dev/null
- program example(output);
- {This program just demonstrates typical EM code.}
- type rec = record r1: integer; r2:real; r3: boolean end;
- var mi: integer; mx:real; r:rec;
-
- function sum(a,b:integer):integer;
- begin
- sum := a + b
- end;
-
- procedure test(var r: rec);
- label 1;
- var i,j: integer;
- x,y: real;
- b: boolean;
- c: char;
- a: array[1..100] of integer;
-
- begin
- j := 1;
- i := 3 * j + 6;
- x := 4.8;
- y := x/0.5;
- b := true;
- c := 'z';
- for i:= 1 to 100 do a[i] := i * i;
- r.r1 := j+27;
- r.r3 := b;
- r.r2 := x+y;
- i := sum(r.r1, a[j]);
- while i > 0 do begin j := j + r.r1; i := i - 1 end;
- with r do begin r3 := b; r2 := x+y; r1 := 0 end;
- goto 1;
- 1: writeln(j, i:6, x:9:3, b)
- end; {test}
- begin {main program}
- mx := 15.96;
- mi := 99;
- test(r)
- end.
+++ /dev/null
-CFLAGS=-O
-HOME=../../..
-
-install \
-all: em emdmp tables
-
-tables: mktables $(HOME)/util/ass/ip_spec.t
- mktables $(HOME)/util/ass/ip_spec.t tables
-
-mktables: mktables.c $(HOME)/h/em_spec.h $(HOME)/h/em_flag.h \
- $(HOME)/util/data/em_data.a $(HOME)/util/ass/ip_spec.h
- cc -O -o mktables mktables.c $(HOME)/util/data/em_data.a
-
-em.out: em.p
- apc -mint -O em.p >emerrs ; mv e.out em.out
-
-em: em.p
- apc -O -i em.p >emerrs ; mv a.out em
-
-nem.p: em.p
- sed -e '/maxadr = t16/s//maxadr =t15/' -e '/maxdata = 8191; /s//maxdata = 14335;/' -e '/ adr=.*long/s// adr= 0..maxadr/' <em.p >nem.p
-
-nem: nem.p
- apc -O -i nem.p >emerrs ; mv a.out nem
-
-emdmp: emdmp.c
- cc -o emdmp -O emdmp.c
-
-cmp:
-
-pr:
- @pr em.p mktables.c emdmp.c
+++ /dev/null
-This interpreter is meant for inclusion in the EM manual.
-Although slow, it showed decent behaviour on several tests.
-The only monitor calls implemented are exit, read(untested),
-write and ioctl - just reurns the correct code for telling it's
-a terminal -
+++ /dev/null
-#
-{ This is an interpreter for EM. It serves as a specification for the
- EM machine. This interpreter must run on a machine which supports
- arithmetic with words and memory offsets.
-
- Certain aspects are over specified. In particular:
-
- 1. The representation of an address on the stack need not be the
- numerical value of the memory location.
-
- 2. The state of the stack is not defined after a trap has aborted
- an instruction in the middle. For example, it is officially un-
- defined whether the second operand of an ADD instruction has
- been popped or not if the first one is undefined ( -32768 or
- unsigned 32768).
-
- 3. The memory layout is implementation dependent. Only the most
- basic checks are performed whenever memory is accessed.
-
- 4. The representation of an integer or set on the stack is not fixed
- in bit order.
-
- 5. The format and existence of the procedure descriptors depends on
- the implementation.
-
- 6. The result of the compare operators CMI etc. are -1, 0 and 1
- here, but other negative and positive values will do and they
- need not be the same each time.
-
- 7. The shift count for SHL, SHR, ROL and ROR must be in the range 0
- to object size in bits - 1. The effect of a count not in this
- range is undefined.
-
- 8. This interpreter does not work for double word integers, although
- any decent EM implementation will include double word arithmetic.
- }
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-{$i256}
-{$d+}
-#ifndef DOC
-program em(tables,prog,core,input,output);
-#else
-program em(tables,prog,input,output);
-#endif
-
-
-label 8888,9999;
-
-const
- t15 = 32768; { 2**15 }
- t15m1 = 32767; { 2**15 -1 }
- t16 = 65536; { 2**16 }
- t16m1 = 65535; { 2**16 -1 }
- t31m1 = 2147483647; { 2**31 -1 }
-
- { constants indicating the size of words and addresses }
- wsize = 2; { number of bytes in a word }
- asize = 2; { number of bytes in an address }
- fsize = 4; { number of bytes in a floating point number }
- maxret =4; { number of words in the return value area }
-
- signbit = t15; { the power of two indicating the sign bit }
- negoff = t16; { the next power of two }
- maxsint = t15m1; { the maximum signed integer }
- maxuint = t16m1; { the maximum unsigned integer }
- maxdbl = t31m1; { the maximum double signed integer }
- maxadr = t16m1; { the maximum address }
- maxoffs = t15m1; { the maximum offset from an address }
- maxbitnr= 15; { the number of the highest bit }
-
- lineadr = 0; { address of the line number }
- fileadr = 4; { address of the file name }
- maxcode = 8191; { highest byte in code address space }
- maxdata = 8191; { highest byte in data address space }
-
- { format of status save area }
- statd = 4; { how far is static link from lb }
- dynd = 2; { how far is dynamic link from lb }
- reta = 0; { how far is the return address from lb }
- savsize = 4; { size of save area in bytes }
-
- { procedure descriptor format }
- pdlocs = 0; { offset for size of local variables in bytes }
- pdbase = asize; { offset for the procedure base }
- pdsize = 4; { size of procedure descriptor in bytes = 2*asize }
-
- { header words }
- NTEXT = 1;
- NDATA = 2;
- NPROC = 3;
- ENTRY = 4;
- NLINE = 5;
- SZDATA = 6;
-
- escape1 = 254; { escape to secondary opcodes }
- escape2 = 255; { escape to tertiary opcodes }
- undef = signbit; { the range of integers is -32767 to +32767 }
-
- { error codes }
- EARRAY = 0; ERANGE = 1; ESET = 2; EIOVFL = 3;
- EFOVFL = 4; EFUNFL = 5; EIDIVZ = 6; EFDIVZ = 7;
- EIUND = 8; EFUND = 9; ECONV = 10; ESTACK = 16;
- EHEAP = 17; EILLINS = 18; EODDZ = 19; ECASE = 20;
- EMEMFLT = 21; EBADPTR = 22; EBADPC = 23; EBADLAE = 24;
- EBADMON = 25; EBADLIN = 26; EBADGTO = 27;
-{
-.ne 20
-.bp
-----------------------------------------------------------------------------}
-{ Declarations }
-{---------------------------------------------------------------------------}
-
-type
- bitval= 0..1; { one bit }
- bitnr= 0..maxbitnr; { bits in machine words are numbered 0 to 15 }
- byte= 0..255; { memory is an array of bytes }
- adr= {0..maxadr} long; { the range of addresses }
- word= {0..maxuint} long;{ the range of unsigned integers }
- offs= -maxoffs..maxoffs; { the range of signed offsets from addresses }
- size= 0..maxoffs; { the range of sizes is the positive offsets }
- sword= {-signbit..maxsint} long; { the range of signed integers }
- full= {-maxuint..maxuint} long; { intermediate results need this range }
- double={-maxdbl..maxdbl} long; { double precision range }
- bftype= (andf,iorf,xorf); { tells which boolean operator needed }
- insclass=(prim,second,tert); { tells which opcode table is in use }
- instype=(implic,explic); { does opcode have implicit or explicit operand }
- iflags= (mini,short,sbit,wbit,zbit,ibit);
- ifset= set of iflags;
-
- mnem = ( NON,
- AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ,
- BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL,
- CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS,
- CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE,
- DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL,
- GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC,
- LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE,
- LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF,
- MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU,
- ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF,
- SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE,
- STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT,
- TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE,
- ZRE, ZRF, ZRL);
-
- dispatch = record
- iflag: ifset;
- instr: mnem;
- case instype of
- implic: (implicit:sword);
- explic: (ilength:byte);
- end;
-
-
-var
- code: packed array[0..maxcode] of byte; { code space }
- data: packed array[0..maxdata] of byte; { data space }
- retarea: array[1..maxret ] of word; { return area }
- pc,lb,sp,hp,pd: adr; { internal machine registers }
- i: integer; { integer scratch variable }
- s,t :word; { scratch variables }
- sz:size; { scratch variables }
- ss,st: sword; { scratch variables }
- k :double; { scratch variables }
- j:size; { scratch variable used as index }
- a,b:adr; { scratch variable used for addresses }
- dt,ds:double; { scratch variables for double precision }
- rt,rs,x,y:real; { scratch variables for real }
- found:boolean; { scratch }
- opcode: byte; { holds the opcode during execution }
- iclass: insclass; { true for escaped opcodes }
- dispat: array[insclass,byte] of dispatch;
- retsize:size; { holds size of last LFR }
- insr: mnem; { holds the instructionnumber }
- halted: boolean; { normally false }
- exitstatus:word; { parameter of MON 1 }
- ignmask:word; { ignore mask for traps }
- uerrorproc:adr; { number of user defined error procedure }
- intrap:boolean; { Set when executing trap(), to catch recursive calls}
- trapval:byte; { Set to number of last trap }
- header: array[1..8] of adr;
-
- tables: text; { description of EM instructions }
- prog: file of byte; { program and initialized data }
-#ifndef DOC
- core: file of byte; { post mortem dump }
-#endif
-{
-.ne 20
-.sp 5
-{---------------------------------------------------------------------------}
-{ Various check routines }
-{---------------------------------------------------------------------------}
-
-{ Only the most basic checks are performed. These routines are inherently
- implementation dependent. }
-
-procedure trap(n:byte); forward;
-#ifndef DOC
-procedure writecore(n:byte); forward;
-#endif
-
-procedure memadr(a:adr);
-begin if (a>maxdata) or ((a<sp) and (a>=hp)) then trap(EMEMFLT) end;
-
-procedure wordadr(a:adr);
-begin memadr(a); if (a mod wsize<>0) then trap(EBADPTR) end;
-
-procedure chkadr(a:adr; s:size);
-begin memadr(a); memadr(a+s-1); { assumption: size is ok }
- if s<wsize
- then begin if a mod s<>0 then trap(EBADPTR) end
- else if a mod wsize<>0 then trap(EBADPTR)
-end;
-
-procedure newpc(a:double);
-begin if (a<0) or (a>maxcode) then trap(EBADPC); pc:=a end;
-
-procedure newsp(a:adr);
-begin if (a>lb) or (a<hp) or (a mod wsize<>0) then trap(ESTACK); sp:=a end;
-
-procedure newlb(a:adr);
-begin if (a<sp) or (a mod wsize<>0) then trap(ESTACK); lb:=a end;
-
-procedure newhp(a:adr);
-begin if (a>sp) or (a>maxdata+1) or (a mod wsize<>0)
- then trap(EHEAP); hp:=a
-end;
-
-function argc(a:double):sword;
-begin if (a<-signbit) or (a>maxsint) then trap(EILLINS); argc:=a end;
-
-function argd(a:double):double;
-begin if (a<-maxdbl) or (a>maxdbl) then trap(EILLINS); argd:=a end;
-
-function argl(a:double):offs;
-begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argl:=a end;
-
-function argg(k:double):adr;
-begin if (k<0) or (k>maxadr) then trap(EILLINS); argg:=k end;
-
-function argf(a:double):offs;
-begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argf:=a end;
-
-function argn(a:double):word;
-begin if (a<0) or (a>maxuint) then trap(EILLINS); argn:=a end;
-
-function args(a:double):size;
-begin if (a<=0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- args:=a ;
-end;
-
-function argz(a:double):size;
-begin if (a<0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- argz:=a ;
-end;
-
-function argo(a:double):size;
-begin if (a<0) or (a>maxoffs)
- then trap(EODDZ)
- else if (a mod wsize<>0) and (wsize mod a<>0) then trap(EODDZ);
- argo:=a ;
-end;
-
-function argw(a:double):size;
-begin if (a<=0) or (a>maxoffs) or (a>maxuint)
- then trap(EODDZ)
- else if (a mod wsize)<>0 then trap(EODDZ);
- argw:=a ;
-end;
-
-function argp(a:double):size;
-begin if (a<0) or (a>=header[NPROC]) then trap(EILLINS); argp:=a end;
-
-function argr(a:double):word;
-begin if (a<0) or (a>2) then trap(EILLINS); argr:=a end;
-
-procedure argwf(s:double);
-begin if argw(s)<>fsize then trap(EILLINS) end;
-
-function szindex(s:double):integer;
-begin s:=argw(s); if (s mod wsize <> 0) or (s>2*wsize) then trap(EILLINS);
- szindex:=s div wsize
-end;
-
-function locadr(l:double):adr;
-begin l:=argl(l); if l<0 then locadr:=lb+l else locadr:=lb+l+savsize end;
-
-function signwd(w:word):sword;
-begin if w = undef then trap(EIUND);
- if w >= signbit then signwd:=w-negoff else signwd:=w
-end;
-
-function dosign(w:word):sword;
-begin if w >= signbit then dosign:=w-negoff else dosign:=w end;
-
-function unsign(w:sword):word;
-begin if w<0 then unsign:=w+negoff else unsign:=w end;
-
-function chopw(dw:double):word;
-begin chopw:=dw mod negoff end;
-
-function fitsw(w:full;trapno:byte):word;
-{ checks whether value fits in signed word, returns unsigned representation}
-begin
- if (w>maxsint) or (w<-signbit) then
- begin trap(trapno);
- if w<0 then fitsw:=negoff- (-w)mod negoff
- else fitsw:=w mod negoff;
- end
- else fitsw:=unsign(w)
-end;
-
-function fitd(w:full):double;
-begin
- if abs(w) > maxdbl then trap(ECONV);
- fitd:=w
-end;
-
-{
-.ne 20
-.sp 5
-{---------------------------------------------------------------------------}
-{ Memory access routines }
-{---------------------------------------------------------------------------}
-
-{ memw returns a machine word as an unsigned integer
- memb returns a single byte as a positive integer: 0 <= memb <= 255
- mems(a,s) fetches an object smaller than a word and returns a word
- store(a,v) stores the word v at machine address a
- storea(a,v) stores the address v at machine address a
- storeb(a,b) stores the byte b at machine address a
- stores(a,s,v) stores the s least significant bytes of a word at address a
- memi returns an offset from the instruction space
- Note that the procedure descriptors are part of instruction space.
- nextpc returns the next byte addressed by pc, incrementing pc
-
- lino changes the line number word.
- filna changes the pointer to the file name.
-
- All routines check to make sure the address is within range and valid for
- the size of the object. If an addressing error is found, a trap occurs.
-}
-
-
-function memw(a:adr):word;
-var b:word; i:integer;
-begin wordadr(a); b:=0;
- for i:=wsize-1 downto 0 do b:=256*b + data[a+i] ;
- memw:=b
-end;
-
-function memd(a:adr):double; { Always signed }
-var b:double; i:integer;
-begin wordadr(a); b:=data[a+2*wsize-1];
- if b>=128 then b:=b-256;
- for i:=2*wsize-2 downto 0 do b:=256*b + data[a+i] ;
- memd:=b
-end;
-
-function mema(a:adr):adr;
-var b:adr; i:integer;
-begin wordadr(a); b:=0;
- for i:=asize-1 downto 0 do b:=256*b + data[a+i] ;
- mema:=b
-end;
-
-function mems(a:adr;s:size):word;
-var i:integer; b:word;
-begin chkadr(a,s); b:=0; for i:=1 to s do b:=b*256+data[a+s-i]; mems:=b end;
-
-function memb(a:adr):byte;
-begin memadr(a); memb:=data[a] end;
-
-procedure store(a:adr; x:word);
-var i:integer;
-begin wordadr(a);
- for i:=0 to wsize-1 do
- begin data[a+i]:=x mod 256; x:=x div 256 end
-end;
-
-procedure storea(a:adr; x:adr);
-var i:integer;
-begin wordadr(a);
- for i:=0 to asize-1 do
- begin data[a+i]:=x mod 256; x:=x div 256 end
-end;
-
-procedure stores(a:adr;s:size;v:word);
-var i:integer;
-begin chkadr(a,s);
- for i:=0 to s-1 do begin data[a+i]:=v mod 256; v:=v div 256 end;
-end;
-
-procedure storeb(a:adr; b:byte);
-begin memadr(a); data[a]:=b end;
-
-function memi(a:adr):adr;
-var b:adr; i:integer;
-begin if (a mod wsize<>0) or (a+asize-1>maxcode) then trap(EBADPTR); b:=0;
- for i:=asize-1 downto 0 do b:=256*b + code[a+i] ;
- memi:=b
-end;
-
-function nextpc:byte;
-begin if pc>=pd then trap(EBADPC); nextpc:=code[pc]; newpc(pc+1) end;
-
-procedure lino(w:word);
-begin store(lineadr,w) end;
-
-procedure filna(a:adr);
-begin storea(fileadr,a) end;
-{
-.ne 20
-.sp 5
-{---------------------------------------------------------------------------}
-{ Stack Manipulation Routines }
-{---------------------------------------------------------------------------}
-
-{ push puts a word on the stack
- pushsw takes a signed one word integer and pushes it on the stack
- pop removes a machine word from the stack and delivers it as a word
- popsw removes a machine word from the stack and delivers a signed integer
- pusha pushes an address on the stack
- popa removes a machine word from the stack and delivers it as an address
- pushd pushes a double precision number on the stack
- popd removes two machine words and returns a double precision integer
- pushr pushes a float (floating point) number on the stack
- popr removes several machine words and returns a float number
- pushx puts an object of arbitrary size on the stack
- popx removes an object of arbitrary size
- }
-
-procedure push(x:word);
-begin newsp(sp-wsize); store(sp,x) end;
-
-procedure pushsw(x:sword);
-begin newsp(sp-wsize); store(sp,unsign(x)) end;
-
-function pop:word;
-begin pop:=memw(sp); newsp(sp+wsize) end;
-
-function popsw:sword;
-begin popsw:=signwd(pop) end;
-
-procedure pusha(x:adr);
-begin newsp(sp-asize); storea(sp,x) end;
-
-function popa:adr;
-begin popa:=mema(sp); newsp(sp+asize) end;
-
-procedure pushd(y:double);
-begin { push double integer onto the stack } newsp(sp-2*wsize) end;
-
-function popd:double;
-begin { pop double integer from the stack } newsp(sp+2*wsize); popd:=0 end;
-
-procedure pushr(z:real);
-begin { Push a float onto the stack } newsp(sp-fsize) end;
-
-function popr:real;
-begin { pop float from the stack } newsp(sp+fsize); popr:=0.0 end;
-
-procedure pushx(objsize:size; a:adr);
-var i:integer;
-begin
- if objsize<wsize
- then push(mems(a,objsize))
- else for i:=1 to objsize div wsize do push(memw(a+objsize-wsize*i))
-end;
-
-procedure popx(objsize:size; a:adr);
-var i:integer;
-begin
- if objsize<wsize
- then stores(a,objsize,pop)
- else for i:=1 to objsize div wsize do store(a-wsize+wsize*i,pop)
-end;
-{
-.ne 20
-.sp 5
-{---------------------------------------------------------------------------}
-{ Bit manipulation routines (extract, shift, rotate) }
-{---------------------------------------------------------------------------}
-
-procedure sleft(var w:sword); { 1 bit left shift }
-begin w:= dosign(fitsw(2*w,EIOVFL)) end;
-
-procedure suleft(var w:word); { 1 bit left shift }
-begin w := chopw(2*w) end;
-
-procedure sdleft(var d:double); { 1 bit left shift }
-begin { shift two word signed integer } end;
-
-procedure sright(var w:sword); { 1 bit right shift with sign extension }
-begin if w >= 0 then w := w div 2 else w := (w-1) div 2 end;
-
-procedure suright(var w:word); { 1 bit right shift without sign extension }
-begin w := w div 2 end;
-
-procedure sdright(var d:double); { 1 bit right shift }
-begin { shift two word signed integer } end;
-
-procedure rleft(var w:word); { 1 bit left rotate }
-begin if w >= t15
- then w:=(w-t15)*2 + 1
- else w:=w*2
-end;
-
-procedure rright(var w:word); { 1 bit right rotate }
-begin if w mod 2 = 1
- then w:=w div 2 + t15
- else w:=w div 2
-end;
-
-function sextend(w:word;s:size):word;
-var i:size;
-begin
- for i:=1 to (wsize-s)*8 do rleft(w);
- for i:=1 to (wsize-s)*8 do sright(w);
- sextend:=w;
-end;
-
-function bit(b:bitnr; w:word):bitval; { return bit b of the word w }
-var i:bitnr;
-begin for i:= 1 to b do rright(w); bit:= w mod 2 end;
-
-function bf(ty:bftype; w1,w2:word):word; { return boolean fcn of 2 words }
-var i:bitnr; j:word;
-begin j:=0;
- for i:= maxbitnr downto 0 do
- begin j := 2*j;
- case ty of
- andf: if bit(i,w1)+bit(i,w2) = 2 then j:=j+1;
- iorf: if bit(i,w1)+bit(i,w2) > 0 then j:=j+1;
- xorf: if bit(i,w1)+bit(i,w2) = 1 then j:=j+1
- end
- end;
- bf:=j
-end;
-
-{---------------------------------------------------------------------------}
-{ Array indexing
-{---------------------------------------------------------------------------}
-
-function arraycalc(c:adr):adr; { subscript calculation }
-var j:full; objsize:size; a:adr;
-begin j:= popsw - signwd(memw(c));
- if (j<0) or (j>memw(c+wsize)) then trap(EARRAY);
- objsize := argo(memw(c+wsize+wsize));
- a := j*objsize+popa; chkadr(a,objsize);
- arraycalc:=a
-end;
-{
-.ne 20
-.sp 5
-{---------------------------------------------------------------------------}
-{ Double and Real Arithmetic }
-{---------------------------------------------------------------------------}
-
-{ All routines for doubles and floats are dummy routines, since the format of
- doubles and floats is not defined in EM.
-}
-
-function doadi(ds,dt:double):double;
-begin { add two doubles } doadi:=0 end;
-
-function dosbi(ds,dt:double):double;
-begin { subtract two doubles } dosbi:=0 end;
-
-function domli(ds,dt:double):double;
-begin { multiply two doubles } domli:=0 end;
-
-function dodvi(ds,dt:double):double;
-begin { divide two doubles } dodvi:=0 end;
-
-function dormi(ds,dt:double):double;
-begin { modulo of two doubles } dormi:=0 end;
-
-function dongi(ds:double):double;
-begin { negative of a double } dongi:=0 end;
-
-function doadf(x,y:real):real;
-begin { add two floats } doadf:=0.0 end;
-
-function dosbf(x,y:real):real;
-begin { subtract two floats } dosbf:=0.0 end;
-
-function domlf(x,y:real):real;
-begin { multiply two floats } domlf:=0.0 end;
-
-function dodvf(x,y:real):real;
-begin { divide two floats } dodvf:=0.0 end;
-
-function dongf(x:real):real;
-begin { negate a float } dongf:=0.0 end;
-
-procedure dofif(x,y:real;var intpart,fraction:real);
-begin { dismember x*y into integer and fractional parts }
- intpart:=0.0; { integer part of x*y, same sign as x*y }
- fraction:=0.0;
- { fractional part of x*y, 0<=abs(fraction)<1 and same sign as x*y }
-end;
-
-procedure dofef(x:real;var mantissa:real;var exponent:sword);
-begin { dismember x into mantissa and exponent parts }
- mantissa:=0.0; { mantissa of x , >= 1/2 and <1 }
- exponent:=0; { base 2 exponent of x }
-end;
-
-{
-.ne 20
-.sp 5
-.bp
-{---------------------------------------------------------------------------}
-{ Trap and Call }
-{---------------------------------------------------------------------------}
-
-procedure call(p:adr); { Perform the call }
-begin
- pusha(lb);pusha(pc);
- newlb(sp);newsp(sp - memi(pd + pdsize*p + pdlocs));
- newpc(memi(pd + pdsize*p+ pdbase))
-end;
-
-procedure dotrap(n:byte);
-var i:size;
-begin
- if (uerrorproc=0) or intrap then
- begin
- if intrap then
- writeln('Recursive trap, first trap number was ', trapval:1);
- writeln('Error ', n:1);
- writeln('With',ord(insr):4,' arg ',k:1);
-#ifndef DOC
- writecore(n);
-#endif
- goto 9999
- end;
- { Deposit all interpreter variables that need to be saved on
- the stack. This includes all scratch variables that can
- be in use at the moment and ( not possible in this interpreter )
- the internal address of the interpreter where the error occurred.
- This would make it possible to execute an RTT instruction totally
- transparent to the user program.
- It can, for example, occur within an ADD instruction that both
- operands are undefined and that the result overflows.
- Although this will generate 3 error traps it must be possible
- to ignore them all.
-
- }
- intrap:=true; trapval:=n;
- for i:=retsize div wsize downto 1 do push(retarea[i]);
- push(retsize); { saved return area }
- pusha(mema(fileadr)); { saved current file name pointer }
- push(memw(lineadr)); { saved line number }
- push(n); { push error number }
- a:=argp(uerrorproc);
- uerrorproc:=0; { reset signal }
- call(a); { call the routine }
- intrap:=false; { Don't catch recursive traps anymore }
- goto 8888; { reenter main loop }
-end;
-
-procedure trap;
-{ This routine is invoked for overflow, and other run time errors.
- For non-fatal errors, trap returns to the calling routine
-}
-begin
- if n>=16 then dotrap(n) else if bit(n,ignmask)=0 then dotrap(n);
-end;
-
-procedure dortt;
-{ The restoration of file address and line number is not essential.
- The restoration of the return save area is.
-}
-var i:size;
- n:word;
-begin
- newsp(lb); lb:=maxdata+1 ; { to circumvent ESTACK for the popa + pop }
- newpc(popa); newlb(popa); { So far a plain RET 0 }
- n:=pop; if (n>=16) and (n<64) then
- begin
-#ifndef DOC
- writecore(n);
-#endif
- goto 9999
- end;
- lino(pop); filna(popa); retsize:=pop;
- for i:=1 to retsize div wsize do retarea[i]:=pop ;
-end;
-{
-.sp 5
-{---------------------------------------------------------------------------}
-{ monitor calls }
-{---------------------------------------------------------------------------}
-
-
-procedure domon(entry:word);
-var index: 1..63;
- dummy: double;
- count,rwptr: adr;
- token: byte;
- i: integer;
-begin
- if (entry<=0) or (entry>63) then entry:=63 ;
- index:=entry;
- case index of
- 1: begin { exit } exitstatus:=pop; halted:=true end;
- 3: begin { read } dummy:=pop; { All input is from stdin }
- rwptr:=popa; count:=popa;
- i:=0 ;
- while (not eof(input)) and (i<count) do
- begin
- if eoln(input) then begin storeb(rwptr,10) ; count:=i end
- else storeb(rwptr,ord(input^)) ;
- get(input); rwptr:=rwptr+1 ; i:=i+1 ;
- end;
- pusha(i); push(0)
- end;
- 4: begin { write } dummy:=pop; { All output is to stdout }
- rwptr:=popa; count:=popa;
- for i:=1 to count do
- begin token:=memb(rwptr); rwptr:=rwptr+1 ;
- if token=10 then writeln else write(chr(token))
- end ;
- pusha(count);
- push(0)
- end;
- 54: begin { ioctl, faked } dummy:=popa;dummy:=popa;dummy:=pop;push(0) end ;
- 2, 5, 6, 7, 8, 9, 10,
- 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
- 21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
- 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
- 41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
- 51, 52, 53, 55, 56, 57, 58, 59, 60,
- 61, 62:
- begin push(22); push(22) end;
- 63: { exists only for the trap }
- trap(EBADMON)
- end
-end;
-{
-.bp
-{---------------------------------------------------------------------------}
-{ Initialization and debugging }
-{---------------------------------------------------------------------------}
-
-procedure doident; { print line number and file name }
-var a:adr; i,c:integer; found:boolean;
-begin
- write('at line ',memw(lineadr):1,' ');
- a:=mema(fileadr); if a<>0 then
- begin i:=20; found:=false;
- while (i<>0) and not found do
- begin c:=memb(a); a:=a+1; found:=true; i:=i-1;
- if (c>=48) and (c<=57) then
- begin found:=false; write(chr(ord('0')+c-48)) end;
- if (c>=65) and (c<=90) then
- begin found:=false; write(chr(ord('A')+c-65)) end;
- if (c>=97) and (c<=122) then
- begin found:=false; write(chr(ord('a')+c-97)) end;
- end;
- end;
- writeln;
-end;
-
-#ifndef DOC
-{---------------------------------------------------------------------------}
-{ Post Mortem Dump }
-{ }
-{This a not a part of the machine definition, but an ad hoc debugging method}
-{---------------------------------------------------------------------------}
-
-procedure writecore;
-var ncoreb,i:integer;
-
-procedure wrbyte(b:byte);
-begin write(core,b); ncoreb:=ncoreb+1 end;
-
-procedure wradr(a:adr);
-var i:integer;
-begin for i:=1 to asize do begin wrbyte(a mod 256); a:=a div 256 end end;
-
-begin
- rewrite(core); ncoreb:=0;
- wrbyte(173); wrbyte(16); { Magic }
- wrbyte(3);wrbyte(0); { Version }
- wrbyte(wsize);wrbyte(0); { Wordsize }
- wrbyte(asize);wrbyte(0); { Address size }
- wradr(0); { Text size in dump }
- wradr(maxdata+1); { Data size in dump }
- wradr(ignmask);
- wradr(uerrorproc);
- wradr(n); { Cause }
- wradr(pc); wradr(sp); wradr(lb); wradr(hp); wradr(pd); wradr(0){pb} ;
- while ncoreb<>512 do wradr(0); { Fill }
- for i:=0 to maxdata do wrbyte(data[i])
-end;
-
-#endif
-
-procedure initialize; { start the ball rolling }
-{ This is not part of the machine definition }
-var cset:set of char;
- f:ifset;
- iclass:insclass;
- insno:byte;
- nops:integer;
- opcode:byte;
- i,j,n:integer;
- wtemp:sword;
- count:integer;
- repc:adr;
- nexta,firsta:adr;
- elem:byte;
- amount,ofst:size;
- c:char;
-
- function readb(n:integer):double;
- var b:byte;
- begin read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b end;
-
- function readbyte:byte;
- begin readbyte:=readb(1) end;
-
- function readword:word;
- begin readword:=readb(wsize) end;
-
- function readadr:adr;
- begin readadr:=readb(asize) end;
-
- function ifind(ordinal:byte):mnem;
- var loopvar:mnem;
- found:boolean;
- begin ifind:=NON;
- loopvar:=insr; found:=false;
- repeat
- if ordinal=ord(loopvar) then
- begin found:=true; ifind:=loopvar end;
- if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON;
- until found or (loopvar=insr) ;
- end;
-
- procedure readhdr;
- type hdrw=0..32767 ; { 16 bit header words }
- var hdr: hdrw;
- i: integer;
- begin
- for i:=0 to 7 do
- begin hdr:=readb(2);
- case i of
- 0: if hdr<>3757 then { 07255 }
- begin writeln('Not an em load file'); halt end;
- 2: if hdr<>0 then
- begin writeln('Unsolved references'); halt end;
- 3: if hdr<>3 then
- begin writeln('Incorrect load file version'); halt end;
- 4: if hdr<>wsize then
- begin writeln('Incorrect word size'); halt end;
- 5: if hdr<>asize then
- begin writeln('Incorrect pointer size'); halt end;
- 1,6,7:;
- end
- end
- end;
-
- procedure noinit;
- begin writeln('Illegal initialization'); halt end;
-
- procedure readint(a:adr;s:size);
- var i:size;
- begin { construct integer out of byte sequence }
- for i:=1 to s do { construct the value and initialize at a }
- begin storeb(a,readbyte); a:=a+1 end
- end;
-
- procedure readuns(a:adr;s:size);
- begin { construct unsigned out of byte sequence }
- readint(a,s) { identical to readint }
- end;
-
- procedure readfloat(a:adr;s:size);
- var i:size; b:byte;
- begin { construct float out of string}
- if (s<>4) and (s<>8) then noinit; i:=0;
- repeat { eat the bytes, construct the value and intialize at a }
- b:=readbyte; i:=i+1;
- until b=0 ;
- end;
-
-begin
- halted:=false;
- exitstatus:=undef;
- uerrorproc:=0; intrap:=false;
-
- { initialize tables }
- for i:=0 to maxcode do code[i]:=0;
- for i:=0 to maxdata do data[i]:=0;
- for iclass:=prim to tert do
- for i:=0 to 255 do
- with dispat[iclass][i] do
- begin instr:=NON; iflag:=[zbit] end;
-
- { read instruction table file. see appendix B }
- { The table read here is a simple transformation of the table on page xx }
- { - instruction names were transformed to numbers }
- { - the '-' flag was transformed to an 'i' flag for 'w' type instructions }
- { - the 'S' flag was added for instructions having signed operands }
- reset(tables);
- insr:=NON;
- repeat
- read(tables,insno) ; cset:=[]; f:=[];
- insr:=ifind(insno);
- if insr=NON then begin writeln('Incorrect table'); halt end;
- repeat read(tables,c) until c<>' ' ;
- repeat
- cset:=cset+[c];
- read(tables,c)
- until c=' ' ;
- if 'm' in cset then f:=f+[mini];
- if 's' in cset then f:=f+[short];
- if '-' in cset then f:=f+[zbit];
- if 'i' in cset then f:=f+[ibit];
- if 'S' in cset then f:=f+[sbit];
- if 'w' in cset then f:=f+[wbit];
- if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ;
- readln(tables,opcode);
- if ('4' in cset) or ('8' in cset) then
- begin iclass:=tert end
- else if 'e' in cset then
- begin iclass:=second end
- else iclass:=prim;
- for i:=0 to nops-1 do
- begin
- with dispat[iclass,opcode+i] do
- begin
- iflag:=f; instr:=insr;
- if '2' in cset then ilength:=2
- else if '4' in cset then ilength:=4
- else if '8' in cset then ilength:=8
- else if (mini in f) or (short in f) then
- begin
- if 'N' in cset then wtemp:=-1-i else wtemp:=i ;
- if 'o' in cset then wtemp:=wtemp+1 ;
- if short in f then wtemp:=wtemp*256 ;
- implicit:=wtemp
- end
- end
- end
- until eof(tables);
-
- { read in program text, data and procedure descriptors }
- reset(prog);
- readhdr; { verify first header }
- for i:=1 to 8 do header[i]:=readadr; { read second header }
- hp:=maxdata+1; sp:=maxdata+1; lino(0);
- { read program text }
- if header[NTEXT]+header[NPROC]*pdsize>maxcode then
- begin writeln('Text size too large'); halt end;
- if header[SZDATA]>maxdata then
- begin writeln('Data size too large'); halt end;
- for i:=0 to header[NTEXT]-1 do code[i]:=readbyte;
- { read data blocks }
- nexta:=0;
- for i:=1 to header[NDATA] do
- begin
- n:=readbyte;
- if n<>0 then
- begin
- elem:=readbyte; firsta:=nexta;
- case n of
- 1: { uninitialized words }
- for j:=1 to elem do
- begin store(nexta,undef); nexta:=nexta+wsize end;
- 2: { initialized bytes }
- for j:=1 to elem do
- begin storeb(nexta,readbyte); nexta:=nexta+1 end;
- 3: { initialized words }
- for j:=1 to elem do
- begin store(nexta,readword); nexta:=nexta+wsize end;
- 4,5: { instruction and data pointers }
- for j:=1 to elem do
- begin storea(nexta,readadr); nexta:=nexta+asize end;
- 6: { signed integers }
- begin readint(nexta,elem); nexta:=nexta+elem end;
- 7: { unsigned integers }
- begin readuns(nexta,elem); nexta:=nexta+elem end;
- 8: { floating point numbers }
- begin readfloat(nexta,elem); nexta:=nexta+elem end;
- end
- end
- else
- begin
- repc:=readadr;
- amount:=nexta-firsta;
- for count:=1 to repc do
- begin
- for ofst:=0 to amount-1 do data[nexta+ofst]:=data[firsta+ofst];
- nexta:=nexta+amount;
- end
- end
- end;
- if header[SZDATA]<>nexta then writeln('Data initialization error');
- hp:=nexta;
- { read descriptor table }
- pd:=header[NTEXT];
- for i:=1 to header[NPROC]*pdsize do code[pd+i-1]:=readbyte;
- { call the entry point routine }
- ignmask:=0; { catch all traps, higher numbered traps cannot be ignored}
- retsize:=0;
- lb:=maxdata; { illegal dynamic link }
- pc:=maxcode; { illegal return address }
- push(0); a:=sp; { No environment }
- push(0); b:=sp; { No args }
- pusha(a); { envp }
- pusha(b); { argv }
- push(0); { argc }
- call(argp(header[ENTRY]));
-end;
-{
-.bp
-{---------------------------------------------------------------------------}
-{ MAIN LOOP OF THE INTERPRETER }
-{---------------------------------------------------------------------------}
-{ It should be noted that the interpreter (microprogram) for an EM
- machine can be written in two fundamentally different ways: (1) the
- instruction operands are fetched in the main loop, or (2) the in-
- struction operands are fetched after the 256 way branch, by the exe-
- cution routines themselves. In this interpreter, method (1) is used
- to simplify the description of execution routines. The dispatch
- table dispat is used to determine how the operand is encoded. There
- are 4 possibilities:
-
- 0. There is no operand
- 1. The operand and instruction are together in 1 byte (mini)
- 2. The operand is one byte long and follows the opcode byte(s)
- 3. The operand is two bytes long and follows the opcode byte(s)
- 4. The operand is four bytes long and follows the opcode byte(s)
-
- In this interpreter, the main loop determines the operand type,
- fetches it, and leaves it in the global variable k for the execution
- routines to use. Consequently, instructions such as LOL, which use
- three different formats, need only be described once in the body of
- the interpreter.
- However, for a production interpreter, or a hardware EM
- machine, it is probably better to use method (2), i.e. to let the
- execution routines themselves fetch their own operands. The reason
- for this is that each opcode uniquely determines the operand format,
- so no table lookup in the dispatch table is needed. The whole table
- is not needed. Method (2) therefore executes much faster.
- However, separate execution routines will be needed for LOL with
- a one byte offset, and LOL with a two byte offset. It is to avoid
- this additional clutter that method (1) is used here. In a produc-
- tion interpreter, it is envisioned that the main loop will fetch the
- next instruction byte, and use it as an index into a 256 word table
- to find the address of the interpreter routine to jump to. The
- routine jumped to will begin by fetching its operand, if any,
- without any table lookup, since it knows which format to expect.
- After doing the work, it returns to the main loop by jumping in-
- directly to a register that contains the address of the main loop.
- A slight variation on this idea is to have the register contain
- the address of the branch table, rather than the address of the main
- loop.
- Another issue is whether the execution routines for LOL 0, LOL
- 2, LOL 4, etc. should all be have distinct execution routines. Doing
- so provides for the maximum speed, since the operand is implicit in
- the routine itself. The disadvantage is that many nearly identical
- execution routines will then be needed. Another way of doing it is
- to keep the instruction byte fetched from memory (LOL 0, LOL 2, LOL
- 4, etc.) in some register, and have all the LOL mini format instruc-
- tions branch to a common routine. This routine can then determine
- the operand by subtracting the code for LOL 0 from the register,
- leaving the true operand in the register (as a word quantity of
- course). This method makes the interpreter smaller, but is a bit
- slower.
-.bp
- To make this important point a little clearer, consider how a
- production interpreter for the PDP-11 might appear. Let us assume the
- following opcodes have been assigned:
-
- 31: LOL -2 (2 bytes, i.e. next word)
- 32: LOL -4
- 33: LOL -6
- 34: LOL b (format with a one byte offset)
- 35: LOL w (format with a one word, i.e. two byte offset)
-
- Further assume that each of the 5 opcodes will have its own execution
- routine, i.e. we are making a tradeoff in favor of fast execution and
- a slightly larger interpreter.
- Register r5 is the em program counter.
- Register r4 is the em LB register
- Register r3 is the em SP register (the stack grows toward low core)
- Register r2 contains the interpreter address of the main loop
-
- The main loop looks like this:
-
- movb (r5)+,r0 /fetch the opcode into r0 and increment r5
- asl r0 /shift r0 left 1 bit. Now: -256<=r0<=+254
- jmp *table(r0) /jump to execution routine
-
- Notice that no operand fetching has been done. The execution routines for
- the 5 sample instructions given above might be as follows:
-
- lol2: mov -2(r4),-(sp) /push local -2 onto stack
- jmp (r2) /go back to main loop
- lol4: mov -4(r4),-(sp) /push local -4 onto stack
- jmp (r2) /go back to main loop
- lol6: mov -6(r4),-(sp) /push local -6 onto stack
- jmp (r2) /go back to main loop
- lolb: mov $177400,r0 /prepare to fetch the 1 byte operand
- bisb (r5)+,r0 /operand is now in r0
- asl r0 /r0 is now offset from LB in bytes, not words
- add r4,r0 /r0 is now address of the needed local
- mov (r0),-(sp) /push the local onto the stack
- jmp (r2)
- lolw: clr r0 /prepare to fetch the 2 byte operand
- bisb (r5)+,r0 /fetch high order byte first !!!
- swab r0 /insert high order byte in place
- bisb (r5)+,r0 /insert low order byte in place
- asl r0 /convert offset to bytes, from words
- add r4,r0 /r0 is now address of needed local
- mov (r0),-(sp) /stack the local
- jmp (r2) /done
-
- The important thing to notice is where and how the operand fetch occurred:
- lol2, lol4, and lol6, (the mini's) have implicit operands
- lolb knew it had to fetch one byte, and did so without any table lookup
- lolw knew it had to fetch a word, and did so, high order byte first }
-{
-.bp
-.sp 4
-{---------------------------------------------------------------------------}
-{ Routines for the individual instructions }
-{---------------------------------------------------------------------------}
-procedure loadops;
-var j:integer;
-begin
- case insr of
- { LOAD GROUP }
- LDC: pushd(argd(k));
- LOC: pushsw(argc(k));
- LOL: push(memw(locadr(k)));
- LOE: push(memw(argg(k)));
- LIL: push(memw(mema(locadr(k))));
- LOF: push(memw(popa+argf(k)));
- LAL: pusha(locadr(k));
- LAE: pusha(argg(k));
- LXL: begin a:=lb; for j:=1 to argn(k) do a:=mema(a+savsize); pusha(a) end;
- LXA: begin a:=lb;
- for j:=1 to argn(k) do a:= mema(a+savsize);
- pusha(a+savsize)
- end;
- LOI: pushx(argo(k),popa);
- LOS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- k:=pop; pushx(argo(k),popa)
- end;
- LDL: begin a:=locadr(k); push(memw(a+wsize)); push(memw(a)) end;
- LDE: begin k:=argg(k); push(memw(k+wsize)); push(memw(k)) end;
- LDF: begin k:=argf(k);
- a:=popa; push(memw(a+k+wsize)); push(memw(a+k))
- end;
- LPI: push(argp(k))
- end
-end;
-
-procedure storeops;
-begin
- case insr of
- { STORE GROUP }
- STL: store(locadr(k),pop);
- STE: store(argg(k),pop);
- SIL: store(mema(locadr(k)),pop);
- STF: begin a:=popa; store(a+argf(k),pop) end;
- STI: popx(argo(k),popa);
- STS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- k:=popa; popx(argo(k),popa)
- end;
- SDL: begin a:=locadr(k); store(a,pop); store(a+wsize,pop) end;
- SDE: begin k:=argg(k); store(k,pop); store(k+wsize,pop) end;
- SDF: begin k:=argf(k); a:=popa; store(a+k,pop); store(a+k+wsize,pop) end
- end
-end;
-
-procedure intarith;
-var i:integer;
-begin
- case insr of
- { SIGNED INTEGER ARITHMETIC }
- ADI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:=popsw; push(fitsw(ss+st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(doadi(ds,dt)) end;
- end ;
- SBI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:= popsw; push(fitsw(ss-st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(dosbi(ds,dt)) end;
- end ;
- MLI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:= popsw; push(fitsw(ss*st,EIOVFL)) end;
- 2: begin dt:=popd; ds:=popd; pushd(domli(ds,dt)) end;
- end ;
- DVI: case szindex(argw(k)) of
- 1: begin st:= popsw; ss:= popsw;
- if st=0 then trap(EIDIVZ) else pushsw(ss div st)
- end;
- 2: begin dt:=popd; ds:=popd; pushd(dodvi(ds,dt)) end;
- end;
- RMI: case szindex(argw(k)) of
- 1: begin st:= popsw; ss:=popsw;
- if st=0 then trap(EIDIVZ) else pushsw(ss - (ss div st)*st)
- end;
- 2: begin dt:=popd; ds:=popd; pushd(dormi(ds,dt)) end
- end;
- NGI: case szindex(argw(k)) of
- 1: begin st:=popsw; pushsw(-st) end;
- 2: begin ds:=popd; pushd(dongi(ds)) end
- end;
- SLI: begin t:=pop;
- case szindex(argw(k)) of
- 1: begin ss:=popsw;
- for i:= 1 to t do sleft(ss); pushsw(ss)
- end
- end
- end;
- SRI: begin t:=pop;
- case szindex(argw(k)) of
- 1: begin ss:=popsw;
- for i:= 1 to t do sright(ss); pushsw(ss)
- end;
- 2: begin ds:=popd;
- for i:= 1 to t do sdright(ss); pushd(ss)
- end
- end
- end
- end
-end;
-
-procedure unsarith;
-var i:integer;
-begin
- case insr of
- { UNSIGNED INTEGER ARITHMETIC }
- ADU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s+t)) end;
- 2: trap(EILLINS);
- end ;
- SBU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s-t)) end;
- 2: trap(EILLINS);
- end ;
- MLU: case szindex(argw(k)) of
- 1: begin t:=pop; s:= pop; push(chopw(s*t)) end;
- 2: trap(EILLINS);
- end ;
- DVU: case szindex(argw(k)) of
- 1: begin t:= pop; s:= pop;
- if t=0 then trap(EIDIVZ) else push(s div t)
- end;
- 2: trap(EILLINS);
- end;
- RMU: case szindex(argw(k)) of
- 1: begin t:= pop; s:=pop;
- if t=0 then trap(EIDIVZ) else push(s - (s div t)*t)
- end;
- 2: trap(EILLINS);
- end;
- SLU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- for i:= 1 to t do suleft(s); push(s)
- end;
- 2: trap(EILLINS);
- end;
- SRU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- for i:= 1 to t do suright(s); push(s)
- end;
- 2: trap(EILLINS);
- end
- end
-end;
-
-procedure fltarith;
-begin
- case insr of
- { FLOATING POINT ARITHMETIC }
- ADF: begin argwf(k); rt:=popr; rs:=popr; pushr(doadf(rs,rt)) end;
- SBF: begin argwf(k); rt:=popr; rs:=popr; pushr(dosbf(rs,rt)) end;
- MLF: begin argwf(k); rt:=popr; rs:=popr; pushr(domlf(rs,rt)) end;
- DVF: begin argwf(k); rt:=popr; rs:=popr; pushr(dodvf(rs,rt)) end;
- NGF: begin argwf(k); rt:=popr; pushr(dongf(rt)) end;
- FIF: begin argwf(k); rt:=popr; rs:=popr;
- dofif(rt,rs,x,y); pushr(y); pushr(x)
- end;
- FEF: begin argwf(k); rt:=popr; dofef(rt,x,ss); pushr(x); pushsw(ss) end
- end
-end;
-
-procedure ptrarith;
-begin
- case insr of
- { POINTER ARITHMETIC }
- ADP: pusha(popa+argf(k));
- ADS: case szindex(argw(k)) of
- 1: begin st:=popsw; pusha(popa+st) end;
- 2: begin dt:=popd; pusha(popa+dt) end;
- end;
- SBS: begin
- a:=popa; b:=popa;
- case szindex(argw(k)) of
- 1: push(fitsw(b-a,EIOVFL));
- 2: pushd(b-a)
- end
- end
- end
-end;
-
-procedure incops;
-var j:integer;
-begin
- case insr of
- { INCREMENT/DECREMENT/ZERO }
- INC: push(fitsw(popsw+1,EIOVFL));
- INL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
- INE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
- DEC: push(fitsw(popsw-1,EIOVFL));
- DEL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
- DEE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
- ZRL: store(locadr(k),0);
- ZRE: store(argg(k),0);
- ZER: for j:=1 to argw(k) div wsize do push(0);
- ZRF: pushr(0);
- end
-end;
-
-procedure convops;
-begin
- case insr of
- { CONVERT GROUP }
- CII: begin s:=pop; t:=pop;
- if t<wsize then begin push(sextend(pop,t)); t:=wsize end;
- case szindex(argw(t)) of
- 1: if szindex(argw(s))=2 then pushd(popsw);
- 2: if szindex(argw(s))=1 then push(fitsw(popd,ECONV))
- end
- end;
- CIU: case szindex(argw(pop)) of
- 1: if szindex(argw(pop))=2 then push(unsign(popd mod negoff));
- 2: trap(EILLINS);
- end;
- CIF: begin argwf(pop);
- case szindex(argw(pop)) of 1:pushr(popsw); 2:pushr(popd) end
- end;
- CUI: case szindex(argw(pop)) of
- 1: case szindex(argw(pop)) of
- 1: begin s:=pop; if s>maxsint then trap(ECONV); push(s) end;
- 2: trap(EILLINS);
- end;
- 2: case szindex(argw(pop)) of
- 1: pushd(pop);
- 2: trap(EILLINS);
- end;
- end;
- CUU: case szindex(argw(pop)) of
- 1: if szindex(argw(pop))=2 then trap(EILLINS);
- 2: trap(EILLINS);
- end;
- CUF: begin argwf(pop);
- if szindex(argw(pop))=1 then pushr(pop) else trap(EILLINS)
- end;
- CFI: begin sz:=argw(pop); argwf(pop); rt:=popr;
- case szindex(sz) of
- 1: push(fitsw(trunc(rt),ECONV));
- 2: pushd(fitd(trunc(rt)));
- end
- end;
- CFU: begin sz:=argw(pop); argwf(pop); rt:=popr;
- case szindex(sz) of
- 1: push( chopw(trunc(abs(rt)-0.5)) );
- 2: trap(EILLINS);
- end
- end;
- CFF: begin argwf(pop); argwf(pop) end
- end
-end;
-
-procedure logops;
-var i,j:integer;
-begin
- case insr of
- { LOGICAL GROUP }
- XAND:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(andf,memw(a),t)) end;
- end;
- IOR:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(iorf,memw(a),t)) end;
- end;
- XOR:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin a:=sp+k; t:=pop; store(a,bf(xorf,memw(a),t)) end;
- end;
- COM:
- begin k:=argw(k);
- for j:= 1 to k div wsize do
- begin
- store(sp+k-wsize*j, bf(xorf,memw(sp+k-wsize*j), negoff-1))
- end
- end;
- ROL: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- t:=pop; s:=pop; for i:= 1 to t do rleft(s); push(s)
- end;
- ROR: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- t:=pop; s:=pop; for i:= 1 to t do rright(s); push(s)
- end
- end
-end;
-
-procedure setops;
-var i,j:integer;
-begin
- case insr of
- { SET GROUP }
- INN:
- begin k:=argw(k);
- t:=pop;
- i:= t mod 8; t:= t div 8;
- if t>=k then
- begin trap(ESET); s:=0 end
- else
- begin s:=memb(sp+t) end;
- newsp(sp+k); push(bit(i,s));
- end;
- XSET:
- begin k:=argw(k);
- t:=pop;
- i:= t mod 8; t:= t div 8;
- for j:= 1 to k div wsize do push(0);
- if t>=k then
- trap(ESET)
- else
- begin s:=1; for j:= 1 to i do rleft(s); storeb(sp+t,s) end
- end
- end
-end;
-
-procedure arrops;
-begin
- case insr of
- { ARRAY GROUP }
- LAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- pushx(argo(memw(a+2*k)),arraycalc(a))
- end;
- SAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- popx(argo(memw(a+2*k)),arraycalc(a))
- end;
- AAR:
- begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- push(arraycalc(a))
- end
- end
-end;
-
-procedure cmpops;
-begin
- case insr of
- { COMPARE GROUP }
- CMI: case szindex(argw(k)) of
- 1: begin st:=popsw; ss:=popsw;
- if ss<st then pushsw(-1) else if ss=st then push(0) else push(1)
- end;
- 2: begin dt:=popd; ds:=popd;
- if ds<dt then pushsw(-1) else if ds=dt then push(0) else push(1)
- end;
- end;
- CMU: case szindex(argw(k)) of
- 1: begin t:=pop; s:=pop;
- if s<t then pushsw(-1) else if s=t then push(0) else push(1)
- end;
- 2: trap(EILLINS);
- end;
- CMP: begin a:=popa; b:=popa;
- if b<a then pushsw(-1) else if b=a then push(0) else push(1)
- end;
- CMF: begin argwf(k); rt:=popr; rs:=popr;
- if rs<rt then pushsw(-1) else if rs=rt then push(0) else push(1)
- end;
- CMS: begin k:=argw(k);
- t:= 0; j:= 0;
- while (j < k) and (t=0) do
- begin if memw(sp+j) <> memw(sp+k+j) then t:=1;
- j:=j+wsize
- end;
- newsp(sp+wsize*k); push(t);
- end;
-
- TLT: if popsw < 0 then push(1) else push(0);
- TLE: if popsw <= 0 then push(1) else push(0);
- TEQ: if pop = 0 then push(1) else push(0);
- TNE: if pop <> 0 then push(1) else push(0);
- TGE: if popsw >= 0 then push(1) else push(0);
- TGT: if popsw > 0 then push(1) else push(0);
- end
-end;
-
-procedure branchops;
-begin
- case insr of
- { BRANCH GROUP }
- BRA: newpc(pc+k);
-
- BLT: begin st:=popsw; if popsw < st then newpc(pc+k) end;
- BLE: begin st:=popsw; if popsw <= st then newpc(pc+k) end;
- BEQ: begin t :=pop ; if pop = t then newpc(pc+k) end;
- BNE: begin t :=pop ; if pop <> t then newpc(pc+k) end;
- BGE: begin st:=popsw; if popsw >= st then newpc(pc+k) end;
- BGT: begin st:=popsw; if popsw > st then newpc(pc+k) end;
-
- ZLT: if popsw < 0 then newpc(pc+k);
- ZLE: if popsw <= 0 then newpc(pc+k);
- ZEQ: if pop = 0 then newpc(pc+k);
- ZNE: if pop <> 0 then newpc(pc+k);
- ZGE: if popsw >= 0 then newpc(pc+k);
- ZGT: if popsw > 0 then newpc(pc+k)
- end
-end;
-
-procedure callops;
-var j:integer;
-begin
- case insr of
- { PROCEDURE CALL GROUP }
- CAL: call(argp(k));
- CAI: begin call(argp(popa)) end;
- RET: begin k:=argz(k); if k div wsize>maxret then trap(EILLINS);
- for j:= 1 to k div wsize do retarea[j]:=pop; retsize:=k;
- newsp(lb); lb:=maxdata+1; { To circumvent stack overflow error }
- newpc(popa);
- if pc=maxcode then
- begin
- halted:=true;
- if retsize=wsize then exitstatus:=retarea[1]
- else exitstatus:=undef
- end
- else
- newlb(popa);
- end;
- LFR: begin k:=args(k); if k<>retsize then trap(EILLINS);
- for j:=k div wsize downto 1 do push(retarea[j]);
- end
- end
-end;
-
-procedure miscops;
-var i,j:integer;
-begin
- case insr of
- { MISCELLANEOUS GROUP }
- ASP,ASS:
- begin if insr=ASS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=popsw end;
- k:=argf(k);
- if k<0
- then for j:= 1 to -k div wsize do push(undef)
- else newsp(sp+k);
- end;
- BLM,BLS:
- begin if insr=BLS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
- k:=argz(k);
- b:=popa; a:=popa;
- for j := 1 to k div wsize do
- store(b-wsize+wsize*j,memw(a-wsize+wsize*j))
- end;
- CSA: begin k:=argw(k); if k<>wsize then trap(EILLINS);
- a:=popa;
- st:= popsw - signwd(memw(a+asize)); b:=0;
- if (st>=0) and (st<=memw(a+wsize+asize)) then
- b:=mema(a+2*wsize+asize+asize*st);
- if b=0 then b:=mema(a);
- if b=0 then trap(ECASE) else newpc(b)
- end;
- CSB: begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
- t:=pop; i:=1; found:=false;
- while (i<=memw(a+asize)) and not found do
- if t=memw(a+(asize+wsize)*i) then found:=true else i:=i+1;
- if found then b:=memw(a+(asize+wsize)*i+wsize) else b:=memw(a);
- if b=0 then trap(ECASE) else newpc(b);
- end;
- DCH: begin pusha(mema(popa+dynd)) end;
- DUP,DUS:
- begin if insr=DUS then
- begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
- k:=args(k);
- for i:=1 to k div wsize do push(memw(sp+k-wsize));
- end;
- EXG: begin
- k:=argw(k);
- for i:=1 to k div wsize do push(memw(sp+k-wsize));
- for i:=0 to k div wsize - 1 do
- store(sp+k+i*wsize,memw(sp+k+k+i*wsize));
- for i:=1 to k div wsize do
- begin t:=pop ; store(sp+k+k-wsize,t) end;
- end;
- FIL: filna(argg(k));
- GTO: begin k:=argg(k);
- newlb(mema(k+2*asize)); newsp(mema(k+asize)); newpc(mema(k))
- end;
- LIM: push(ignmask);
- LIN: lino(argn(k));
- LNI: lino(memw(0)+1);
- LOR: begin i:=argr(k);
- case i of 0:pusha(lb); 1:pusha(sp); 2:pusha(hp) end;
- end;
- LPB: pusha(popa+statd);
- MON: domon(pop);
- NOP: writeln('NOP at line ',memw(0):5) ;
- RCK: begin a:=popa;
- case szindex(argw(k)) of
- 1: if (signwd(memw(sp))<signwd(memw(a))) or
- (signwd(memw(sp))>signwd(memw(a+wsize))) then trap(ERANGE);
- 2: if (memd(sp)<memd(a)) or
- (memd(sp)>memd(a+2*wsize)) then trap(ERANGE);
- end
- end;
- RTT: dortt;
- SIG: begin a:=popa; pusha(uerrorproc); uerrorproc:=a end;
- SIM: ignmask:=pop;
- STR: begin i:=argr(k);
- case i of 0: newlb(popa); 1: newsp(popa); 2: newhp(popa) end;
- end;
- TRP: trap(pop)
- end
-end;
-{
-.bp
-{---------------------------------------------------------------------------}
-{ Main Loop }
-{---------------------------------------------------------------------------}
-
-begin initialize;
-8888:
- repeat
- opcode := nextpc; { fetch the first byte of the instruction }
- if opcode=escape1 then iclass:=second
- else if opcode=escape2 then iclass:=tert
- else iclass:=prim;
- if iclass<>prim then opcode := nextpc;
- with dispat[iclass][opcode] do
- begin insr:=instr;
- if not (zbit in iflag) then
- if ibit in iflag then k:=pop else
- begin
- if mini in iflag then k:=implicit else
- begin
- if short in iflag then k:=implicit+nextpc else
- begin k:=nextpc;
- if (sbit in iflag) and (k>=128) then k:=k-256;
- for i:=2 to ilength do k:=256*k + nextpc
- end
- end;
- if wbit in iflag then k:=k*wsize;
- end
- end;
-case insr of
-
- NON: trap(EILLINS);
-
- { LOAD GROUP }
- LDC,LOC,LOL,LOE,LIL,LOF,LAL,LAE,LXL,LXA,LOI,LOS,LDL,LDE,LDF,LPI:
- loadops;
-
- { STORE GROUP }
- STL,STE,SIL,STF,STI,STS,SDL,SDE,SDF:
- storeops;
-
- { SIGNED INTEGER ARITHMETIC }
- ADI,SBI,MLI,DVI,RMI,NGI,SLI,SRI:
- intarith;
-
- { UNSIGNED INTEGER ARITHMETIC }
- ADU,SBU,MLU,DVU,RMU,SLU,SRU:
- unsarith;
-
- { FLOATING POINT ARITHMETIC }
- ADF,SBF,MLF,DVF,NGF,FIF,FEF:
- fltarith;
-
- { POINTER ARITHMETIC }
- ADP,ADS,SBS:
- ptrarith;
-
- { INCREMENT/DECREMENT/ZERO }
- INC,INL,INE,DEC,DEL,DEE,ZRL,ZRE,ZER,ZRF:
- incops;
-
- { CONVERT GROUP }
- CII,CIU,CIF,CUI,CUU,CUF,CFI,CFU,CFF:
- convops;
-
- { LOGICAL GROUP }
- XAND,IOR,XOR,COM,ROL,ROR:
- logops;
-
- { SET GROUP }
- INN,XSET:
- setops;
-
- { ARRAY GROUP }
- LAR,SAR,AAR:
- arrops;
-
- { COMPARE GROUP }
- CMI,CMU,CMP,CMF,CMS, TLT,TLE,TEQ,TNE,TGE,TGT:
- cmpops;
-
- { BRANCH GROUP }
- BRA, BLT,BLE,BEQ,BNE,BGE,BGT, ZLT,ZLE,ZEQ,ZNE,ZGE,ZGT:
- branchops;
-
- { PROCEDURE CALL GROUP }
- CAL,CAI,RET,LFR:
- callops;
-
- { MISCELLANEOUS GROUP }
- ASP,ASS,BLM,BLS,CSA,CSB,DCH,DUP,DUS,EXG,FIL,GTO,LIM,
- LIN,LNI,LOR,LPB,MON,NOP,RCK,RTT,SIG,SIM,STR,TRP:
- miscops;
-
- end; { end of case statement }
- if not ( (insr=RET) or (insr=ASP) or (insr=BRA) or (insr=GTO) ) then
- retsize:=0 ;
- until halted;
-9999:
- writeln('halt with exit status: ',exitstatus:1);
- doident;
-end.
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/* Author: E.G. Keizer */
-
-/* Print a readable version of the data in the post mortem dump */
-/* dmpc [-s] [-dn,m] [file] */
-
-#include "/usr/em/h/local.h"
-#include <stdio.h>
-#include <ctype.h>
-
-int dflag = 0 ;
-long l_low,l_high;
-
-int sflag;
-
-int wsize,asize;
-long tsize,dsize;
-long ignmask,uerrorproc,cause;
-long pc,sp,lb,hp,pd,pb;
-
-char *cstr[] = {
- "Array bound error",
- "Range bound error",
- "Set error",
- "Integer overflow",
- "Float overflow",
- "Float underflow",
- "Divide by 0",
- "Divide by 0.0",
- "Integer undefined",
- "Float undefined",
- "Conversion error",
- "User error 11",
- "User error 12",
- "User error 13",
- "User error 14",
- "User error 15",
- "Stack overflow",
- "Heap overflow",
- "Illegal instruction",
- "Illegal size parameter",
- "Case error",
- "Memory fault",
- "Illegal pointer",
- "Illegal pc",
- "Bad argument of LAE",
- "Bad monitor call",
- "Bad line number",
- "GTO descriptor error"
-};
-
-FILE *fcore;
-char *core = "core" ;
-int nbyte=0;
-
-char *pname;
-
-int readbyte();
-int read2();
-long readaddr();
-long readword();
-unsigned getbyte();
-long getword();
-long getaddr();
-
-main(argc,argv) char **argv;
-{
- register i ;
- long line,fileaddr;
- char tok ;
-
- scanargs(argc,argv); fcore=fopen(core,"r") ;
- if ( fcore==NULL ) fatal("Can't open %s",core) ;
-
- if ( read2()!=010255 ) fatal("not a post mortem dump");
- if ( read2()!=VERSION ) fatal("wrong version dump file");
- wsize=read2(); asize=read2();
- if ( wsize>4 ) fatal("cannot handle word size %d",wsize) ;
- if ( asize>4 ) fatal("cannot handle pointer size %d",asize) ;
- tsize=readaddr(); dsize=readaddr();
- ignmask=readaddr(); uerrorproc=readaddr(); cause=readaddr();
- pc=readaddr(); sp=readaddr(); lb=readaddr(); hp=readaddr();
- pd=readaddr(); pb=readaddr();
- if ( sflag==0 ) {
- line=getword(0L);
- fileaddr=getaddr(4L);
- if ( fileaddr ) {
- for ( i=0 ; i<40 ; i++ ) {
- tok=getbyte(fileaddr++) ;
- if ( !isprint(tok) ) break ;
- putc(tok,stdout);
- }
- printf(" ");
- }
- if ( line ) {
- printf("line %D",line) ;
- }
- if ( fileaddr || line ) printf(", ");
- fseek(fcore,512L,0);
-
- if ( cause>27 ) {
- printn("cause",cause) ;
- } else {
- prints("cause",cstr[(int)cause]);
- }
- printn("pc",pc);printn("sp",sp);printn("lb",lb);
- printn("hp",hp);
- if ( pd ) printn("pd",pd) ;
- if ( pb ) printn("pb",pb) ;
- printn("errproc",uerrorproc) ;
- printn("ignmask",ignmask) ;
- if ( tsize ) printn("Text size",tsize) ;
- if ( dsize ) printn("Data size",dsize) ;
- }
- if ( dflag==0 ) return 0;
- fatal("d-flag not implemeted (yet)");
- return 1 ;
-}
-
-scanargs(argc,argv) char **argv ; {
- pname=argv[0];
- while ( argv++, argc-- > 1 ) {
- switch( argv[0][0] ) {
- case '-': switch( argv[0][1] ) {
- case 's': sflag++ ; break ;
- case 'l': dflag++ ; break ;
- default : fatal(": [-s] [-ln.m] [file]") ;
- } ;
- break ;
- default :core=argv[0] ;
- }
- }
-}
-
-prints(s1,s2) char *s1,*s2; {
- printf("%-15s %s\n",s1,s2);
-}
-
-printn(s1,d) char *s1; long d; {
- printf("%-15s %15ld\n",s1,d);
-}
-
-/* VARARGS1 */
-fatal(s1,p1,p2,p3,p4,p5) char *s1 ; {
- fprintf(stderr,"%s: ",pname);
- fprintf(stderr,s1,p1,p2,p3,p4,p5) ;
- fprintf(stderr,"\n") ;
- exit(1) ;
-}
-
-int getb() {
- int i ;
- i=getc(fcore) ;
- if ( i==EOF ) fatal("Premature EOF");
- return i&0377 ;
-}
-
-int read2() {
- int i ;
- i=getb() ; return getb()*256 + i ;
-}
-
-long readaddr() {
- long res ;
- register int i ;
-
- res=0 ;
- for (i=0 ; i<asize ; i++ ) res |= getb()<<(8*i) ;
- return res ;
-}
-
-long readword() {
- long res ;
- register int i ;
-
- res=0 ;
- for (i=0 ; i<wsize ; i++ ) res |= getb()<<(8*i) ;
- return res ;
-}
-
-unsigned getbyte(a) long a ; {
- fseek(fcore,a+512,0) ;
- return getb() ;
-}
-
-long getword(a) long a ; {
- fseek(fcore,a+512,0) ;
- return readword() ;
-}
-
-long getaddr(a) long a ; {
- fseek(fcore,a+512,0) ;
- return readaddr() ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/* Author: E.G. Keizer */
-
-#include <stdio.h>
-#include "/usr/em/util/ass/ip_spec.h"
-#include "/usr/em/h/em_spec.h"
-#include "/usr/em/h/em_flag.h"
-
-/* This program reads the human readable interpreter specification
- and produces a efficient machine representation that can be
- translated by a C-compiler.
-*/
-
-#define ESCAP 256
-
-int nerror = 0 ;
-int atend = 0 ;
-int line = 1 ;
-int maxinsl= 0 ;
-
-extern char em_mnem[][4] ;
-char esca[] = "escape" ;
-#define ename(no) ((no)==ESCAP?esca:em_mnem[(no)])
-
-extern char em_flag[] ;
-
-main(argc,argv) char **argv ; {
- if ( argc>1 ) {
- if ( freopen(argv[1],"r",stdin)==NULL) {
- fatal("Cannot open %s",argv[1]) ;
- }
- }
- if ( argc>2 ) {
- if ( freopen(argv[2],"w",stdout)==NULL) {
- fatal("Cannot create %s",argv[2]) ;
- }
- }
- if ( argc>3 ) {
- fatal("%s [ file [ file ] ]",argv[0]) ;
- }
- atend=0 ;
- readin();
- atend=1 ;
- return nerror ;
-}
-
-readin() {
- char *ident();
- char *firstid ;
- int opcode,flags;
- int c;
-
- while ( !feof(stdin) ) {
- firstid=ident() ;
- if ( *firstid=='\n' || feof(stdin) ) continue ;
- opcode = getmnem(firstid) ;
- printf("%d ",opcode+1) ;
- flags = decflag(ident(),opcode) ;
- switch(em_flag[opcode]&EM_PAR) {
- case PAR_D: case PAR_F: case PAR_B: case PAR_L: case PAR_C:
- putchar('S') ;
- }
- putchar(' ');
- while ( (c=readchar())!='\n' && c!=EOF ) putchar(c) ;
- putchar('\n') ;
- }
-}
-
-char *ident() {
- /* skip spaces and tabs, anything up to space,tab or eof is
- a identifier.
- Anything from # to end-of-line is an end-of-line.
- End-of-line is an identifier all by itself.
- */
-
- static char array[200] ;
- register int c ;
- register char *cc ;
-
- do {
- c=readchar() ;
- } while ( c==' ' || c=='\t' ) ;
- for ( cc=array ; cc<&array[(sizeof array) - 1] ; cc++ ) {
- if ( c=='#' ) {
- do {
- c=readchar();
- } while ( c!='\n' && c!=EOF ) ;
- }
- *cc = c ;
- if ( c=='\n' && cc==array ) break ;
- c=readchar() ;
- if ( c=='\n' ) {
- pushback(c) ;
- break ;
- }
- if ( c==' ' || c=='\t' || c==EOF ) break ;
- }
- *++cc=0 ;
- return array ;
-}
-
-int getmnem(str) char *str ; {
- char (*ptr)[4] ;
-
- for ( ptr = em_mnem ; *ptr<= &em_mnem[sp_lmnem][0] ; ptr++ ) {
- if ( strcmp(*ptr,str)==0 ) return (ptr-em_mnem) ;
- }
- error("Illegal mnemonic") ;
- return 0 ;
-}
-
-error(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- if ( !atend ) fprintf(stderr,"line %d: ",line) ;
- fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
- fprintf(stderr,"\n");
- nerror++ ;
-}
-
-mess(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- if ( !atend ) fprintf(stderr,"line %d: ",line) ;
- fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
- fprintf(stderr,"\n");
-}
-
-fatal(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- error(str,a1,a2,a3,a4,a5,a6) ;
- exit(1) ;
-}
-
-#define ILLGL -1
-
-check(val) int val ; {
- if ( val!=ILLGL ) error("Illegal flag combination") ;
-}
-
-int decflag(str,opc) char *str ; {
- int type ;
- int escape ;
- int range ;
- int wordm ;
- int notzero ;
- char c;
-
- type=escape=range=wordm=notzero= ILLGL ;
- while ( c= *str++ ) {
- switch ( c ) {
- case 'm' :
- check(type) ; type=OPMINI ; break ;
- case 's' :
- check(type) ; type=OPSHORT ; break ;
- case '-' :
- check(type) ; type=OPNO ;
- if ( (em_flag[opc]&EM_PAR)==PAR_W ) c='i' ;
- break ;
- case '1' :
- check(type) ; type=OP8 ; break ;
- case '2' :
- check(type) ; type=OP16 ; break ;
- case '4' :
- check(type) ; type=OP32 ; break ;
- case '8' :
- check(type) ; type=OP64 ; break ;
- case 'e' :
- check(escape) ; escape=0 ; break ;
- case 'N' :
- check(range) ; range= 2 ; break ;
- case 'P' :
- check(range) ; range= 1 ; break ;
- case 'w' :
- check(wordm) ; wordm=0 ; break ;
- case 'o' :
- check(notzero) ; notzero=0 ; break ;
- default :
- error("Unknown flag") ;
- }
- putchar(c);
- }
- if ( type==ILLGL ) error("Type must be specified") ;
- switch ( type ) {
- case OP64 :
- case OP32 :
- if ( escape!=ILLGL ) error("Conflicting escapes") ;
- escape=ILLGL ;
- case OP16 :
- case OP8 :
- case OPSHORT :
- case OPNO :
- if ( notzero!=ILLGL ) mess("Improbable OPNZ") ;
- if ( type==OPNO && range!=ILLGL ) {
- mess("No operand in range") ;
- }
- }
- if ( escape!=ILLGL ) type|=OPESC ;
- if ( wordm!=ILLGL ) type|=OPWORD ;
- switch ( range) {
- case ILLGL : type|=OP_BOTH ; break ;
- case 1 : type|=OP_POS ; break ;
- case 2 : type|=OP_NEG ; break ;
- }
- if ( notzero!=ILLGL ) type|=OPNZ ;
- return type ;
-}
-
-static int pushchar ;
-static int pushf ;
-
-int readchar() {
- int c ;
-
- if ( pushf ) {
- pushf=0 ;
- c = pushchar ;
- } else {
- if ( feof(stdin) ) return EOF ;
- c=getc(stdin) ;
- }
- if ( c=='\n' ) line++ ;
- return c ;
-}
-
-pushback(c) {
- if ( pushf ) {
- fatal("Double pushback") ;
- }
- pushf++ ;
- pushchar=c ;
- if ( c=='\n' ) line-- ;
-}
+++ /dev/null
-.BP
-.S1 "INTRODUCTION"
-EM is a family of intermediate languages designed for producing
-portable compilers.
-The general strategy is for a program called
-.B front end
-to translate the source program to EM.
-Another program,
-.B back
-.BW end
-translates EM to target assembly language.
-Alternatively, the EM code can be assembled to a binary form
-and interpreted.
-These considerations led to the following goals:
-.IS 2 10
-.PS 1 4
-.PT
-The design should allow translation to,
-or interpretation on, a wide range of existing machines.
-Design decisions should be delayed as far as possible
-and the implications of these decisions should
-be localized as much as possible.
-.N
-The current microcomputer technology offers 8, 16 and 32 bit machines
-with various sizes of address space.
-EM should be flexible enough to be useful on most of these
-machines.
-The differences between the members of the EM family should only
-concern the wordsize and address space size.
-.PT
-The architecture should ease the task of code generation for
-high level languages such as Pascal, C, Ada, Algol 68, BCPL.
-.PT
-The instruction set used by the interpreter should be compact,
-to reduce the amount of memory needed
-for program storage, and to reduce the time needed to transmit
-programs over communication lines.
-.PT
-It should be designed with microprogrammed implementations in
-mind; in particular, the use of many short fields within
-instruction opcodes should be avoided, because their extraction by the
-microprogram or conversion to other instruction formats is inefficient.
-.PE
-.IE
-.A
-The basic architecture is based on the concept of a stack. The stack
-is used for procedure return addresses, actual parameters, local variables,
-and arithmetic operations.
-There are several built-in object types,
-for example, signed and unsigned integers,
-floating point numbers, pointers and sets of bits.
-There are instructions to push and pop objects
-to and from the stack.
-The push and pop instructions are not typed.
-They only care about the size of the objects.
-For each built-in type there are
-reverse Polish type instructions that pop one or more
-objects from the top of
-the stack, perform an operation, and push the result back onto the
-stack.
-For all types except pointers,
-these instructions have the object size
-as argument.
-.P
-There are no visible general registers used for arithmetic operands
-etc. This is in contrast to most third generation computers, which usually
-have 8 or 16 general registers. The decision not to have a group of
-general registers was fully intentional, and follows W.L. Van der
-Poel's dictum that a machine should have 0, 1, or an infinite
-number of any feature. General registers have two primary uses: to hold
-intermediate results of complicated expressions, e.g.
-.IS 5 0 1
-((a*b + c*d)/e + f*g/h) * i
-.IE 1
-and to hold local variables.
-.P
-Various studies
-have shown that the average expression has fewer than two operands,
-making the former use of registers of doubtful value. The present trend
-toward structured programs consisting of many small
-procedures greatly reduces the value of registers to hold local variables
-because the large number of procedure calls implies a large overhead in
-saving and restoring the registers at every call.
-.BP
-.P
-Although there are no general purpose registers, there are a
-few internal registers with specific functions as follows:
-.IS 2
-.N 1
-.TS
-tab(:);
-l 1 l l.
-PC:-:Program Counter:Pointer to next instruction
-LB:-:Local Base:Points to base of the local variables \
-in the current procedure.
-SP:-:Stack Pointer:Points to the highest occupied word on the stack.
-HP:-:Heap Pointer:Points to the top of the heap area.
-.TE 1
-.IE
-.A
-Furthermore, reverse Polish code is much easier to generate than
-multi-register machine code, especially if highly efficient code is
-desired.
-When translating to assembly language the back end can make
-good use of the target machine's registers.
-An EM machine can
-achieve high performance by keeping part of the stack
-in high speed storage (a cache or microprogram scratchpad memory) rather
-than in primary memory.
-.P
-Again according to van der Poel's dictum,
-all EM instructions have zero or one argument.
-We believe that instructions needing two arguments
-can be split into two simpler ones.
-The simpler ones can probably be used in other
-circumstances as well.
-Moreover, these two instructions together often
-have a shorter encoding than the single
-instruction before.
-.P
-This document describes EM at three different levels:
-the abstract level, the assembly language level and
-the machine language level.
-.A
-The most important level is that of the abstract EM architecture.
-This level deals with the basic design issues.
-Only the functional capabilities of instructions are relevant, not their
-format or encoding.
-Most chapters of this document refer to the abstract level
-and it is explicitly stated whenever
-another level is described.
-.A
-The assembly language is intended for the compiler writer.
-It presents a more or less orthogonal instruction
-set and provides symbolic names for data.
-Moreover, it facilitates the linking of
-separately compiled 'modules' into a single program
-by providing several pseudoinstructions.
-.A
-The machine language is designed for interpretation with a compact
-program text and easy decoding.
-The binary representation of the machine language instruction set is
-far from orthogonal.
-Frequent instructions have a short opcode.
-The encoding is fully byte oriented.
-These bytes do not contain small bit fields, because
-bit fields would slow down decoding considerably.
-.P
-A common use for EM is for producing portable (cross) compilers.
-When used this way, the compilers produce
-EM assembly language as their output.
-To run the compiled program on the target machine,
-the back end, translates the EM assembly language to
-the target machine's assembly language.
-When this approach is used, the format of the EM
-machine language instructions is irrelevant.
-On the other hand, when writing an interpreter for EM machine language
-programs, the interpreter must deal with the machine language
-and not with the symbolic assembly language.
-.P
-As mentioned above, the
-current microcomputer technology offers 8, 16 and 32 bit
-machines with address spaces ranging from 2\v'-0.5m'16\v'0.5m'
-to 2\v'-0.5m'32\v'0.5m' bytes.
-Having one size of pointers and integers restricts
-the usefulness of the language.
-We decided to have a different language for each combination of
-word and pointer size.
-All languages offer the same instruction set and differ only in
-memory alignment restrictions and the implicit size assumed in
-several instructions.
-The languages
-differ slightly for the
-different size combinations.
-For example: the
-size of any object on the stack and alignment restrictions.
-The wordsize is restricted to powers of 2 and
-the pointer size must be a multiple of the wordsize.
-Almost all programs handling EM will be parametrized with word
-and pointer size.
+++ /dev/null
-.SN 8
-.VS 1 0
-.BP
-.S1 "ENVIRONMENT INTERACTIONS"
-EM programs can interact with their environment in three ways.
-Two, starting/stopping and monitor calls, are dealt with in this chapter.
-The remaining way to interact, interrupts, will be treated
-together with traps in chapter 9.
-.S2 "Program starting and stopping"
-EM user programs start with a call to a procedure called
-m_a_i_n.
-The assembler and backends look for the definition of a procedure
-with this name in their input.
-The call passes three parameters to the procedure.
-The parameters are similar to the parameters supplied by the
-UNIX
-.FS
-UNIX is a Trademark of Bell Laboratories.
-.FE
-operating system to C programs.
-These parameters are often called
-.BW argc ,
-.B argv
-and
-.BW envp .
-Argc is the parameter nearest to LB and is a wordsized integer.
-The other two are pointers to the first element of an array of
-string pointers.
-.N
-The
-.B argv
-array contains
-.B argc
-strings, the first of which contains the program call name.
-The other strings in the
-.B argv
-array are the program parameters.
-.P
-The
-.B envp
-array contains strings in the form "name=string", where 'name'
-is the name of an environment variable and string its value.
-The
-.B envp
-is terminated by a zero pointer.
-.P
-An EM user program stops if the program returns from the first
-invocation of m_a_i_n.
-The contents of the function return area are used to procure a
-wordsized program return code.
-EM programs also stop when traps and interrupts occur that are
-not caught and when the exit monitor call is executed.
-.S2 "Input/Output and other monitor calls"
-EM differs from most conventional machines in that it has high level i/o
-instructions.
-Typical instructions are OPEN FILE and READ FROM FILE instead
-of low level instructions such as setting and clearing
-bits in device registers.
-By providing such high level i/o primitives, the task of implementing
-EM on various non EM machines is made considerably easier.
-.P
-I/O is initiated by the MON instruction, which expects an iocode on top
-of the stack.
-Often there are also parameters which are pushed on the
-stack in reverse order, that is: last
-parameter first.
-Some i/o functions also provide results, which are returned on the stack.
-In the list of monitor calls we use several types of parameters and results,
-these types consist of integers and unsigneds of varying sizes, but never
-smaller than the wordsize, and the two pointer types.
-.N 1
-The names of the types used are:
-.IS 4
-.PS - 10
-.PT int
-an integer of wordsize
-.PT int2
-an integer whose size is the maximum of the wordsize and 2
-bytes
-.PT int4
-an integer whose size is the maximum of the wordsize and 4
-bytes
-.PT intp
-an integer with the size of a pointer
-.PT uns2
-an unsigned integer whose size is the maximum of the wordsize and 2
-.PT unsp
-an unsigned integer with the size of a pointer
-.PT ptr
-a pointer into data space
-.PE 1
-.IE 0
-The table below lists the i/o codes with their results and
-parameters.
-This list is similar to the system calls of the UNIX Version 7
-operating system.
-.BP
-.A
-To execute a monitor call, proceed as follows:
-.IS 2
-.N 1
-.PS a 4 "" )
-.PT
-Stack the parameters, in reverse order, last parameter first.
-.PT
-Push the monitor call number (iocode) onto the stack.
-.PT
-Execute the MON instruction.
-.PE 1
-.IE
-An error code is present on the top of the stack after
-execution of most monitor calls.
-If this error code is zero, the call performed the action
-requested and the results are available on top of the stack.
-Non-zero error codes indicate a failure, in this case no
-results are available and the error code has been pushed twice.
-This construction enables programs to test for failure with a
-single instruction (~TEQ or TNE~) and still find out the cause of
-the failure.
-The result name 'e' is reserved for the error code.
-.N 1
-List of monitor calls.
-.DS B
-number name parameters results function
-
- 1 Exit status:int Terminate this process
- 2 Fork e,flag,pid:int Spawn new process
- 3 Read fildes:int;buf:ptr;nbytes:unsp
- e:int;rbytes:unsp Read from file
- 4 Write fildes:int;buf:ptr;nbytes:unsp
- e:int;wbytes:unsp Write on a file
- 5 Open string:ptr;flag:int
- e,fildes:int Open file for read and/or write
- 6 Close fildes:int e:int Close a file
- 7 Wait e:int;status,pid:int2
- Wait for child
- 8 Creat string:ptr;mode:int
- e,fildes:int Create a new file
- 9 Link string1,string2:ptr
- e:int Link to a file
- 10 Unlink string:ptr e:int Remove directory entry
- 12 Chdir string:ptr e:int Change default directory
- 14 Mknod string:ptr;mode,addr:int2
- e:int Make a special file
- 15 Chmod string:ptr;mode:int2
- e:int Change mode of file
- 16 Chown string:ptr;owner,group:int2
- e:int Change owner/group of a file
- 18 Stat string,statbuf:ptr
- e:int Get file status
- 19 Lseek fildes:int;off:int4;whence:int
- e:int;oldoff:int4 Move read/write pointer
- 20 Getpid pid:int2 Get process identification
- 21 Mount special,string:ptr;rwflag:int
- e:int Mount file system
- 22 Umount special:ptr e:int Unmount file system
- 23 Setuid userid:int2 e:int Set user ID
- 24 Getuid e_uid,r_uid:int2 Get user ID
- 25 Stime time:int4 e:int Set time and date
- 26 Ptrace request:int;pid:int2;addr:ptr;data:int
- e,value:int Process trace
- 27 Alarm seconds:uns2 previous:uns2 Schedule signal
- 28 Fstat fildes:int;statbuf:ptr
- e:int Get file status
- 29 Pause Stop until signal
- 30 Utime string,timep:ptr
- e:int Set file times
- 33 Access string,mode:int e:int Determine file accessibility
- 34 Nice incr:int Set program priority
- 35 Ftime bufp:ptr e:int Get date and time
- 36 Sync Update filesystem
- 37 Kill pid:int2;sig:int
- e:int Send signal to a process
- 41 Dup fildes,newfildes:int
- e,fildes:int Duplicate a file descriptor
- 42 Pipe e,w_des,r_des:int Create a pipe
- 43 Times buffer:ptr Get process times
- 44 Profil buff:ptr;bufsiz,offset,scale:intp Execution time profile
- 46 Setgid gid:int2 e:int Set group ID
- 47 Getgid e_gid,r_gid:int Get group ID
- 48 Sigtrp trapno,signo:int
- e,prevtrap:int See below
- 51 Acct file:ptr e:int Turn accounting on or off
- 53 Lock flag:int e:int Lock a process
- 54 Ioctl fildes,request:int;argp:ptr
- e:int Control device
- 56 Mpxcall cmd:int;vec:ptr e:int Multiplexed file handling
- 59 Exece name,argv,envp:ptr
- e:int Execute a file
- 60 Umask complmode:int2 oldmask:int2 Set file creation mode mask
- 61 Chroot string:ptr e:int Change root directory
-.DE 1
-Codes 0, 11, 13, 17, 31, 32, 38, 39, 40, 45, 49, 50, 52,
-55, 57, 58, 62, and 63 are
-not used.
-.P
-All monitor calls, except fork and sigtrp
-are the same as the UNIX version 7 system calls.
-.P
-The sigtrp entry maps UNIX signals onto EM interrupts.
-Normally, trapno is in the range 0 to 252.
-In that case it requests that signal signo
-will cause trap trapno to occur.
-When given trap number -2, default signal handling is reset, and when given
-trap number -3, the signal is ignored.
-.P
-The flag returned by fork is 1 in the child process and 0 in
-the parent.
-The pid returned is the process-id of the other process.
-.BP
-.S1 "TRAPS AND INTERRUPTS"
-EM provides a means for the user program to catch all traps
-generated by the program itself, the hardware, or external conditions.
-This mechanism uses five instructions: LIM, SIM, SIG, TRP and RTT.
-This section of the manual may be omitted on the first reading since it
-presupposes knowledge of the EM instruction set.
-.P
-The action taken when a trap occures is determined by the value
-of an internal EM trap register.
-This register contains a pointer to a procedure.
-Initially the pointer used is zero and all traps halt the
-program with, hopefully, a useful message to the outside world.
-The SIG instruction can be used to alter the trap register,
-it pops a procedure pointer from the
-stack into the trap register.
-When a trap occurs after storing a nonzero value in the trap
-register, the procedure pointed to by the trap register
-is called with the trap number
-as the only parameter (see below).
-SIG returns the previous value of the trap register on the
-stack.
-Two consecutive SIGs are a no-op.
-When a trap occurs, the trap register is reset to its initial
-condition, to prevent recursive traps from hanging the machine up,
-e.g. stack overflow in the stack overflow handling procedure.
-.P
-The runtime systems for some languages need to ignore some EM
-traps.
-EM offers a feature called the ignore mask.
-It contains one bit for each of the lowest 16 trap numbers.
-The bits are numbered 0 to 15, with the least significant bit
-having number 0.
-If a certain bit is 1 the corresponding trap never
-occurs and processing simply continues.
-The actions performed by the offending instruction are
-described by the Pascal program in appendix A.
-.N
-If the bit is 0, traps are not ignored.
-The instructions LIM and SIM allow copying and replacement of
-the ignore mask.~
-.P
-The TRP instruction generates a trap, the trap number being found on the
-stack.
-This is, among other things,
-useful for library procedures and runtime systems.
-It can also be used by a low level trap procedure to pass the trap to a
-higher level one (see example below).
-.P
-The RTT instruction returns from the trap procedure and continues after the
-trap.
-In the list below all traps marked with an asterisk ('*') are
-considered to be fatal and it is explicitly undefined what happens if
-you try to restart after the trap.
-.P
-The way a trap procedure is called is completely compatible
-with normal calling conventions. The only way a trap procedure
-differs from normal procedures is the return. It has to use RTT instead
-of RET. This is necessary because the complete runtime status is saved on the
-stack before calling the procedure and all this status has to be reloaded.
-Error numbers are in the range 0 to 252.
-The trap numbers are divided into three categories:
-.IS 4
-.N 1
-.PS - 10
-.PT ~~0-~63
-EM machine errors, e.g. illegal instruction.
-.PS - 8
-.PT ~0-15
-maskable
-.PT 16-63
-not maskable
-.PE
-.PT ~64-127
-Reserved for use by compilers, run time systems, etc.
-.PT 128-252
-Available for user programs.
-.PE 1
-.IE
-EM machine errors are numbered as follows:
-.DS I 5
-.TS
-tab(@);
-n l l.
-0@EARRAY@Array bound error
-1@ERANGE@Range bound error
-2@ESET@Set bound error
-3@EIOVFL@Integer overflow
-4@EFOVFL@Floating overflow
-5@EFUNFL@Floating underflow
-6@EIDIVZ@Divide by 0
-7@EFDIVZ@Divide by 0.0
-8@EIUND@Undefined integer
-9@EFUND@Undefined float
-10@ECONV@Conversion error
-16*@ESTACK@Stack overflow
-17*@EHEAP@Heap overflow
-18*@EILLINS@Illegal instruction
-19*@EODDZ@Illegal size argument
-20*@ECASE@Case error
-21*@EMEMFLT@Addressing non existent memory
-22*@EBADPTR@Bad pointer used
-23*@EBADPC@Program counter out of range
-24@EBADLAE@Bad argument of LAE
-25@EBADMON@Bad monitor call
-26@EBADLIN@Argument of LIN too high
-27@EBADGTO@GTO descriptor error
-.TE
-.DE 0
-.P
-As an example,
-suppose a subprocedure has to be written to do a numeric
-calculation.
-When an overflow occurs the computation has to be stopped and
-the higher level procedure must be resumed.
-This can be programmed as follows using the mechanism described above:
-.DS B
- mes 2,2,2 ; set sizes
-ersave
- bss 2,0,0 ; Room to save previous value of trap procedure
-msave
- bss 2,0,0 ; Room to save previous value of trap mask
-
- pro calcule,0 ; entry point
- lxl 0 ; fill in non-local goto descriptor with LB
- ste jmpbuf+4
- lor 1 ; and SP
- ste jmpbuf+2
- lim ; get current ignore mask
- ste msave ; save it
- lim
- loc 4 ; bit for EFOVFL
- ior 2 ; set in mask
- sim ; ignore EFOVFL from now on
- lpi $catch ; load procedure identifier
- sig ; catch wil get all traps now
- ste ersave ; save previous trap procedure identifier
-; perform calculation now, possibly generating overflow
-1 ; label jumped to by catch procedure
- loe ersave ; get old trap procedure
- sig ; refer all following trap to old procedure
- asp 2 ; remove result of sig
- loe msave ; restore previous mask
- sim ; done now
-; load result of calculation
- ret 2 ; return result
-jmpbuf
- con *1,0,0
- end
-.DE 0
-.VS 1 1
-.DS
-Example of catch procedure
- pro catch,0 ; Local procedure that must catch the overflow trap
- lol 2 ; Load trap number
- loc 4 ; check for overflow
- bne *1 ; if other trap, call higher trap procedure
- gto jmpbuf ; return to procedure calcule
-1 ; other trap has occurred
- loe ersave ; previous trap procedure
- sig ; other procedure will get the traps now
- asp 2 ; remove the result of sig
- lol 2 ; stack trap number
- trp ; call other trap procedure
- rtt ; if other procedure returns, do the same
- end
-.DE
+++ /dev/null
-BEGIN { printf ".TS\nlw(6) lw(8) rw(3) rw(6) 14 lw(6) lw(8) rw(3) rw(6) 14 lw(6) lw(8) rw(3) rw(6).\n" }
-NF == 4 { printf "%s\t%s\t%d\t%d",$1,$2,$3,$4 }
-NF == 3 { printf "%s\t%s\t\t%d",$1,$2,$3 }
- { if ( NR%3 == 0 ) printf("\n") ; else printf("\t"); }
-END { if ( NR%3 != 0 ) printf("\n")
- printf ".TE\n" }
+++ /dev/null
-.SN 3
-.BP
-.S1 "INSTRUCTION ADDRESS SPACE"
-The instruction space of the EM machine contains
-the code for procedures.
-Tables necessary for the execution of this code, for example, procedure
-descriptor tables, may also be present.
-The instruction space does not change during
-the execution of a program, so that it may be
-protected.
-No further restrictions to the instruction address space are
-necessary for the abstract and assembly language level.
-.P
-Each procedure has a single entry point: the first instruction.
-A special type of pointer identifies a procedure.
-Pointers into the instruction
-address space have the same size as pointers into data space and
-can, for example, contain the address of the first instruction
-or an index in a procedure descriptor table.
-.A
-There is a single EM program counter, PC, pointing
-to the next instruction to be executed.
-The procedure pointed to by PC is
-called the 'current' procedure.
-A procedure may call another procedure using the CAL or CAI
-instruction.
-The calling procedure remains 'active' and is resumed whenever the called
-procedure returns.
-Note that a procedure has several 'active' invocations when
-called recursively.
-.P
-Each procedure must return properly.
-It is not allowed to fall through to the
-code of the next procedure.
-There are several ways to exit from a procedure:
-.IS 3
-.PS
-.PT
-the RET instruction, which returns to the
-calling procedure.
-.PT
-the RTT instruction, which exits a trap handling routine and resumes
-the trapping instruction (see next chapter).
-.PT
-the GTO instruction, which is used for non-local goto's.
-It can remove several frames from the stack and transfer
-control to an active procedure.
-.PE
-.IE
-.P
-All branch instructions can transfer control
-to any label within the same procedure.
-Branch instructions can never jump out of a procedure.
-.P
-Several language implementations use a so called procedure
-instance identifier, a combination of a procedure identifier and
-the LB of a stack frame, also called static link.
-.P
-The program text for each procedure, as well as any tables,
-are fragments and can be allocated anywhere
-in the instruction address space.
+++ /dev/null
-.TS
-.if \n+(b.=1 .nr d. \n(.c-\n(c.-1
-.de 35
-.ps \n(.s
-.vs \n(.vu
-.in \n(.iu
-.if \n(.u .fi
-.if \n(.j .ad
-.if \n(.j=0 .na
-..
-.nf
-.nr #~ 0
-.if n .nr #~ 0.6n
-.ds #d .d
-.if \(ts\n(.z\(ts\(ts .ds #d nl
-.fc
-.nr 33 \n(.s
-.rm 80 81 82 83 84 85 86 87 88 89 90 91
-.nr 80 0
-.nr 38 \w\ 2aar\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2adp\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2adp\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2asp\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2beq\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ble\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2bne\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2bra\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cff\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cmf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cms\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dec\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dup\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2fil\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ine\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2inn\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lae\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ldc\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ldl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lfr\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lil\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lni\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2loc\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2loe\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lof\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2loi\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lxa\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2mli\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ret\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sbf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2set\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sli\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2stf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sti\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2stl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2stl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2tgt\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zeq\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zge\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zlt\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zre\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zrl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2aar\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2adi\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ads\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2and\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ass\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2bgt\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2bls\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2bne\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cfi\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cmf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cmi\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cmu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2com\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2csb\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2cui\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2del\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dus\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dvf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dvu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2fef\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2inl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2inn\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lar\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ldf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lfr\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lim\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lor\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2lxl\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2mli\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2mlu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ngf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2nop\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ret\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2rmu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2rol\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2rtt\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sbf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sbi\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sbu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sdf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2set\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sil\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sli\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2slu\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sru\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2sts\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2tge\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2xor\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zer\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zle\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2zrf\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2dch\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2exg\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 38 \w\ 2ldc\ 2
-.if \n(80<\n(38 .nr 80 \n(38
-.80
-.rm 80
-.nr 38 6n
-.if \n(80<\n(38 .nr 80 \n(38
-.nr 81 0
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sN\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2N2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2swP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mN\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2w2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2wP2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwN\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2wP2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2mwN\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2w2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2esP\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(81<\n(38 .nr 81 \n(38
-.81
-.rm 81
-.nr 38 8n
-.if \n(81<\n(38 .nr 81 \n(38
-.nr 82 0
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 25\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 28\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 25\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(82<\n(38 .nr 82 \n(38
-.82
-.rm 82
-.nr 38 3n
-.if \n(82<\n(38 .nr 82 \n(38
-.nr 83 0
-.nr 38 \w\ 234\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 238\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 242\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 245\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 252\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 255\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 258\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 262\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 293\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 296\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2100\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2103\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2106\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2109\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2112\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2117\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2120\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2129\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2132\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2136\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2139\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2143\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2146\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2150\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2152\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2155\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2162\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2168\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2174\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2180\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2190\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2194\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2199\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2202\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2206\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2209\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2214\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2218\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2224\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2228\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2235\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2238\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2242\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2245\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2248\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2252\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 27\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 210\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 213\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 216\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 219\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 222\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 225\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 228\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 231\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 234\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 237\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 240\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 243\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 246\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 249\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 252\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 255\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 258\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 261\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 264\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 267\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 270\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 273\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 276\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 279\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 282\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 285\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 288\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 291\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 294\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 297\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2100\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2103\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2106\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2109\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2112\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2115\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2118\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2121\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2124\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2127\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2130\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2133\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2136\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2139\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2142\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2145\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2148\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2151\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2154\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 2157\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 38 \w\ 20\ 2
-.if \n(83<\n(38 .nr 83 \n(38
-.83
-.rm 83
-.nr 38 6n
-.if \n(83<\n(38 .nr 83 \n(38
-.nr 84 0
-.nr 38 \w\ 2adf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2adp\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ads\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2asp\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2bge\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2blm\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2bra\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cal\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cif\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cmi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2csa\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2dee\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2dvf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2inc\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2inl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ior\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lae\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lde\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ldl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lil\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lin\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2loc\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2loc\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2loe\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lof\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2loi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lxl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2rck\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2rmi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sbi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sil\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ste\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2stf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sti\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2stl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2stl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2tlt\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zeq\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zgt\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zne\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zre\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zrl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2adf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2adi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2adu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2and\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ass\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ble\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2bls\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cai\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cfu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cmf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cms\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cmu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2csa\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2csb\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2cuu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2del\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2dus\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2dvi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2dvu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2fif\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2inl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ior\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lar\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ldl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lil\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2los\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lpi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2mlf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2mli\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2mon\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ngi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2rck\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2rmi\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2rmu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2ror\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sar\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sbf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sbs\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sbu\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sdl\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2set\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sil\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sli\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sri\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sru\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2sts\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2tle\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2xor\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zge\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zlt\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2zrf\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2exg\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 38 \w\ 2lpb\ 2
-.if \n(84<\n(38 .nr 84 \n(38
-.84
-.rm 84
-.nr 38 6n
-.if \n(84<\n(38 .nr 84 \n(38
-.nr 85 0
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2m\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2w2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2wN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2w2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2wN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2wN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2esP\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(85<\n(38 .nr 85 \n(38
-.85
-.rm 85
-.nr 38 8n
-.if \n(85<\n(38 .nr 85 \n(38
-.nr 86 0
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 228\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 23\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 27\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 25\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(86<\n(38 .nr 86 \n(38
-.86
-.rm 86
-.nr 38 3n
-.if \n(86<\n(38 .nr 86 \n(38
-.nr 87 0
-.nr 38 \w\ 235\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 239\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 243\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 250\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 253\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 256\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 259\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 264\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 294\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 297\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2101\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2104\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2107\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2110\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2113\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2118\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2121\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2130\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2133\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2137\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2140\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2144\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2148\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2151\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2153\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2156\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2166\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2169\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2175\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2188\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2191\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2196\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2200\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2203\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2207\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2210\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2215\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2219\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2225\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2233\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2236\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2239\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2243\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2246\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2249\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2253\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 25\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 28\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 211\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 214\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 217\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 220\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 223\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 226\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 229\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 232\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 235\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 238\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 241\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 244\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 247\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 250\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 253\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 256\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 259\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 262\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 265\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 268\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 271\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 274\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 277\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 280\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 283\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 286\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 289\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 292\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 295\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 298\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2101\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2104\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2107\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2110\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2113\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2116\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2119\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2122\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2125\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2128\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2131\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2134\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2137\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2140\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2143\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2146\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2149\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2152\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2155\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 38 \w\ 2158\ 2
-.if \n(87<\n(38 .nr 87 \n(38
-.87
-.rm 87
-.nr 38 6n
-.if \n(87<\n(38 .nr 87 \n(38
-.nr 88 0
-.nr 38 \w\ 2adi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2adp\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2and\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2beq\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2bgt\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2blt\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2bra\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cal\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cii\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cmp\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2csb\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2del\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2dvi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ine\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2inl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ior\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lal\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lar\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lde\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lfr\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lil\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lin\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2loc\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2loc\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lof\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2loi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2loi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lol\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2mlf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ret\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sar\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sdl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sil\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ste\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2stf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sti\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2stl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2teq\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2tne\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zer\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zle\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zne\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zrl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2aar\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2adf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ads\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2adu\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2asp\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2bge\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2blm\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2blt\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cal\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ciu\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cmi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cms\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2com\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2csa\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2cuf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2dee\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2dup\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2dvf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2dvi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2fef\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2fif\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2inn\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ior\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ldc\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ldl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lil\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2los\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2lxa\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2mlf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2mlu\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ngf\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ngi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2rck\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2rmi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2rol\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2ror\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sar\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sbi\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sbs\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sde\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sdl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sig\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sim\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2slu\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sri\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2sti\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2str\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2trp\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zer\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zgt\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zne\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2zrl\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2exg\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 38 \w\ 2gto\ 2
-.if \n(88<\n(38 .nr 88 \n(38
-.88
-.rm 88
-.nr 38 6n
-.if \n(88<\n(38 .nr 88 \n(38
-.nr 89 0
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2w2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2P2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwPo\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2swP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sw\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2sN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2mwN\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ew2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ew2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ewN2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2esP\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e-\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2ewP2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 38 \w\ 2e2\ 2
-.if \n(89<\n(38 .nr 89 \n(38
-.89
-.rm 89
-.nr 38 8n
-.if \n(89<\n(38 .nr 89 \n(38
-.nr 90 0
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 234\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 24\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 23\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 22\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 38 \w\ 21\ 2
-.if \n(90<\n(38 .nr 90 \n(38
-.90
-.rm 90
-.nr 38 3n
-.if \n(90<\n(38 .nr 90 \n(38
-.nr 91 0
-.nr 38 \w\ 236\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 241\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 244\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 251\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 254\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 257\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 260\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 292\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 295\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 299\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2102\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2105\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2108\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2111\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2116\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2119\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2128\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2131\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2135\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2138\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2141\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2145\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2149\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 20\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2154\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2161\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2167\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2173\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2176\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2189\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2193\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2197\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2201\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2205\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2208\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2211\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2217\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2223\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2226\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2234\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2237\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2241\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2244\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2247\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2250\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 20\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 23\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 26\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 29\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 212\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 215\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 218\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 221\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 224\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 227\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 230\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 233\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 236\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 239\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 242\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 245\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 248\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 251\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 254\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 257\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 260\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 263\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 266\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 269\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 272\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 275\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 278\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 281\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 284\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 287\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 290\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 293\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 296\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 299\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2102\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2105\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2108\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2111\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2114\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2117\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2120\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2123\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2126\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2129\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2132\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2135\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2138\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2141\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2144\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2147\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2150\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2153\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2156\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 \w\ 2159\ 2
-.if \n(91<\n(38 .nr 91 \n(38
-.91
-.rm 91
-.nr 38 6n
-.if \n(91<\n(38 .nr 91 \n(38
-.nr 38 1n
-.nr 79 0
-.nr 40 \n(79+(0*\n(38)
-.nr 80 +\n(40
-.nr 41 \n(80+(3*\n(38)
-.nr 81 +\n(41
-.nr 42 \n(81+(3*\n(38)
-.nr 82 +\n(42
-.nr 43 \n(82+(3*\n(38)
-.nr 83 +\n(43
-.nr 44 \n(83+(14*\n(38)
-.nr 84 +\n(44
-.nr 45 \n(84+(3*\n(38)
-.nr 85 +\n(45
-.nr 46 \n(85+(3*\n(38)
-.nr 86 +\n(46
-.nr 47 \n(86+(3*\n(38)
-.nr 87 +\n(47
-.nr 48 \n(87+(14*\n(38)
-.nr 88 +\n(48
-.nr 49 \n(88+(3*\n(38)
-.nr 89 +\n(49
-.nr 50 \n(89+(3*\n(38)
-.nr 90 +\n(50
-.nr 51 \n(90+(3*\n(38)
-.nr 91 +\n(51
-.nr TW \n(91
-.if t .if (\n(TW+\n(.o)>7.65i .tm Table at line 103 file Input is too wide - \n(TW units
-.fc \ 2 \ 3
-.nr #T 0-1
-.nr #a 0-1
-.eo
-.de T#
-.ds #d .d
-.if \(ts\n(.z\(ts\(ts .ds #d nl
-.mk ##
-.nr ## -1v
-.ls 1
-.ls
-..
-.ec
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2aar\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 334\ 2\h'|\n(44u'\ 2adf\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 335\ 2\h'|\n(48u'\ 2adi\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 336\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2adp\ 3\ 2\h'|\n(41u'\ 22\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 338\ 2\h'|\n(44u'\ 2adp\ 3\ 2\h'|\n(45u'\ 2mPo\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 339\ 2\h'|\n(48u'\ 2adp\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 341\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2adp\ 3\ 2\h'|\n(41u'\ 2sN\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 342\ 2\h'|\n(44u'\ 2ads\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 343\ 2\h'|\n(48u'\ 2and\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 344\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2asp\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 35\ 2\h'|\n(43u'\ 2\ 345\ 2\h'|\n(44u'\ 2asp\ 3\ 2\h'|\n(45u'\ 2swP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 350\ 2\h'|\n(48u'\ 2beq\ 3\ 2\h'|\n(49u'\ 22\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 351\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2beq\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 352\ 2\h'|\n(44u'\ 2bge\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 353\ 2\h'|\n(48u'\ 2bgt\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 354\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ble\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 355\ 2\h'|\n(44u'\ 2blm\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 356\ 2\h'|\n(48u'\ 2blt\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 357\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2bne\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 358\ 2\h'|\n(44u'\ 2bra\ 3\ 2\h'|\n(45u'\ 22\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 359\ 2\h'|\n(48u'\ 2bra\ 3\ 2\h'|\n(49u'\ 2sN\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 360\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2bra\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 32\ 2\h'|\n(43u'\ 2\ 362\ 2\h'|\n(44u'\ 2cal\ 3\ 2\h'|\n(45u'\ 2mPo\ 3\ 2\h'|\n(46u'\ 2\ 328\ 2\h'|\n(47u'\ 2\ 364\ 2\h'|\n(48u'\ 2cal\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 392\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cff\ 3\ 2\h'|\n(41u'\ 2-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 393\ 2\h'|\n(44u'\ 2cif\ 3\ 2\h'|\n(45u'\ 2-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 394\ 2\h'|\n(48u'\ 2cii\ 3\ 2\h'|\n(49u'\ 2-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 395\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cmf\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 396\ 2\h'|\n(44u'\ 2cmi\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 397\ 2\h'|\n(48u'\ 2cmp\ 3\ 2\h'|\n(49u'\ 2-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 399\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cms\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3100\ 2\h'|\n(44u'\ 2csa\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3101\ 2\h'|\n(48u'\ 2csb\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3102\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dec\ 3\ 2\h'|\n(41u'\ 2-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3103\ 2\h'|\n(44u'\ 2dee\ 3\ 2\h'|\n(45u'\ 2sw\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3104\ 2\h'|\n(48u'\ 2del\ 3\ 2\h'|\n(49u'\ 2swN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3105\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dup\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3106\ 2\h'|\n(44u'\ 2dvf\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3107\ 2\h'|\n(48u'\ 2dvi\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3108\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2fil\ 3\ 2\h'|\n(41u'\ 22\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3109\ 2\h'|\n(44u'\ 2inc\ 3\ 2\h'|\n(45u'\ 2-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3110\ 2\h'|\n(48u'\ 2ine\ 3\ 2\h'|\n(49u'\ 2w2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3111\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ine\ 3\ 2\h'|\n(41u'\ 2sw\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3112\ 2\h'|\n(44u'\ 2inl\ 3\ 2\h'|\n(45u'\ 2mwN\ 3\ 2\h'|\n(46u'\ 2\ 33\ 2\h'|\n(47u'\ 2\ 3113\ 2\h'|\n(48u'\ 2inl\ 3\ 2\h'|\n(49u'\ 2swN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3116\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2inn\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3117\ 2\h'|\n(44u'\ 2ior\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3118\ 2\h'|\n(48u'\ 2ior\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3119\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lae\ 3\ 2\h'|\n(41u'\ 22\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3120\ 2\h'|\n(44u'\ 2lae\ 3\ 2\h'|\n(45u'\ 2sw\ 3\ 2\h'|\n(46u'\ 2\ 37\ 2\h'|\n(47u'\ 2\ 3121\ 2\h'|\n(48u'\ 2lal\ 3\ 2\h'|\n(49u'\ 2P2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3128\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lal\ 3\ 2\h'|\n(41u'\ 2N2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3129\ 2\h'|\n(44u'\ 2lal\ 3\ 2\h'|\n(45u'\ 2m\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3130\ 2\h'|\n(48u'\ 2lal\ 3\ 2\h'|\n(49u'\ 2mN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3131\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lal\ 3\ 2\h'|\n(41u'\ 2swP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3132\ 2\h'|\n(44u'\ 2lal\ 3\ 2\h'|\n(45u'\ 2swN\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 3133\ 2\h'|\n(48u'\ 2lar\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3135\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ldc\ 3\ 2\h'|\n(41u'\ 2mP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3136\ 2\h'|\n(44u'\ 2lde\ 3\ 2\h'|\n(45u'\ 2w2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3137\ 2\h'|\n(48u'\ 2lde\ 3\ 2\h'|\n(49u'\ 2sw\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3138\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ldl\ 3\ 2\h'|\n(41u'\ 2mP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3139\ 2\h'|\n(44u'\ 2ldl\ 3\ 2\h'|\n(45u'\ 2swN\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3140\ 2\h'|\n(48u'\ 2lfr\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 3141\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lfr\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3143\ 2\h'|\n(44u'\ 2lil\ 3\ 2\h'|\n(45u'\ 2swN\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3144\ 2\h'|\n(48u'\ 2lil\ 3\ 2\h'|\n(49u'\ 2swP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3145\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lil\ 3\ 2\h'|\n(41u'\ 2mwP\ 3\ 2\h'|\n(42u'\ 2\ 32\ 2\h'|\n(43u'\ 2\ 3146\ 2\h'|\n(44u'\ 2lin\ 3\ 2\h'|\n(45u'\ 22\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3148\ 2\h'|\n(48u'\ 2lin\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3149\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lni\ 3\ 2\h'|\n(41u'\ 2-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3150\ 2\h'|\n(44u'\ 2loc\ 3\ 2\h'|\n(45u'\ 22\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3151\ 2\h'|\n(48u'\ 2loc\ 3\ 2\h'|\n(49u'\ 2mP\ 3\ 2\h'|\n(50u'\ 2\ 334\ 2\h'|\n(51u'\ 2\ 30\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2loc\ 3\ 2\h'|\n(41u'\ 2mN\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3152\ 2\h'|\n(44u'\ 2loc\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3153\ 2\h'|\n(48u'\ 2loc\ 3\ 2\h'|\n(49u'\ 2sN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3154\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2loe\ 3\ 2\h'|\n(41u'\ 2w2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3155\ 2\h'|\n(44u'\ 2loe\ 3\ 2\h'|\n(45u'\ 2sw\ 3\ 2\h'|\n(46u'\ 2\ 35\ 2\h'|\n(47u'\ 2\ 3156\ 2\h'|\n(48u'\ 2lof\ 3\ 2\h'|\n(49u'\ 22\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3161\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lof\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 34\ 2\h'|\n(43u'\ 2\ 3162\ 2\h'|\n(44u'\ 2lof\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3166\ 2\h'|\n(48u'\ 2loi\ 3\ 2\h'|\n(49u'\ 22\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3167\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2loi\ 3\ 2\h'|\n(41u'\ 2mPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3168\ 2\h'|\n(44u'\ 2loi\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 34\ 2\h'|\n(47u'\ 2\ 3169\ 2\h'|\n(48u'\ 2loi\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3173\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lol\ 3\ 2\h'|\n(41u'\ 2wP2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3174\ 2\h'|\n(44u'\ 2lol\ 3\ 2\h'|\n(45u'\ 2wN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3175\ 2\h'|\n(48u'\ 2lol\ 3\ 2\h'|\n(49u'\ 2mwP\ 3\ 2\h'|\n(50u'\ 2\ 34\ 2\h'|\n(51u'\ 2\ 3176\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lol\ 3\ 2\h'|\n(41u'\ 2mwN\ 3\ 2\h'|\n(42u'\ 2\ 38\ 2\h'|\n(43u'\ 2\ 3180\ 2\h'|\n(44u'\ 2lol\ 3\ 2\h'|\n(45u'\ 2swP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3188\ 2\h'|\n(48u'\ 2lol\ 3\ 2\h'|\n(49u'\ 2swN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3189\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lxa\ 3\ 2\h'|\n(41u'\ 2mPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3190\ 2\h'|\n(44u'\ 2lxl\ 3\ 2\h'|\n(45u'\ 2mPo\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 3191\ 2\h'|\n(48u'\ 2mlf\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3193\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2mli\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 32\ 2\h'|\n(43u'\ 2\ 3194\ 2\h'|\n(44u'\ 2rck\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3196\ 2\h'|\n(48u'\ 2ret\ 3\ 2\h'|\n(49u'\ 2mwP\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 3197\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ret\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3199\ 2\h'|\n(44u'\ 2rmi\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3200\ 2\h'|\n(48u'\ 2sar\ 3\ 2\h'|\n(49u'\ 2mwPo\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3201\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sbf\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3202\ 2\h'|\n(44u'\ 2sbi\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 3203\ 2\h'|\n(48u'\ 2sdl\ 3\ 2\h'|\n(49u'\ 2swN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3205\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2set\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3206\ 2\h'|\n(44u'\ 2sil\ 3\ 2\h'|\n(45u'\ 2swN\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3207\ 2\h'|\n(48u'\ 2sil\ 3\ 2\h'|\n(49u'\ 2swP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3208\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sli\ 3\ 2\h'|\n(41u'\ 2mwPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3209\ 2\h'|\n(44u'\ 2ste\ 3\ 2\h'|\n(45u'\ 2w2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3210\ 2\h'|\n(48u'\ 2ste\ 3\ 2\h'|\n(49u'\ 2sw\ 3\ 2\h'|\n(50u'\ 2\ 33\ 2\h'|\n(51u'\ 2\ 3211\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2stf\ 3\ 2\h'|\n(41u'\ 22\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3214\ 2\h'|\n(44u'\ 2stf\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 3215\ 2\h'|\n(48u'\ 2stf\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3217\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sti\ 3\ 2\h'|\n(41u'\ 2mPo\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3218\ 2\h'|\n(44u'\ 2sti\ 3\ 2\h'|\n(45u'\ 2mwPo\ 3\ 2\h'|\n(46u'\ 2\ 34\ 2\h'|\n(47u'\ 2\ 3219\ 2\h'|\n(48u'\ 2sti\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3223\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2stl\ 3\ 2\h'|\n(41u'\ 2wP2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3224\ 2\h'|\n(44u'\ 2stl\ 3\ 2\h'|\n(45u'\ 2wN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3225\ 2\h'|\n(48u'\ 2stl\ 3\ 2\h'|\n(49u'\ 2mwP\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 3226\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2stl\ 3\ 2\h'|\n(41u'\ 2mwN\ 3\ 2\h'|\n(42u'\ 2\ 35\ 2\h'|\n(43u'\ 2\ 3228\ 2\h'|\n(44u'\ 2stl\ 3\ 2\h'|\n(45u'\ 2swN\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3233\ 2\h'|\n(48u'\ 2teq\ 3\ 2\h'|\n(49u'\ 2-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3234\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2tgt\ 3\ 2\h'|\n(41u'\ 2-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3235\ 2\h'|\n(44u'\ 2tlt\ 3\ 2\h'|\n(45u'\ 2-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3236\ 2\h'|\n(48u'\ 2tne\ 3\ 2\h'|\n(49u'\ 2-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3237\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zeq\ 3\ 2\h'|\n(41u'\ 22\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3238\ 2\h'|\n(44u'\ 2zeq\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 32\ 2\h'|\n(47u'\ 2\ 3239\ 2\h'|\n(48u'\ 2zer\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3241\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zge\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3242\ 2\h'|\n(44u'\ 2zgt\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3243\ 2\h'|\n(48u'\ 2zle\ 3\ 2\h'|\n(49u'\ 2sP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3244\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zlt\ 3\ 2\h'|\n(41u'\ 2sP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3245\ 2\h'|\n(44u'\ 2zne\ 3\ 2\h'|\n(45u'\ 2sP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3246\ 2\h'|\n(48u'\ 2zne\ 3\ 2\h'|\n(49u'\ 2sN\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3247\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zre\ 3\ 2\h'|\n(41u'\ 2w2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3248\ 2\h'|\n(44u'\ 2zre\ 3\ 2\h'|\n(45u'\ 2sw\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3249\ 2\h'|\n(48u'\ 2zrl\ 3\ 2\h'|\n(49u'\ 2mwN\ 3\ 2\h'|\n(50u'\ 2\ 32\ 2\h'|\n(51u'\ 2\ 3250\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zrl\ 3\ 2\h'|\n(41u'\ 2swN\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 3252\ 2\h'|\n(44u'\ 2zrl\ 3\ 2\h'|\n(45u'\ 2wN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3253\ 2\h'|\n(48u'\ 2aar\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 30\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2aar\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 31\ 2\h'|\n(44u'\ 2adf\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 32\ 2\h'|\n(48u'\ 2adf\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 33\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2adi\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 34\ 2\h'|\n(44u'\ 2adi\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 35\ 2\h'|\n(48u'\ 2ads\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 36\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ads\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 37\ 2\h'|\n(44u'\ 2adu\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 38\ 2\h'|\n(48u'\ 2adu\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 39\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2and\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 310\ 2\h'|\n(44u'\ 2and\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 311\ 2\h'|\n(48u'\ 2asp\ 3\ 2\h'|\n(49u'\ 2ew2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 312\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ass\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 313\ 2\h'|\n(44u'\ 2ass\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 314\ 2\h'|\n(48u'\ 2bge\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 315\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2bgt\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 316\ 2\h'|\n(44u'\ 2ble\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 317\ 2\h'|\n(48u'\ 2blm\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 318\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2bls\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 319\ 2\h'|\n(44u'\ 2bls\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 320\ 2\h'|\n(48u'\ 2blt\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 321\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2bne\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 322\ 2\h'|\n(44u'\ 2cai\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 323\ 2\h'|\n(48u'\ 2cal\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 324\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cfi\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 325\ 2\h'|\n(44u'\ 2cfu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 326\ 2\h'|\n(48u'\ 2ciu\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 327\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cmf\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 328\ 2\h'|\n(44u'\ 2cmf\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 329\ 2\h'|\n(48u'\ 2cmi\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 330\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cmi\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 331\ 2\h'|\n(44u'\ 2cms\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 332\ 2\h'|\n(48u'\ 2cms\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 333\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cmu\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 334\ 2\h'|\n(44u'\ 2cmu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 335\ 2\h'|\n(48u'\ 2com\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 336\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2com\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 337\ 2\h'|\n(44u'\ 2csa\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 338\ 2\h'|\n(48u'\ 2csa\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 339\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2csb\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 340\ 2\h'|\n(44u'\ 2csb\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 341\ 2\h'|\n(48u'\ 2cuf\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 342\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2cui\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 343\ 2\h'|\n(44u'\ 2cuu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 344\ 2\h'|\n(48u'\ 2dee\ 3\ 2\h'|\n(49u'\ 2ew2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 345\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2del\ 3\ 2\h'|\n(41u'\ 2ewP2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 346\ 2\h'|\n(44u'\ 2del\ 3\ 2\h'|\n(45u'\ 2ewN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 347\ 2\h'|\n(48u'\ 2dup\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 348\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dus\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 349\ 2\h'|\n(44u'\ 2dus\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 350\ 2\h'|\n(48u'\ 2dvf\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 351\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dvf\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 352\ 2\h'|\n(44u'\ 2dvi\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 353\ 2\h'|\n(48u'\ 2dvi\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 354\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dvu\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 355\ 2\h'|\n(44u'\ 2dvu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 356\ 2\h'|\n(48u'\ 2fef\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 357\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2fef\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 358\ 2\h'|\n(44u'\ 2fif\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 359\ 2\h'|\n(48u'\ 2fif\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 360\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2inl\ 3\ 2\h'|\n(41u'\ 2ewP2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 361\ 2\h'|\n(44u'\ 2inl\ 3\ 2\h'|\n(45u'\ 2ewN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 362\ 2\h'|\n(48u'\ 2inn\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 363\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2inn\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 364\ 2\h'|\n(44u'\ 2ior\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 365\ 2\h'|\n(48u'\ 2ior\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 366\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lar\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 367\ 2\h'|\n(44u'\ 2lar\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 368\ 2\h'|\n(48u'\ 2ldc\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 369\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ldf\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 370\ 2\h'|\n(44u'\ 2ldl\ 3\ 2\h'|\n(45u'\ 2ewP2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 371\ 2\h'|\n(48u'\ 2ldl\ 3\ 2\h'|\n(49u'\ 2ewN2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 372\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lfr\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 373\ 2\h'|\n(44u'\ 2lil\ 3\ 2\h'|\n(45u'\ 2ewP2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 374\ 2\h'|\n(48u'\ 2lil\ 3\ 2\h'|\n(49u'\ 2ewN2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 375\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lim\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 376\ 2\h'|\n(44u'\ 2los\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 377\ 2\h'|\n(48u'\ 2los\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 378\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lor\ 3\ 2\h'|\n(41u'\ 2esP\ 3\ 2\h'|\n(42u'\ 2\ 31\ 2\h'|\n(43u'\ 2\ 379\ 2\h'|\n(44u'\ 2lpi\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 380\ 2\h'|\n(48u'\ 2lxa\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 381\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2lxl\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 382\ 2\h'|\n(44u'\ 2mlf\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 383\ 2\h'|\n(48u'\ 2mlf\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 384\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2mli\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 385\ 2\h'|\n(44u'\ 2mli\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 386\ 2\h'|\n(48u'\ 2mlu\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 387\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2mlu\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 388\ 2\h'|\n(44u'\ 2mon\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 389\ 2\h'|\n(48u'\ 2ngf\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 390\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ngf\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 391\ 2\h'|\n(44u'\ 2ngi\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 392\ 2\h'|\n(48u'\ 2ngi\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 393\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2nop\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 394\ 2\h'|\n(44u'\ 2rck\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 395\ 2\h'|\n(48u'\ 2rck\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 396\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ret\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 397\ 2\h'|\n(44u'\ 2rmi\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 398\ 2\h'|\n(48u'\ 2rmi\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 399\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2rmu\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3100\ 2\h'|\n(44u'\ 2rmu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3101\ 2\h'|\n(48u'\ 2rol\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3102\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2rol\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3103\ 2\h'|\n(44u'\ 2ror\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3104\ 2\h'|\n(48u'\ 2ror\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3105\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2rtt\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3106\ 2\h'|\n(44u'\ 2sar\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3107\ 2\h'|\n(48u'\ 2sar\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3108\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sbf\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3109\ 2\h'|\n(44u'\ 2sbf\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3110\ 2\h'|\n(48u'\ 2sbi\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3111\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sbi\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3112\ 2\h'|\n(44u'\ 2sbs\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3113\ 2\h'|\n(48u'\ 2sbs\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3114\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sbu\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3115\ 2\h'|\n(44u'\ 2sbu\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3116\ 2\h'|\n(48u'\ 2sde\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3117\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sdf\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3118\ 2\h'|\n(44u'\ 2sdl\ 3\ 2\h'|\n(45u'\ 2ewP2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3119\ 2\h'|\n(48u'\ 2sdl\ 3\ 2\h'|\n(49u'\ 2ewN2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3120\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2set\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3121\ 2\h'|\n(44u'\ 2set\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3122\ 2\h'|\n(48u'\ 2sig\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3123\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sil\ 3\ 2\h'|\n(41u'\ 2ewP2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3124\ 2\h'|\n(44u'\ 2sil\ 3\ 2\h'|\n(45u'\ 2ewN2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3125\ 2\h'|\n(48u'\ 2sim\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3126\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sli\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3127\ 2\h'|\n(44u'\ 2sli\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3128\ 2\h'|\n(48u'\ 2slu\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3129\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2slu\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3130\ 2\h'|\n(44u'\ 2sri\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3131\ 2\h'|\n(48u'\ 2sri\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3132\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sru\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3133\ 2\h'|\n(44u'\ 2sru\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3134\ 2\h'|\n(48u'\ 2sti\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3135\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2sts\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3136\ 2\h'|\n(44u'\ 2sts\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3137\ 2\h'|\n(48u'\ 2str\ 3\ 2\h'|\n(49u'\ 2esP\ 3\ 2\h'|\n(50u'\ 2\ 31\ 2\h'|\n(51u'\ 2\ 3138\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2tge\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3139\ 2\h'|\n(44u'\ 2tle\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3140\ 2\h'|\n(48u'\ 2trp\ 3\ 2\h'|\n(49u'\ 2e-\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3141\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2xor\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3142\ 2\h'|\n(44u'\ 2xor\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3143\ 2\h'|\n(48u'\ 2zer\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3144\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zer\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3145\ 2\h'|\n(44u'\ 2zge\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3146\ 2\h'|\n(48u'\ 2zgt\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3147\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zle\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3148\ 2\h'|\n(44u'\ 2zlt\ 3\ 2\h'|\n(45u'\ 2e2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3149\ 2\h'|\n(48u'\ 2zne\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3150\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2zrf\ 3\ 2\h'|\n(41u'\ 2e2\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3151\ 2\h'|\n(44u'\ 2zrf\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3152\ 2\h'|\n(48u'\ 2zrl\ 3\ 2\h'|\n(49u'\ 2ewP2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3153\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2dch\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3154\ 2\h'|\n(44u'\ 2exg\ 3\ 2\h'|\n(45u'\ 2esP\ 3\ 2\h'|\n(46u'\ 2\ 31\ 2\h'|\n(47u'\ 2\ 3155\ 2\h'|\n(48u'\ 2exg\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3156\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2exg\ 3\ 2\h'|\n(41u'\ 2e-\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 3157\ 2\h'|\n(44u'\ 2lpb\ 3\ 2\h'|\n(45u'\ 2e-\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3158\ 2\h'|\n(48u'\ 2gto\ 3\ 2\h'|\n(49u'\ 2e2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3159\ 2
-.ta \n(80u \n(81u \n(82u \n(83u \n(84u \n(85u \n(86u \n(87u \n(88u \n(89u \n(90u \n(91u
-.nr 31 \n(.f
-.nr 35 1m
-\&\h'|\n(40u'\ 2ldc\ 3\ 2\h'|\n(41u'\ 24\ 3\ 2\h'|\n(42u'\ 2\ 3\ 2\h'|\n(43u'\ 2\ 30\ 2\h'|\n(44u'\ 2\ 3\ 2\h'|\n(45u'\ 2\ 3\ 2\h'|\n(46u'\ 2\ 3\ 2\h'|\n(47u'\ 2\ 3\ 2\h'|\n(48u'\ 2\ 3\ 2\h'|\n(49u'\ 2\ 3\ 2\h'|\n(50u'\ 2\ 3\ 2\h'|\n(51u'\ 2\ 3\ 2
-.fc
-.nr T. 1
-.T# 1
-.35
-.TE
-.if \n-(b.=0 .nr c. \n(.c-\n(d.-102
+++ /dev/null
-.BP
-.SN 10
-.S1 "EM MACHINE LANGUAGE"
-The EM machine language is designed to make program text compact
-and to make decoding easy.
-Compact program text has many advantages: programs execute faster,
-programs occupy less primary and secondary storage and loading
-programs into satellite processors is faster.
-The decoding of EM machine language is so simple,
-that it is feasible to use interpreters as long as EM hardware
-machines are not available.
-This chapter is irrelevant when back ends are used to
-produce executable target machine code.
-.S2 "Instruction encoding"
-A design goal of EM is to make the
-program text as compact as possible.
-Decoding must be easy, however.
-The encoding is fully byte oriented, without any small bit fields.
-There are 256 primary opcodes, two of which are an escape to
-two groups of 256 secondary opcodes each.
-.A
-EM instructions without arguments have a single opcode assigned,
-possibly escaped:
-.DS
-
- |--------------|
- | opcode |
- |--------------|
-
- or
-
- |--------------|--------------|
- | escape | opcode |
- |--------------|--------------|
-
-.DE
-The encoding for instructions with an argument is more complex.
-Several instructions have an address from the global data area
-as argument.
-Other instructions have different opcodes for positive
-and negative arguments.
-.N 1
-There is always an opcode that takes the next two bytes as argument,
-high byte first:
-.DS
-
- |--------------|--------------|--------------|
- | opcode | hibyte | lobyte |
- |--------------|--------------|--------------|
-
- or
-
- |--------------|--------------|--------------|--------------|
- | escape | opcode | hibyte | lobyte |
- |--------------|--------------|--------------|--------------|
-
-.DE
-.DS
-An extra escape is provided for instructions with four or eight byte arguments.
-
- |--------------|--------------|--------------| |--------------|
- | ESCAPE | opcode | hibyte |...| lobyte |
- |--------------|--------------|--------------| |--------------|
-
-.DE
-For most instructions some argument values predominate.
-The most frequent combinations of instruction and argument
-will be encoded in a single byte, called a mini:
-.DS
-
- |---------------|
- |opcode+argument| (mini)
- |---------------|
-
-.DE
-The number of minis is restricted, because only
-254 primary opcodes are available.
-Many instructions have the bulk of their arguments
-fall in the range 0 to 255.
-Instructions that address global data have their arguments
-distributed over a wider range,
-but small values of the high byte are common.
-For all these cases there is another encoding
-that combines the instruction and the high byte of the argument
-into a single opcode.
-These opcodes are called shorties.
-Shorties may be escaped.
-.DS
-
- |--------------|--------------|
- | opcode+high | lobyte | (shortie)
- |--------------|--------------|
-
- or
-
- |--------------|--------------|--------------|
- | escape | opcode+high | lobyte |
- |--------------|--------------|--------------|
-
-.DE
-Escaped shorties are useless if the normal encoding has a primary opcode.
-Note that for some instruction-argument combinations
-several different encodings are available.
-It is the task of the assembler to select the shortest of these.
-The savings by these mini and shortie
-opcodes are considerable, about 55%.
-.P
-Further improvements are possible:
-the arguments of
-many instructions are a multiple of the wordsize.
-Some do also not allow zero as an argument.
-If these arguments are divided by the wordsize and,
-when zero is not allowed, then decremented by 1, more of them can
-be encoded as shortie or mini.
-The arguments of some other instructions
-rarely or never assume the value 0, but start at 1.
-The value 1 is then encoded as 0,
-2 as 1 and so on.
-.P
-Assigning opcodes to instructions by the assembler is completely
-table driven.
-For details see appendix B.
-.S2 "Procedure descriptors"
-The procedure identifiers used in the interpreter are indices
-into a table of procedure descriptors.
-Each descriptor contains:
-.IS 6
-.PS - 4
-.PT 1.
-the number of bytes to be reserved for locals at each
-invocation.
-.N
-This is a pointer-szied integer.
-.PT 2.
-the start address of the procedure
-.PE
-.IE
-.S2 "Load format"
-The EM machine language load format defines the interface between
-the EM assembler/loader and the EM machine itself.
-A load file consists of a header, the program text to be executed,
-a description of the global data area and the procedure descriptor table,
-in this order.
-All integers in the load file are presented with the
-least significant byte first.
-.P
-The header has two parts: the first half (eight 16-bit integers)
-aids in selecting
-the correct EM machine or interpreter.
-Some EM machines, for instance, may have hardware floating point
-instructions.
-.N
-The header entries are as follows (bit 0 is rightmost):
-.IS 2
-.VS 1 0
-.PS 1 4 "" :
-.PT
-magic number (07255)
-.PT
-flag bits with the following meaning:
-.PS - 7 "" :
-.PT bit 0
-TEST; test for integer overflow etc.
-.PT bit 1
-PROFILE; for each source line: count the number of memory
-cycles executed.
-.PT bit 2
-FLOW; for each source line: set a bit in a bit map table if
-instructions on that line are executed.
-.PT bit 3
-COUNT; for each source line: increment a counter if that line
-is entered.
-.PT bit 4
-REALS; set if a program uses floating point instructions.
-.PT bit 5
-EXTRA; more tests during compiler debugging.
-.PE
-.PT
-number of unresolved references.
-.PT
-version number; used to detect obsolete EM load files.
-.PT
-wordsize ; the number of bytes in each machine word.
-.PT
-pointer size ; the number of bytes available for addressing.
-.PT
-unused
-.PT
-unused
-.PE
-.IE
-The second part of the header (eight entries, of pointer size bytes each)
-describes the load file itself:
-.IS 2
-.PS 1 4 "" :
-.PT
-NTEXT; the program text size in bytes.
-.PT
-NDATA; the number of load-file descriptors (see below).
-.PT
-NPROC; the number of entries in the procedure descriptor table.
-.PT
-ENTRY; procedure number of the procedure to start with.
-.PT
-NLINE; the maximum source line number.
-.PT
-SZDATA; the address of the lowest uninitialized data byte.
-.PT
-unused
-.PT
-unused
-.PE
-.IE
-.P
-The program text consists of NTEXT bytes.
-NTEXT is always a multiple of the wordsize.
-The first byte of the program text is the
-first byte of the instruction address
-space, i.e. it has address 0.
-Pointers into the program text are found in the procedure descriptor
-table where relocation is simple and in the global data area.
-The initialization of the global data area allows easy
-relocation of pointers into both address spaces.
-.P
-The global data area is described by the NDATA descriptors.
-Each descriptor describes a number of consecutive words (of~wordsize)
-and consists of a sequence of bytes.
-While reading the descriptors from the load file, one can
-initialize the global data area from low to high addresses.
-The size of the initialized data area is given by SZDATA,
-this number can be used to check the initialization.
-.N
-The header of each descriptor consists of a byte, describing the type,
-and a count.
-The number of bytes used for this (unsigned) count depends on the
-type of the descriptor and
-is either a pointer-sized integer
-or one byte.
-The meaning of the count depends on the descriptor type.
-At load time an interpreter can
-perform any conversion deemed necessary, such as
-reordering bytes in integers
-and pointers and adding base addresses to pointers.
-.BP
-.A
-In the following pictures we show a graphical notation of the
-initializers.
-The leftmost rectangle represents the leading byte.
-.N 1
-.DS
-.PS - 4 " "
-Fields marked with
-.N 1
-.PT n
-contain a pointer-sized integer used as a count
-.PT m
-contain a one-byte integer used as a count
-.PT b
-contain a one-byte integer
-.PT w
-contain a wordsized integer
-.PT p
-contain a data or instruction pointer
-.PT s
-contain a null terminated ASCII string
-.PE 1
-.DE 0
-.VS 1 1
-.DS
-
- -------------------
- | 0 | n | repeat last initialization n times
- -------------------
-.DE
-.DS
- ---------
- | 1 | m | m uninitialized words
- ---------
-.DE
-.DS
- ____________
- / bytes \e
- ----------------- -----
- | 2 | m | b | b |...| b | m initialized bytes
- ----------------- -----
-.DE
-.DS
- _________
- / word \e
- -----------------------
- | 3 | m | w |... m initialized wordsized integers
- -----------------------
-.DE
-.DS
- _________
- / pointer \e
- -----------------------
- | 4 | m | p |... m initialized data pointers
- -----------------------
-.DE
-.DS
- _________
- / pointer \e
- -----------------------
- | 5 | m | p |... m initialized instruction pointers
- -----------------------
-.DE
-.DS
- ____________
- / bytes \e
- -------------------------
- | 6 | m | b | b |...| b | initialized integer of size m
- -------------------------
-.DE
-.DS
- ____________
- / bytes \e
- -------------------------
- | 7 | m | b | b |...| b | initialized unsigned of size m
- -------------------------
-.DE
-.DS
- ____________
- / string \e
- -------------------------
- | 8 | m | s | initialized float of size m
- -------------------------
-.DE 3
-.PS - 8
-.PT type~0:
-If the last initialization initialized k bytes starting
-at address \fIa\fP, do the same initialization again n times,
-starting at \fIa\fP+k, \fIa\fP+2*k, .... \fIa\fP+n*k.
-This is the only descriptor whose starting byte
-is followed by an integer with the
-size of a
-pointer,
-in all other descriptors the first byte is followed by a one-byte count.
-This descriptor must be preceded by a descriptor of
-another type.
-.PT type~1:
-Reserve m words, not explicitly initialized (BSS and HOL).
-.PT type~2:
-The m bytes following the descriptor header are
-initializers for the next m bytes of the
-global data area.
-m is divisible by the wordsize.
-.PT type~3:
-The m words following the header are initializers for the next m words of the
-global data area.
-.PT type~4:
-The m data address space pointers following the header are
-initializers for the next
-m data pointers in the global data area.
-Interpreters that represent EM pointers by
-target machine addresses must relocate all data pointers.
-.PT type~5:
-The m instruction address space pointers following the header are
-initializers for the next
-m instruction pointers in the global data area.
-Interpreters that represent EM instruction pointers by
-target machine addresses must relocate these pointers.
-.PT type~6:
-The m bytes following the header form
-a signed integer number with a size of m bytes,
-which is an initializer for the next m bytes
-of the global data area.
-m is governed by the same restrictions as for
-transfer of objects to/from memory.
-.PT type~7:
-The m bytes following the header form
-an unsigned integer number with a size of m bytes,
-which is an initializer for the next m bytes
-of the global data area.
-m is governed by the same restrictions as for
-transfer of objects to/from memory.
-.PT type~8:
-The header is followed by an ASCII string, null terminated, to
-initialize, in global data,
-a floating point number with a size of m bytes.
-m is governed by the same restrictions as for
-transfer of objects to/from memory.
-The ASCII string contains the notation of a real as used in the
-Pascal language.
-.PE
-.P
-The NPROC procedure descriptors on the load file consist of
-an instruction space address (of~pointer~size) and
-an integer (of~pointer~size) specifying the number of bytes for
-locals.
+++ /dev/null
-.so /usr/lib/tmac/tmac.kun
-.SS 6
-.RP
-.PL 12i 11i
-.LL 89
-.MS T E
-\!.TL '%'''
-.ME
-.MS T O
-\!.TL '''%'
-.ME
-.MS B
-.sp 1
-.ME
-.SM S1 B
-.SM S2 B
+++ /dev/null
-.SN 5
-.BP
-.S1 "MAPPING OF EM DATA MEMORY ONTO TARGET MACHINE MEMORY"
-The EM architecture is designed to be implemented
-on many existing and future machines.
-EM memory is highly fragmented to make
-adaptation to various memory architectures possible.
-Format and encoding of pointers is explicitly undefined.
-.P
-This chapter gives solutions to some of the
-anticipated problems.
-First, we describe a possible memory layout for machines
-with 64K bytes of address space.
-Here we use a member of the EM family with 2-byte word and pointer
-size.
-The most straightforward layout is shown in figure 2.
-.N 1
-.DS
- 65534 -> |-------------------------------|
- |///////////////////////////////|
- |//// unimplemented memory /////|
- |///////////////////////////////|
- ML -> |-------------------------------|
- | |
- | | <- LB
- | stack and local area |
- | |
- |-------------------------------| <- SP
- |///////////////////////////////|
- |//////// inaccessible /////////|
- |///////////////////////////////|
- |-------------------------------| <- HP
- | |
- | heap area |
- | |
- | |
- HB -> |-------------------------------|
- | |
- | global data area |
- | |
- EB -> |-------------------------------|
- | |
- | program text | <- PC
- | |
- | ( and tables ) |
- | |
- | |
- PB -> |-------------------------------|
- |///////////////////////////////|
- |////////// undefined //////////|
- |///////////////////////////////|
- 0 -> |-------------------------------|
-
- Figure 2. Memory layout showing typical register
- positions during execution of an EM program.
-.DE 2
-The base registers for the various memory pieces can be stored
-in target machine registers or memory.
-.IS
-.N 1
-.TS
-tab(;);
-l 1 l l l.
-PB;:;program base;points to the base of the instruction address space.
-EB;:;external base;points to the base of the data address space.
-HB;:;heap base;points to the base of the heap area.
-ML;:;memory limit;marks the high end of the addressable data space.
-.TE 1
-.IE
-The stack grows from high
-EM addresses to low EM addresses, and the heap the
-other way.
-The memory between SP and HP is not accessible,
-but may be allocated later to the stack or the heap if needed.
-The local data area is allocated starting at the high end of
-memory.
-.P
-Because EM address 0 is not mapped onto target
-address 0, a problem arises when pointers are used.
-If a program pushed a constant, say 6, onto the stack,
-and then tried to indirect through it,
-the wrong word would be fetched,
-because EM address 6 is mapped onto target address EB+6
-and not target address 6 itself.
-This particular problem is solved by explicitly declaring
-the format of a pointer to be undefined,
-so that using a constant as a pointer is completely illegal.
-However, the general problem of mapping pointers still exists.
-.P
-There are two possible solutions.
-In the first solution, EM pointers are represented
-in the target machine as true EM addresses,
-for example, a pointer to EM address 6 really is
-stored as a 6 in the target machine.
-This solution implies that every time a pointer is fetched
-EB must be added before referencing
-the target machine's memory.
-If the target machine has powerful indexing
-facilities, EB can be kept in a target machine register,
-and the relocation can indeed be done on
-every reference to the data address space
-at a modest cost in speed.
-.P
-The other solution consists of having EM pointers
-refer to the true target machine address.
-Thus the instruction LAE 6 (Load Address of External 6)
-would push the value of EB+6 onto the stack.
-When this approach is chosen, back ends must know
-how to offset from EB, to translate all
-instructions that manipulate EM addresses.
-However, the problem is not completely solved,
-because a front end may have to initialize a pointer
-in CON or ROM data to point to a global address.
-This pointer must also be relocated by the back end or the interpreter.
-.P
-Although the EM stack grows from high to low EM addresses,
-some machines have hardware PUSH and POP
-instructions that require the stack to grow upwards.
-If reasons of efficiency urge you to use these
-instructions, then EM
-can be implemented with the memory layout
-upside down, as shown in figure 3.
-This is possible because the pointer format is explicitly undefined.
-The first element of a word array will have a
-lower physical address than the second element.
-.N 2
-.DS
- | | | |
- | EB=60 | | ^ |
- | | | | |
- |-----------------| |-----------------|
- 105 | 45 | 44 | 104 214 | 41 | 40 | 215
- |-----------------| |-----------------|
- 103 | 43 | 42 | 102 212 | 43 | 42 | 213
- |-----------------| |-----------------|
- 101 | 41 | 40 | 100 210 | 45 | 44 | 211
- |-----------------| |-----------------|
- | | | | |
- | v | | EB=255 |
- | | | |
-
- Type A Type B
-.sp 2
- Figure 3. Two possible memory implementations.
- Numbers within the boxes are EM addresses.
- The other numbers are physical addresses.
-.DE 2
-.A 0 0
-So, we have two different EM memory implementations:
-.IS
-.PS - 4
-.PT A~-
-stack downwards
-.PT B~-
-stack upwards
-.PE
-.IE
-.P
-For each of these two possibilities we give the translation of
-the EM instructions to push the third byte of a global data
-block starting at EM address 40 onto the stack and to load the
-word at address 40.
-All translations assume a word and pointer size of two bytes.
-The target machine used is a PDP-11 augmented with push and pop instructions.
-Registers 'r0' and 'r1' are used and suffer from sign extension for byte
-transfers.
-Push $40 means push the constant 40, not word 40.
-.P
-The translation of the EM instructions depends on the pointer representation
-used.
-For each of the two solutions explained above the translation is given.
-.P
-First, the translation for the two implementations using EM addresses as
-pointer representation:
-.DS
-.TS
-tab(:), center;
-l s l s l s
-_ s _ s _ s
-l 2 l 6 l 2 l 6 l 2 l.
-EM:type A:type B
-
-
-LAE:40:push:$40:push:$40
-
-ADP:3:pop:r0:pop:r0
-::add:$3,r0:add:$3,r0
-::push:r0:push:r0
-
-LOI:1:pop:r0:pop:r0
-::-::neg:r0
-::clr:r1:clr:r1
-::bisb:eb(r0),r1:bisb:eb(r0),r1
-::push:r1:push:r1
-
-LOE:40:push:eb+40:push:eb-41
-.TE
-.DE
-.BP
-.P
-The translation for the two implementations, if the target machine address is
-used as pointer representation, is:
-.N 1
-.DS
-.TS
-tab(:), center;
-l s l s l s
-_ s _ s _ s
-l 2 l 6 l 2 l 6 l 2 l.
-EM:type A:type B
-
-
-LAE:40:push:$eb+40:push:$eb-40
-
-ADP:3:pop:r0:pop:r0
-::add:$3,r0:sub:$3,r0
-::push:r0:push:r0
-
-LOI:1:pop:r0:pop:r0
-::clr:r1:clr:r1
-::bisb:(r0),r1:bisb:(r0),r1
-::push:r1:push:r1
-
-LOE:40:push:eb+40:push:eb-41
-.TE
-.DE
-.P
-The translation presented above is not intended to be optimal.
-Most machines can handle these simple cases in one or two instructions.
-It demonstrates, however, the flexibility of the EM design.
-.P
-There are several possibilities to implement EM on machines with
-address spaces larger than 64k bytes.
-For EM with two byte pointers one could allocate instruction and
-data space each in a separate 64k piece of memory.
-EM pointers still have to fit in two bytes,
-but the base registers PB and EB may be loaded in hardware registers
-wider than 16 bits, if available.
-EM implementations can also make efficient use of a machine
-with separate instruction and data space.
-.P
-EM with 32 bit pointers allows one to make use of machines
-with large address spaces.
-In a virtual, segmented memory system one could use a separate
-segment for each fragment.
+++ /dev/null
-.BP
-.SN 2
-.S1 MEMORY
-The EM machine has two distinct address spaces,
-one for instructions and one for data.
-The data space is divided up into 8-bit bytes.
-The smallest addressable unit is a byte.
-Bytes are numbered consecutively from 0 to some maximum.
-All sizes in EM are expressed in bytes.
-.P
-Some EM instructions can transfer objects containing several bytes
-to and/or from memory.
-The size of all objects larger than a word must be a multiple of
-the wordsize.
-The size of all objects smaller than a word must be a divisor
-of the wordsize.
-For example: if the wordsize is 2 bytes, objects of the sizes 1,
-2, 4, 6,... are allowed.
-The address of such an object is the lowest address of all bytes it contains.
-For objects smaller than the wordsize, the
-address must be a multiple of the object size.
-For all other objects the address must be a multiple of the
-wordsize.
-For example, if an instruction transfers a 4-byte object to memory at
-location \fIm\fP and the wordsize is 2,
-\fIm\fP must be a multiple of 2 and the bytes at
-locations \fIm\fP, \fIm\fP\|+\|1,\fIm\fP\|+\|2 and
-\fIm\fP\|+\|3 are overwritten.
-.P
-The size of almost all objects in EM
-is an integral number of words.
-Only two operations are allowed on
-objects whose size is a divisor of the wordsize:
-push it onto the stack and pop it from the stack.
-The addressing of these objects in memory is always indirect.
-If such a small object is pushed onto the stack
-it is assumed to be a small integer and stored
-in the least significant part of a word.
-The rest of the word is cleared to zero,
-although
-EM provides a way to sign-extend a small integer.
-Popping a small object from the stack removes a word
-from the stack, stores the least significant byte(s)
-of this word in memory and discards the rest of the word.
-.P
-The format of pointers into both address spaces is explicitly undefined.
-The size of a pointer, however, is fixed for a member of EM, so that
-the compiler writer knows how much storage to allocate for a pointer.
-.P
-A minor problem is raised by the undefined pointer format.
-Some languages, notably Pascal, require a special,
-otherwise illegal, pointer value to represent the nil pointer.
-The current Pascal-VU compiler uses the
-integer value 0 as nil pointer.
-This value is also used by many C programs as a normally impossible address.
-A better solution would be to have a special
-instruction loading an illegal pointer value,
-but it is hard to imagine an implementation
-for which the current solution is inadequate,
-especially because the first word in the EM data space
-is special and probably not the target of any pointer.
-.P
-The next two chapters describe the EM memory
-in more detail.
-One describes the instruction address space,
-the other the data address space.
-.P
-A design goal of EM has been to allow
-its implementation on a wide range of existing machines,
-as well as allowing a new one to be built in hardware.
-To this extent we have tried to minimize the demands
-of EM on the memory structure of the target machine.
-Therefore, apart from the logical partitioning,
-EM memory is divided into 'fragments'.
-A fragment consists of consecutive machine
-words and has a base address and a size.
-Pointer arithmetic is only defined within a fragment.
-The only exception to this rule is comparison with the null
-pointer.
-All fragments must be word aligned.
+++ /dev/null
-
-case $# in
-1) make "$1".t ; ntlp "$1".t^lpr ;;
-*) echo $0 heeft een argument nodig ;;
-esac
+++ /dev/null
-case $# in
-1) make $1.t ; ntout $1.t ;;
-*) echo $0 heeft een argument nodig ;;
-esac
+++ /dev/null
-.po 0
-.TP 1
-.ll 79
-.sp 15
-.ce 4
-DESCRIPTION OF A MACHINE
-ARCHITECTURE FOR USE WITH
-BLOCK STRUCTURED LANGUAGES
-.sp 6
-.ce 4
-Andrew S. Tanenbaum
-Hans van Staveren
-Ed G. Keizer
-Johan W. Stevenson\v'-0.5m'*\v'0.5m'
-.sp 2
-.ce
-August 1983
-.sp 2
-.ce
-Informatica Rapport IR-81
-.sp 13
-Abstract
-.sp 2
-.ti +5
-EM is a family of intermediate languages
-designed for producing portable compilers.
-A program called
-.B front end
-translates source programs to EM.
-Another program,
-.B back
-.BW end ,
-translates EM to the assembly language of the target machine.
-Alternatively, the EM program can be assembled to a highly
-efficient binary format for interpretation.
-This document describes the EM languages in detail.
-.sp 4
-\v'-0.5m'*\v'0.5m' Present affiliation: NV Philips, Eindhoven
+++ /dev/null
-.SN 6
-.BP
-.S1 "TYPE REPRESENTATIONS"
-The representations used for typed objects are not precisely
-specified by EM.
-Sometimes we only specify that a typed object occupies a
-certain amount of space and state no further restrictions.
-If one wants to have a different representation of the value of
-an object on the stack one has to use a convert instruction
-in most cases.
-We do specify some relations between the representations of
-types.
-This allows some intermixed use of operators for different types
-on the same object(s).
-For example, the instruction ZER pushes signed and
-unsigned integers with the value zero and empty sets.
-ZER has as only argument the size of the object.
-.A
-The representation of floating point numbers is a good example,
-it allows widely varying implementations.
-The only ways to create floating point numbers are via
-initialization and via conversions from integer numbers.
-Only by using conversions to integers and comparing
-two floating point numbers with each other, can these numbers
-be converted to human readable output.
-Implementations may use base 10, base 2 or any other
-base for exponents, and have freedom in choosing the range of
-exponent and mantissa.
-.A
-Other types are more precisely described.
-In the following paragraphs a description will be given of the
-restrictions imposed on the representation of the types used.
-A number \fBn\fP used in these paragraphs indicates the size of
-the object in \fIbits\fP.
-.S2 "Unsigned integers"
-The range of unsigned integers is 0..2\v'-0.5m'\fBn\fP\v'0.5m'-1.
-A binary representation is assumed.
-The order of the bits within an object is knowingly left
-unspecified.
-Discussing bit order within each 8-bit byte is academic,
-so the only real freedom of this specification lies in the byte
-order.
-We really do not care whether an implementation of a 4-byte
-integer has its bytes in a particular order of significance.
-This of course means that some sequences of instructions have
-unpredictable effects.
-For example:
-.DS
- LOC 258 ; STL 0 ; LAL 0 ; LOI 1 ( wordsize >=2 )
-.DE
-The value on the stack after executing this sequence
-can be anything,
-but will most likely be 1 or 2.
-.A
-Conversion between unsigned integers of different sizes have to
-be done with explicit convert instructions.
-One cannot simply pad an unsigned integer with zero's at either end
-and expect a correct result.
-.A
-We assume existence of at least single word unsigned arithmetic
-in any implementation.
-.S2 "Signed Integers"
-The range of signed integers is -2\v'-0.5m'\fBn\fP-1\v'0.5m'~..~2\v'-0.5m'\fBn\fP-1\v'0.5m'-1,
-in other words the range of signed integers of \fBn\fP bits
-using two's complement arithmetic.
-The representation is the same as for unsigned integers except
-the range 2\v'-0.5m'\fBn\fP-1\v'0.5m'~..~2\v'-0.5m'\fBn\fP\v'0.5m'-1 is mapped on the
-range -2\v'-0.5m'\fBn\fP-1\v'0.5m'~..~-1.
-In other words, the most significant bit is used as sign bit.
-The convert instructions between signed and unsigned integers
-of the same size can be used to catch errors.
-.A
-The value -2\v'-0.5m'\fBn\fP-1\v'0.5m' is used for undefined
-signed integers.
-EM implementations should trap when this value is used in an
-operation on signed integers.
-The instruction mask, accessed with SIM and LIM -~see chapter 9~- ,
-can be used to disable such traps.
-.A
-We assume existence of at least single word signed arithmetic
-in any implementation.
-.BP
-.S2 "Floating point values"
-Floating point values must have a signed mantissa and a signed
-exponent.
-Although no base is specified, base 2 is the normal choice,
-because the FEF instruction pushes the exponent in base 2.
-.A
-The implementation of floating point arithmetic is optional.
-The compilers currently in use have runtime parameters for the
-size of the floating point values they should use.
-Common choices are 4 and/or 8 bytes.
-.S2 Pointers
-EM has two kinds of pointers: for instruction and for data
-space.
-Each kind can only be used for its own space, conversion between
-these two subtypes is impossible.
-We assume that pointers have a range from 0 upwards.
-Any implementation may have holes in the pointer range between
-fragments.
-One can of course not expect to be able to address two megabyte
-of memory using a 2-byte pointer.
-Normally, a 2-byte pointer allows up to 65536 bytes of
-addressable memory.
-.A
-Pointer representation has one restriction.
-The pointer with the same representation as the integer zero of
-the same size should be invalid.
-Some languages and/or runtime systems represent the nil
-pointer as zero.
-.S2 "Bit sets"
-All bit sets of size \fBn\fP are subsets of the set
-{~i~|~i>=0,~i<\fBn\fP~}.
-A bit set contains a bit for each element showing its
-presence or absence.
-Bit sets are subdivided into words.
-The word with the lowest EM address governs the subset
-{~i~|~i>=0,~i<\fBm\fP~}, where \fBm\fP is the number of bits in
-a word.
-The next higher words each govern the next higher \fBm\fP set elements.
-The relation between a set with size of
-a word and an unsigned integer word is that
-the value of the unsigned integer is the summation of the
-2\v'-0.5m'i\v'0.5m' where i is in the set.
-.A
-Example: a 2-word bit set (wordsize 2) containing the
-elements 1, 6, 8, 15, 18, 21, 27 and 28 is composed of two
-integers, e.g. at addresses 40 and 42.
-The word at 40 contains the value 33090 (or~-32446),
-the word at 42 contains the value 6180.
+++ /dev/null
-.nr LL 7.5i
-.nr PD 1v
-.TL
-Amsterdam Compiler Kit installation guide
-.AU
-Ed Keizer
-.AI
-Wiskundig Seminarium
-Vrije Universiteit
-Amsterdam
-.NH
-Introduction
-.PP
-This document
-describes the process of installing Amsterdam Compiler Kit.
-It depends on your combination of hard- and software how
-hard it will be to install the kit.
-This description is intended for a PDP 11/44 running
-.UX
-Version 7.
-Installation on other PDP 11's should be easy, as long
-as they have separate instruction and data space.
-Installation on machine's without this feature, like PDP 11/34,
-PDP 11/60 requires extensive surgery on some programs and is
-thought of as impossible.
-See chapter 6 for installation on other systems.
-.NH
-Restoring tree
-.PP
-The process of installing Amsterdam Compiler Kit is quite simple.
-It is important that the original Amsterdam Compiler Kit
-distribution tree structure is restored.
-Proceed as follows
-.IP " -" 10
-Create a directory, for example /usr/em, on a device
-with at least 20000 blocks left.
-.IP " -"
-Change to that directory (cd ...); it will be the working directory.
-.IP " -"
-Extract all files from the distribution medium, for instance
-magtape:
-\fBtar x\fP.
-.IP " -"
-Keep a copy of the original distribution to be able to repeat the process
-of installation in case of disasters.
-This copy is also useful as a reference point for diff-listings.
-.LP
-The directories in the tree contain the following information:
-.nr PD 1v
-.IP "lib" 14
-.br
-almost all binaries and shell files used by commands and
-library em_data.a from misc/data
-.IP "lib/ack"
-.br
-The command descriptor files used by the program ack.
-.nr PD 0
-.IP "bin"
-.br
-the few utilities that knot things together
-.IP "etc"
-.br
-The MAIN description of EM sits here.
-contains files (e.g. em_table) describing
-the opcodes and pseudos in use,
-the operands allowed, effect in stack etc. etc.
-Make in this directory creates most of the files in h
-.IP "include"
-.br
-More or less system independent include files needed by modules
-in the C library from lang/cem/libcc.
-Especially needed for "stdio".
-.IP "h"
-.br
-The #include files for:
-.nf
-as_spec.h Used by EM assembler and interpreters.
-em_abs.h Contains trap numbers and address for lin and fil
-em_flag.h Definition of bits in array em_flag in lib/em_data.a
- Describes parameters effect on flow of instructions
-em_mes.h Definition of names for mes pseudo numbers
-em_mnem.h instruction => compact mapping.
-em_pseu.h pseudo instruction => compact mapping
-em_ptyp.h Useful for compact code reading/writing,
- defines classes of parameters
-em_spec.h Definition of constants used in compact code
-local.h Various definitions for local versions
-pc_err.h Definitions of error numbers in Pascal
-pc_file.h Macro's used in file handling in Pascal
-em_path.h Pathnames used by \fIack\fP, intended
- for all utilities
-pc_size.h Sizes of objects used by Pascal compiler and
- run-time system.
-em_reg.h Definition of names for register types.
-.IP "doc"
-.br
-Documentation
-.nf
-cg.doc Use and internal specification of the backend.
-.br
-regadd.doc Update for cg.doc concerning register variables
-.br
-regadd.doc Description of steps to add register variables.
-.br
-ack.doc Layout of description files needed for each machine.
-.br
-cref.doc C reference manual, addendum
-.br
-install.doc Ack Installation Guide
-.br
-pcref.doc Pascal reference manual, addendum
-.br
-peep.doc Description of the peephole optimizer
-.br
-em.doc EM reference manual
-.br
-toolkit.doc A general overview of the toolkit
-.br
-v7bugs.doc Bugs in the standard V7 system
-.br
-val.doc Pascal validation suite version 3 report
-.nf
-.IP "doc/em.doc"
-.br
-The EM-manual IR-81
-.IP "doc/em.doc/int"
-.br
-The EM interpreter written in pascal
-.IP "mkun"
-.br
-The PUBMAC macro package for nroff/troff from the Katholieke Universiteit at
-Nijmegen.
-It is used for the EM reference manual,
-the Makefile installs the macro package in
-/usr/lib/tmac/tmac.mkun*.
-This package is in the public domain.
-.IP "mach"
-.br
-just there to group the directories for all machines
-these directories have sub-directories named:
-.nf
- as the assembler ( *.s + libraries => a.out )
- cg the new backend ( *.m => *.s )
- lib the libraries for all run-time systems
- these libraries are used by the assembler.
- libpc Used to create Pascal run-time system in 'lib'
- libcc Used to create C run-time system in 'lib'
- libem Sources for EM runtime system, result sits in 'lib'
- test Various tests
- dl Down-load programs
- int Source for an interpreter
-available are:
- PMDS II 68000, wordsize 2, ptrsize 4
- mach/m68k2
- mach/m68k2/as
- mach/m68k2/cg
- mach/m68k2/libem
- mach/m68k2/lib
- mach/m68k2/dl
- mach/m68k2/libpc
- mach/m68k2/libcc
- mach/m68k2/libsys
- bare 6809
- mach/6809
- mach/6809/as
- 8080, wordsize 2, ptrsize 2
- mach/8080
- mach/8080/as
- mach/8080/test
- mach/8080/libcc
- mach/8080/lib
- bare 8086, wordsize 2, ptrsize 2
- mach/i86
- mach/i86/as
- mach/i86/lib
- mach/i86/libcc
- mach/i86/dl
- mach/i86/libem
- mach/i86/libpc
- mach/i86/saio (library for stand-alone EM on 86/12A )
- pdp 11, UNIX/V7, wordsize 2, ptrsize 2
- mach/pdp
- mach/pdp/test
- mach/pdp/libem
- mach/pdp/lib
- mach/pdp/libcc
- mach/pdp/libpc
- mach/pdp/cg
- mach/pdp/int -PDP 11/44 EM interpreter
- vax 780, UNIX V7, wordsize 4, ptrsize 4
- mach/vax4
- mach/vax4/cg
- mach/vax4/lib
- mach/vax4/libcc
- mach/vax4/libem
- mach/vax4/libpc
- z80, CP/M, wordsize 2, ptrsize 2
- mach/z80
- mach/z80/as
- mach/z80/libem
- mach/z80/lib
- mach/z80/libcc
- mach/z80/libpc
- mach/z80/int -Z80 EM interpreter
- z80, nascom
- mach/z80a
- mach/z80a/dl
- vax 11/780, Berkeley UNIX, wordsize 2, ptrsize 4
- mach/vax2
- mach/vax2/cg
- mach/vax2/lib
- mach/vax2/libpc
- mach/vax2/libem
- bare 6500, wordsize 2, ptrsize 2
- mach/6500
- mach/6500/as
- mach/6500/dl
- mach/6500/libem
- mach/6500/lib
- bare 6800, wordsize 2, ptrsize 2
- mach/6800
- mach/6800/as
- EM virtual machine code, wordsize 2, ptrsize 2
- mach/int
- mach/int/libcc
- mach/int/libpc
- mach/int/lib
- mach/int/test
- The directory proto contains files used by most machines.
- e.g. makefiles for libraries for C and Pascal
- mach/proto
- mach/proto/libg
-.fi
-.IP "emtest"
-.br
-Contains prototype of em test set.
-.IP "man"
-.br
-Man files for various utilities
-.IP "lang"
-.br
-just there to group the directories for all front-ends
-.IP "lang/pc"
-.br
-Pascal front-end
-.IP "lang/pc/libpc"
-.br
-Source of Pascal run-time system ( in EM or C )
-.IP "lang/pc/test"
-.br
-Some test programs written in Pascal
-.IP "lang/pc/pem"
-.br
-The compiler proper
-.IP "lang/cem"
-.br
-C front-end
-.IP "lang/cem/libcc"
-.br
-Directories with sources of C runtime system, libraries (in EM or C)
-.IP "lang/cem/libcc/gen"
-.br
-Sources for routines in chapter III of UNIX programmers manual,
-excluding STDIO
-.IP "lang/cem/libcc/stdio"
-.br
-STDIO sources
-.IP "lang/cem/libcc/mon"
-.br
-Sources for routines in chapter II, written in EM
-.IP "lang/cem/comp"
-.br
-The compiler proper
-.IP "lang/cem/ctest"
-.br
-C test set
-.IP "lang/cem/ctest/cterr"
-.br
-Programs developed for pinpointing previous errors
-.IP "lang/cem/ctest/ct*"
-.br
-The test programs.
-.IP "util"
-.br
-Contains directories with various utilities
-.IP "util/opt"
-.br
-EM peephole optimizer (*.k => *.m)
-.IP "util/misc"
-.br
-Decode (*.[km] => *.e) + encode (*.e => *.k)
-.IP "util/data"
-.br
-The C-code for `lib/em_data.a`
-These sources are created by the Makefile in `etc`
-.IP "util/ass"
-.br
-The EM assembler ( *.[km] + libraries => e.out )
-.IP "util/arch"
-.br
-The archiver to be used for ALL EM utilities
-.IP "util/cgg"
-.br
-A program needed for compiling backends.
-.IP "util/cpp"
-.br
-The V7 C preprocessor.
-.LP
-All pathnames mentioned in the text of this document are relative to the
-working directory, unless they start with '/'.
-.PP
-The person doing the installation needs permission to write in the
-directories of the Amsterdam Compiler Kit distribution tree.
-Preferably you should log in as sys (uid=3,gid=0).
-.NH
-Pathnames
-.PP
-Absolute pathnames are concentrated in "h/em_path.h".
-Only the pascal runtime system and the utility \fIack\fP use
-absolute pathnames to access files in the kit.
-The tree is distributed with /usr/em as the working
-directory.
-The definition of EM_HOME in em_path.h should be altered to
-specify the root
-directory for the Compiler Kit distribution on your system.
-The trailing " in the definition of EM_HOME is intentionally
-missing!
-Em_path.h also specifies which directory should be used for
-temporary files.
-Most programs from the kit do indeed use that directory
-although some remain stubborn and use /tmp or /usr/tmp.
-.LP
-The shape of the tree should not be altered lightly because
-most Makefiles and the
-utility \fIack\fP know the shape of the ACK tree.
-All pathnames in all Makefiles are relative, that is do not
-have "/" as the first character.
-The knowledge of the utility \fIack\fP about the shape of the tree is
-concentrated in the files in the directory lib/ack.
-.NH
-Commands
-.PP
-The kit is distributed with all available commands in the bin
-directory.
-The commands distributed are:
-.IP "\fIack\fP, \fIacc\fP, \fIapc\fP and their links"
-.br
-They are used to compile the Pascal, C, etc... programs.
-.IP \fIarch\fP
-.br
-The archiver used for the EM- and universal assembler.
-.IP "\fIem\fP and \fIeminform\fP"
-.br
-The EM interpretator for the PDP-11 and the program to unravel
-its post-mortem information.
-.LP
-We currently make the kit available to our users by telling
-them that they should include the bin directory of the kit in
-their PATH shell variable.
-The programs will still work when moved to a different
-directory.
-The copying should preferably be done with tar, since links are
-heavily used.
-Renaming of the programs linked to \fIack\fP will not always
-produce the desired result.
-This program uses its call name as an argument.
-Any call name not being \fIcc\fP, \fIacc\fP, \fIpc\fP or \fIapc\fP will be
-interpreted as the name of a 'machine description' and the
-program will try to find a description file with that name.
-All recompilations will only touch the utilities in the bin
-directory, not your own copies.
-.NH
-Options
-.PP
-There is one important option in h/local.h.
-The utility \fIack\fP uses a default machine name when called
-as \fIacc\fP, \fIcc\fP, \fIapc\fP, \fIpc\fP or \fIack\fP.
-The machine name used for default is determined by the
-definition of ACKM in h/local.h.
-The current definition is \fIpdp\fP.
-.PP
-The distribution is tailored to one specific opreating system per CPU type.
-For some of these CPU's it is possible to tailor the distribution to another
-operating system.
-The steps to be taken are described in READ_ME (or README) files in the
-subdirectories of the directory in EM_HOME/mach for that particular machine.
-For example: The vax2 distribution is tailoerd to BSD4.1, but has #define's
-for BSD4.1c and BSD4.2.
-For the names and places of these define's look in EM_HOME/mach/vax2/cg and
-EM_HOME/mach/vax2/libem.
-.NH
-Recompilation
-.PP
-The kit comes with binaries in the directories \fBbin\fP and
-\fBlib\fP.
-Some directories among mach/*/lib contain archives with object files,
-notably mach/pdp/lib.
-The binaries and object files are for a PDP 11/44 with floating
-point running UNIX V7.
-.PP
-Almost all directories contain a "Makefile" or a shell command file called
-"make".
-Apart from commands applying to that specific directory these
-files all recognize a few special commands.
-When called with one of these they will apply the command to
-their own directory and all subdirectories.
-The special commands are:
-.IP "install" 20
-recompile and install all binaries and libraries.
-.br
-Some Makefiles allow errors to occur in the programs they call.
-They ignore such errors and notify the user with the message
-"~....... error code n: ignored".
-Whenever such a message appears in the output you can ignore it
-too.
-.br
-The installation of the PUBMAC macro package is not done
-automatically from the higher level directory.
-.IP "cmp"
-recompile all binaries and libraries and compare them to the
-ones already installed.
-.IP pr
-print the sources and documentation on the standard output.
-.IP opr
-make pr | opr
-.br
-Opr should be an off-line printer daemon.
-On some systems it exists under another name e.g. lpr.
-The easiest way to call such a spooler is using a shell script
-with the name opr that calls lpr.
-This script should be placed in /usr/bin or EM_HOME/bin or
-one of the directories in your PATH.
-.IP clean
-remove all files not needed for day-to-day use,
-that is binaries not in bin or lib, object files etc.
-.LP
-Example:
-.nf
-.sp 1
- make install
-.sp 1
-.fi
-given as command in the home directory will cause
-recompilation of all programs in the kit.
-.LP
-Recompilation of the complete kit lasts about 9 hours an a PDP
-11/44.
-.NH 2
-Recompilation on a different machine.
-.PP
-Installation on other systems will often require recompilation
-of all programs.
-The presence of a C compiler is essential for recompilation.
-Except the Pascal compiler proper all programs are written in C.
-Some modules are derived from \fIyacc\fP sources.
-Retranslating these programs from that yacc source is not
-necessary, although it might improve performance.
-Some versions of \fIyacc\fP 'know' that the resulting C programs will
-run on a 32-bit int machine.
-C modules produced by such a \fIyacc\fP are not portable and
-should not be used to (cross)compile programs for 16-bit machines.
-We assume a version UNIX which, apart from the C-compiler,
-contains most normal utilities, like ed, sed, grep, make, the
-Bourne shell etc.
-All Makefiles use the system C-compiler.
-The existence of a backend for your system is of course essential
-if you wish to produce executable files for that system.
-When the backend exists it is also possible to boot the Pascal
-Compiler,
-that is written in Pascal itself.
-The kit contains the compact code files for the 2/2 and 2/4
-versions of the Pascal compiler.
-The current version of this compiler can only be used on machines
-with a 16-bit word size and 16- or 32-bit pointers.
-The Makefile automatically tries to boot the Pascal compiler
-from one of these compact code files, if the compiler proves
-unable to compile itself.
-.PP
-The native assemblers and loaders are used on PDP-11 and VAX.
-The description files in lib/ack for other systems use our
-universal assembler.
-The load file produced by this assembler is not directly
-usable in any system known to us,
-but has to be converted before it can be put to use.
-The \fIdl\fP programs present for some machines unravel
-these load files and transmit commands to load memory
-to a microprocessor over a serial line.
-The PDP-11 version of our universal assembler is supplied
-with a conversion program.
-The file man/a.out.5 contains a description of the format of
-the universal assembler load file,
-it might be useful to those who wish or need to write their
-own conversion programs.
-.br
-Berkeley UNIX for the VAX'en has (at least) three different
-versions, BSD4.1a, BSD4.1c and BSD4.2. The READ_ME files in the
-directories mach/vax2/cg, mach/vax2/libem, mach/vax4/cg and
-mach/vax4/libem tell you how to adapt the vax2 and vax4 backend
-to these versions.
-.NH 2
-Recompiling libraries
-.PP
-The kit contains sources for part II and III of the C-library, except
-the math functions, they are grabbed from our V7 system and sometimes
-altered in a EM dependent way or replaced altogether when the original
-was in assembly.
-These files can be used to make libraries for the Ack C-compiler.
-The recompilation process uses a few include files.
-The include directory in the EM home directory contains a few more
-or less system independent include files.
-The system dependent include files are fetched from /usr/include
-on the system you use to recompile.
-This may lead to several problems.
-Sometimes the system differs so much from V7 that certain manifest constants
-do not exist any more.
-At other times these include files were written for a compiler without
-a restriction on name length.
-In that case - I've seen it happen - people tend to use differing
-identifiers that are identical in the first eight characters.
-All these problems you have to solve yourself,
-the libraries are only included as an extra and too much system
-dependent to give any guarantees.
-.NH
-Fixes to the UNIX V7 system
-.PP
-UNIX System V7 has a few bugs that prevent a part of or the whole kit
-from working properly.
-To be honest, we do not know which of the following changes are
-essential to the functioning of our kit.
-.PP
-The file "doc/v7bugs.doc" gives for each of the following bugs
-a small test program and a diff listing of the source files that have to be
-modified.
-.IP 1
-Bug in the C optimizer for unsigned comparison
-.nr PD 0
-.IP 2
-The loader 'ld' fails for large data and text portions
-.IP 3
-Floating point registers are not saved if more memory is needed.
-.IP 4
-Floating point registers are not copied to child in fork().
-.nr PD 1v
-.LP
-Use the test programs to see if the errors are present in your system
-and to check if the modifications are effective.
-.NH
-Testing
-.PP
-Test sets are available in Pascal, C and EM assembly.
-.IP em 8
-.br
-The directory emtest contains a few EM test programs.
-The EM assembly files in these tests must be transformed into
-load files, thereby avoiding use of the EM optimizer.
-These tests use the LIN and NOP instructions to mark the passing of each
-test.
-The NOP instruction prints the current line number during the
-test phase.
-Each test notifies its correctness by calling LIN with a unique
-number followed by a NOP which prints this line number.
-The test finishes normally with 0 as the last number printed
-In all other cases a bug showed its
-existence.
-.IP Pascal
-.br
-The directory lang/pc/test contains a few pascal test programs.
-All these programs print the number of errors found and a
-identification of these errors.
-.IP C
-.br
-The sub-directories in lang/cem/ctest contain C test programs.
-The idea behind these tests is:
-when you have a program called xx.c, compile it into xx.cem.
-Run it with standard output to xx.cem.r, compare this file to
-xx.cem.g, a file containing the 'ideal' output.
-Any differences will point to implementation differences or
-bugs.
-Giving the command "run gen" or plain "run" starts this
-process.
-The differences will be presented on standard output.
-The contents of the result files depend on the wordsize,
-the xx.cem.g files on the distribution are intended for a
-16-bit machine.
-.NH
-Documentation
-.PP
-Manual pages for Amsterdam Compiler Kit can be copied
-to "/usr/man/man?" by the
-following commands:
-.DS
-cd man
-make install
-.DE
-.LP
-Several documents are provided:
-.DS
-doc/toolkit.doc: a general overview
-doc/pcref.doc: the Pascal-frontend reference manual
-doc/val.doc: the results of running the Pascal Validation Suite
-doc/cref.doc: the C-frontend manual
-doc/em.doc: a description of the EM machine architecture
-doc/peep.doc: internal documentation for the peephole optimizer
-doc/cg.doc: documentation for backend writers and maintainers
-doc/regadd.doc: addendum to previous document describing register variables
-doc/install.doc: this document
-.DE
-.LP
-The Validation Suite is a collection of more than 200 Pascal programs,
-designed by Brian Wichmann and Arthur Sale to test Pascal compilers.
-We are not allowed to distribute it, but you may
-request a copy from
-.DS
-Richard J. Cichelli
-A.N.P.A.
-1350 Sullivan Trail
-P.O. Box 598
-Easton, Pennsylvania 18042
-USA
-.DE
-.LP
-Good luck.
+++ /dev/null
-.ds OF \\fBtest~off:~\\fR
-.ds ON \\fBtest~on:~~\\fR
-.ds AL \\fBtest~all:~\\fR
-.ll 72
-.wh 0 hd
-.wh 60 fo
-.de hd
-'sp 5
-..
-.de fo
-'bp
-..
-.tr ~
-. TITLE
-.de TL
-.sp 15
-.ce
-\\fB\\$1\\fR
-..
-. AUTHOR
-.de AU
-.sp 15
-.ce
-by
-.sp 2
-.ce
-\\$1
-..
-. DATE
-.de DA
-.sp 3
-.ce
-( Dated \\$1 )
-..
-. INSTITUTE
-.de VU
-.sp 3
-.ce 4
-Wiskundig Seminarium
-Vrije Universiteit
-De Boelelaan 1081
-Amsterdam
-..
-. PARAGRAPH
-.de PP
-.sp
-.ti +5
-..
-.nr CH 0 1
-. CHAPTER
-.de CH
-.nr SH 0 1
-.bp
-.in 0
-\\fB\\n+(CH.~\\$1\\fR
-.PP
-..
-. SUBCHAPTER
-.de SH
-.sp 3
-.in 0
-\\fB\\n(CH.\\n+(SH.~\\$1\\fR
-.PP
-..
-. INDENT START
-.de IS
-.sp
-.in +5
-..
-. INDENT END
-.de IE
-.in -5
-.sp
-..
-. DOUBLE INDENT START
-.de DS
-.sp
-.in +5
-.ll -5
-..
-. DOUBLE INDENT END
-.de DE
-.ll +5
-.in -5
-.sp
-..
-. EQUATION START
-.de EQ
-.sp
-.nf
-..
-. EQUATION END
-.de EN
-.fi
-.sp
-..
-. ITEM
-.de IT
-.sp
-.in 0
-\\fBISO~\\$1:\\fR~\\
-..
-. IMPLEMENTATION 1
-.de I1
-.IS
-.ti -3
-1.~\\
-..
-. IMPLEMENTATION 2
-.de I2
-.sp
-.ti -3
-2.~\\
-..
-.de CS
-.br
-~-~\\
-..
-.br
-.fi
-.TL "Amsterdam Compiler Kit-Pascal reference manual"
-.AU "Johan W. Stevenson"
-.DA "January 4, 1983"
-.VU
-.CH "Introduction"
-This document refers to the (March 1980) ISO standard proposal for Pascal [1].
-Ack-Pascal complies with the requirements of this proposal almost completely.
-The standard requires an accompanying document describing the
-implementation-defined and implementation-dependent features,
-the reaction on errors and the extensions to standard Pascal.
-These four items will be treated in the rest of this document,
-each in a separate chapter.
-The other chapters describe the deviations from the standard and
-the list of options recognized by the compiler.
-.PP
-The Ack-Pascal compiler produces code for an EM machine as defined in [2].
-It is up to the implementor of the EM machine to decide whether errors like
-integer overflow, undefined operand and range bound error are recognized or not.
-For these errors the reaction of some known implementations is given.
-.PP
-There does not (yet) exist a hardware EM machine.
-Therefore, EM programs must be interpreted, or translated into
-instructions for a target machine.
-For the following implementations the behavior is documented:
-.I1
-an interpreter running on a PDP-11.
-Normally the interpreter performs some tests to detect undefined
-integers, integer overflow, range errors, etc.
-However, an option of the interpreter is to skip these tests.
-Another option is to perform some extra tests
-to check for instance the number of actual parameter
-words against the number expected by
-the called procedure.
-We will refer to these modes of operation as 'test all', 'test on' and 'test off'.
-.I2
-a translator into PDP-11 instructions.
-.IE
-.CH "Implementation-defined features"
-For each implementation-defined feature mentioned in the ISO standard
-we give the section number, the quotation from that section and the definition.
-First we quote the definition of implementation-defined:
-.DS
-Those parts of the language which may differ between processors, but which
-will be defined for any particular processor.
-.DE
-.IT 6.1.7
-Each string-character shall denote an implementation-defined value of char-type.
-.IS
-All 7-bits ASCII characters except linefeed LF (10) are allowed.
-Note that an apostrophe ' must be doubled within a string.
-.IE
-.IT 6.4.2.2
-The values of type real shall be an implementation-defined subset
-of the real numbers denoted as specified by 6.1.5.
-.IS
-The format of reals is not defined in EM.
-Even the size of reals depends on the implementation.
-The compiler can be instructed, by the f-option, to use a different
-size for real values.
-The size of reals is preset by the calling program \fIack\fP
-[4] to
-the proper size.
-For each implementation of EM the following constants must be defined:
- epbase: the base for the exponent part
- epprec: the precision of the fraction
- epemin: the minimum exponent
- epemax: the maximum exponent
-.br
-These constants must be chosen so that zero and all numbers with
-exponent e in the range
-.EQ
- epemin <= e <= epemax
-.EN
-and fraction-parts of the form
-.EQ
- f = +\b_ f\d1\u.b\u-1\d + ... + f\depprec\u.b\u-epprec\d
-.EN
-where
-.EQ
- f\di\u = 0,...,epbase-1 and f\d1\u <> 0
-.EN
-are possible values for reals.
-All other values of type real are considered illegal.
-(See [3] for more information about these constants).
-.br
-For the known EM implementations these constants are:
-.I1
-epbase = 2
-.br
-epprec = 24
-.br
-epemin = -127
-.br
-epemax = +127
-.I2
-ditto
-.IE
-.IT 6.4.2.2
-The type char shall be the enumeration of a set of implementation-defined
-characters, some possibly without graphic representations.
-.IS
-The 7-bits ASCII character set is used, where LF (10) denotes the
-end-of-line marker on text-files.
-.IT 6.4.2.2
-The ordinal numbers of the character values shall be values of integer-type,
-that are implementation-defined, and that are determined by mapping
-the character values on to consecutive non-negative integer values
-starting at zero.
-.IS
-The normal ASCII ordering is used: ord('0')=48, ord('A')=65, ord('a')=97, etc.
-.IE
-.IT 6.4.3.4
-The largest and smallest values of integer-type
-permitted as numbers of a value
-of a set-type shall be implementation-defined.
-.IS
-The smallest value is 0. The largest value is default 15, but can be
-changed by using the i-option of the compiler up to a maximum
-of 32767.
-The compiler allocates as many bits for set-type variables as are necessary
-to store all possible values of the host-type of the base-type of the set,
-rounded up to the nearest multiple of 16.
-If 8 bits are sufficient then only
-8 bits are used if part of a packed structure.
-Thus, the variable s, declared by
-.EQ
- var s: set of '0'..'9';
-.EN
-will contain 128 bits, not 10 or 16.
-These 128 bits are stored in 16 bytes, both for packed and unpacked sets.
-If the host-type of the base-type is integer, then the
-number of bits depends on the i-option.
-The programmer may specify how many bits to allocate for these sets.
-The default is 16, the maximum is 32767.
-The effective number of bits is rounded up to the next multiple of 16, or up
-to 8 if the number of bits is less than or equal to 8.
-Note that the use of set-constructors for sets with more than 256 elements
-is far less efficient than for smaller sets.
-.IT 6.7.2.2
-The predefined constant maxint shall be of integer-type and shall denote
-an implementation-defined value, that satisfies the following conditions:
-.sp 1
-.in +5
-.ti -4
-(a)~All integral values in the closed interval from -maxint to +maxint
-shall be values in the integer-type.
-.ti -4
-(b)~Any monadic operation performed on an integer value in this interval
-shall be correctly performed according to the mathematical rules for
-integer arithmetic.
-.ti -4
-(c)~Any dyadic integer operation on two integer values in this same interval
-shall be correctly performed according to the mathematical rules for
-integer arithmetic, provided that the result is also in this interval.
-.ti -4
-(d)~Any relational operation on two integer values in this same interval
-shall be correctly performed according to the mathematical rules for
-integer arithmetic.
-.in -5
-.IS
-The representation of integers in EM is a \fIn\fP*8-bit word using
-two's complement arithmetic.
-Where \fIn\fP is called wordsize.
-The compiler can only generate code for EM with wordsize 2.
-Thus always:
-.EQ
- maxint = 32767
-.EN
-Because the number -32768 may be used to indicate 'undefined', the
-range of available integers depends on the EM implementation:
-.I1
-\*(ON-32767..+32767.
-.br
-\*(OF-32768..+32767.
-.I2
--32768..+32767.
-.IE
-.IT 6.9.4.2
-The default TotalWidth values for integer, Boolean and real types
-shall be implementation-defined.
-.IS
-The defaults are:
- integer 6
- Boolean 5
- real 13
-.IT 6.9.4.5.1
-ExpDigits, the number of digits written in an exponent part of a real,
-shall be implementation-defined.
-.IS
-ExpDigits is defined as
-.EQ
- ceil(log10(log10(2 ** epemax)))
-.EN
-For the current implementations this evaluates to 2.
-.IT 6.9.4.5.1
-The character written as part of the representation of
-a real to indicate the beginning of the exponent part shall be
-implementation-defined, either 'E' or 'e'.
-.IS
-The exponent part starts with 'e'.
-.IT 6.9.4.6
-The case of the characters written as representation of the
-Boolean values shall be implementation-defined.
-.IS
-The representations of true and false are 'true' and 'false'.
-.IT 6.9.6
-The effect caused by the standard procedure page
-on a text file shall be implementation-defined.
-.IS
-The ASCII character form feed FF (12) is written.
-.IT 6.10
-The binding of the variables denoted by the program-parameters
-to entities external to the program shall be implementation-defined if
-the variable is of a file-type.
-.IS
-The program parameters must be files and all, except input and output,
-must be declared as such in the program block.
-.PP
-The program parameters input and output, if specified, will correspond
-with the UNIX streams 'standard input' and 'standard output'.
-.PP
-The other program parameters will be mapped to the argument strings
-provided by the caller of this program.
-The argument strings are supposed to be path names of the files to be
-opened or created.
-The order of the program parameters determines the mapping:
-the first parameter is mapped onto the first argument string etc.
-Note that input and output are ignored in this mapping.
-.PP
-The mapping is recalculated each time a program parameter
-is opened for reading or writing by a call to the standard procedures
-reset or rewrite.
-This gives the programmer the opportunity to manipulate the list
-of string arguments using the external procedures argc, argv and argshift
-available in libpc [7].
-.IT 6.10
-The effect of an explicit use of reset or rewrite
-on the standard textfiles input or output shall be implementation-defined.
-.IS
-The procedures reset and rewrite are no-ops
-if applied to input or output.
-.CH "Implementation-dependent features"
-For each implementation-dependent feature mentioned in the ISO standard draft,
-we give the section number, the quotation from that section and the way
-this feature is treated by the Ack-Pascal system.
-First we quote the definition of 'implementation-dependent':
-.DS
-Those parts of the language which may differ between processors,
-and for which there need not be a definition for a particular processor.
-.DE
-.IT 5.1.1
-The method for reporting errors or warnings shall be implementation-dependent.
-.IS
-The error handling is treated in a following chapter.
-.IE
-.IT 6.1.4
-Other implementation-dependent directives may be defined.
-.IS
-Except for the required directive 'forward' the Ack-Pascal compiler recognizes
-only one directive: 'extern'.
-This directive tells the compiler that the procedure block of this
-procedure will not be present in the current program.
-The code for the body of this procedure must be included at a later
-stage of the compilation process.
-.PP
-This feature allows one to build libraries containing often used routines.
-These routines do not have to be included in all the programs using them.
-Maintenance is much simpler if there is only one library module to be
-changed instead of many Pascal programs.
-.PP
-Another advantage is that these library modules may be written in a different
-language, for instance C or the EM assembly language.
-This is useful if you want to use some specific EM instructions not generated
-by the Pascal compiler. Examples are the system call routines and some
-floating point conversion routines.
-Another motive could be the optimization of some time-critical program parts.
-.PP
-The use of external routines, however, is dangerous.
-The compiler normally checks for the correct number and type of parameters
-when a procedure is called and for the result type of functions.
-If an external routine is called these checks are not sufficient,
-because the compiler can not check whether the procedure heading of the
-external routine as given in the Pascal program matches the actual routine
-implementation.
-It should be the loader's task to check this.
-However, the current loaders are not that smart.
-Another solution is to check at run time, at least the number of words
-for parameters. Some EM implementations check this:
-.I1
-\*(ALthe number of words passed as parameters is checked, but this will not catch all faulty cases.
-.br
-\*(ONnot checked.
-.I2
-not checked.
-.IT 6.7.2.1
-The order of evaluation of the operands of a dyadic operator
-shall be implementation-dependent.
-.IS
-Operands are always evaluated, so the program part
-.EQ
- if (p<>nil) and (p^.value<>0) then
-.EN
-is probably incorrect.
-.PP
-The left-hand operand of a dyadic operator is almost always evaluated
-before the right-hand side.
-Some peculiar evaluations exist for the following cases:
-.IS
-.ti -3
-1.~\
-the modulo operation is performed by a library routine to
-check for negative values of the right operand.
-.IE
-.sp
-.ti -3
-2.~\
-the expression
-.EQ
- set1 <= set2
-.EN
-where set1 and set2 are compatible set types is evaluated in the
-following steps:
-.IS
-.CS
-evaluate set2
-.CS
-evaluate set1
-.CS
-compute set2+set1
-.CS
-test set2 and set2+set1 for equality
-.IE
-This is the only case where the right-hand side is computed first.
-.sp
-.ti -3
-3.~\
-the expression
-.EQ
- set1 >= set2
-.EN
-where set1 and set2 are compatible set types is evaluated in the following steps:
-.IS
-.CS
-evaluate set1
-.CS
-evaluate set2
-.CS
-compute set1+set2
-.CS
-test set1 and set1+set2 for equality
-.IE
-.IT 6.7.3
-The order of evaluation, accessing and binding
-of the actual-parameters for functions
-shall be implementation-dependent.
-.IS
-The order of evaluation is from right to left.
-.IT 6.8.2.2
-If access to the variable in an assignment-statement involves the indexing of an array
-and/or a reference to a field within a variant of a record
-and/or the de-referencing of a pointer-variable
-and/or a reference to a buffer-variable,
-the decision whether these actions precede or follow the evaluation
-of the expression shall be implementation-dependent.
-.IS
-The expression is evaluated first.
-.IT 6.8.2.3
-The order of evaluation and binding of the actual-parameters for procedures
-shall be implementation-dependent.
-.IS
-The same as for functions.
-.IT 6.9.6
-The effect of inspecting a text file to which the page
-procedure was applied during generation is
-implementation-dependent.
-.IS
-The formfeed character written by page is
-treated like a normal character, with ordinal value 12.
-.IT 6.10
-The binding of the variables denoted by the program-parameters
-to entities external to the program shall be implementation-dependent unless
-the variable is of a file-type.
-.IS
-Only variables of a file-type are allowed as program parameters.
-.IE
-.CH "Error handling"
-There are three classes of errors to be distinguished.
-In the first class are the error messages generated by the compiler.
-The second class consists of the occasional errors generated by the other
-programs involved in the compilation process.
-Errors of the third class are the errors as defined in the standard by:
-.DS
-An error is a violation by a program of the requirements of this standard
-such that detection normally requires execution of the program.
-.DE
-.SH "Compiler errors"
-The error messages (and the listing) are not generated by the compiler itself.
-The compiler only detects errors and writes the errors in condensed form on
-an intermediate file.
-Each error in condensed form contains:
-.IS
-.CS
-an optional error message parameter (identifier or number).
-.CS
-an error number
-.CS
-a line number
-.CS
-a column number.
-.IE
-Every time the compiler detects an error that does not have influence
-on the code produced by the compiler or on the syntax decisions, a warning
-messages is given.
-If only warnings are generated, compilation proceeds and probably results
-in a correctly compiled program.
-.PP
-The intermediate error file is read by the interface program
-\fIack\fP [4],
-that produces the error messages.
-It uses an other file, the error message file,
-to find an error script line.
-Whenever this error script line contains the character '%', the error messages
-parameter is substituted.
-For negative error numbers the message constructed is prepended with 'Warning: '.
-.PP
-Sometimes the compiler produces several errors for the same file position
-(line number, column number).
-Only the first of these messages is given, because the others are probably
-directly caused by the first one.
-If the first one is a warning while one of its successors for that position
-is a fatal message, then the warning is promoted to a fatal one.
-However, parameterized messages are always given.
-.PP
-The error messages and listing come in three flavors, selected by flags
-given to \fIack\fP [4]:
-.in +10
-.sp
-.ti -8
-default:no listing, one line per error giving the file name
-of the Pascal source file, the line number and the error messages.
-.sp
-.ti -8
--e:~~~~~for each erroneous line a listing of the line and its predecessor.
-The next line contains one or more characters '^' pointing to the
-places where an error is detected.
-For each error on that line a message follows.
-.sp
-.ti -8
--E:~~~~~same as for '-e', except that all source lines are listed,
-even if the program is perfect.
-.IE
-.IE
-.SH "Other errors detected at compilation time"
-Two main categories: file system problems and table overflow.
-Problems with the file system may be caused by protection (you may not read
-or create files) or by space problems (no space left on device; out of inodes;
-too many processes).
-Table overflow problems are often caused by peculiar source programs:
-very long procedures or functions, a lot of strings.
-Table overflow problems can sometimes be cured
-by giving a flag (-sl when producing e.out files) to \fIack\fP [4].
-.PP
-Extensive treatment of these errors is outside the scope of this manual.
-.SH "Runtime errors"
-Errors detected at run time cause an error message to be generated on the
-diagnostic output stream (UNIX file descriptor 2).
-The message consists of the name of the program followed by a message
-describing the error, possibly followed by the source line number.
-Unless the l-option is turned off, the compiler generates code to keep track
-of which source line causes which EM instructions to be generated.
-It depends on the EM implementation whether these LIN instructions
-are skipped or executed:
-.I1
-LIN instructions are always executed. The old line number is saved and
-restored whenever a procedure or function is called.
-All error messages contain this line number, except when the l-option
-was turned off.
-.I2
-same as above, but line numbers are not saved when procedures and functions
-are called.
-.IE
-For each error mentioned in the standard we give the section number,
-the quotation from that section and the way it is processed by the
-Pascal-compiler or runtime system.
-.PP
-For detected errors the corresponding message
-and trap number are given.
-Trap numbers are useful for exception-handling routines.
-Normally, each error causes the program to terminate.
-By using exception-handling routines one can
-ignore errors or perform alternate actions.
-Only some of the errors can be ignored
-by restarting the failing instruction.
-These errors are marked as non-fatal,
-all others as fatal.
-A list of errors with trap number between 0 and 63
-(EM errors) can be found in [2].
-Errors with trap number between 64 and 127 (Pascal errors) are listed in [8].
-.IT 6.4.3.3
-It shall be an error if any field-identifier defined within a variant
-is used in a field-designator unless the value of the tag-field
-is associated with that variant.
-.IS
-This error is not detected.
-Sometimes this feature is used to achieve easy type conversion.
-However, using record variants this way is dangerous, error prone and not portable.
-.IT 6.4.6
-It shall be an error if a value of type T2 must be
-assignment-compatible with type T1, while
-T1 and T2 are compatible ordinal-types and the value of
-type T2 is not in the closed interval specified by T1.
-.IS
-The compiler distinguishes between array-index expressions and the other
-places where assignment-compatibility is required.
-.PP
-Array subscripting is done using the EM array instructions.
-These instructions have three arguments: the array base address,
-the index and the address of the array descriptor.
-An array descriptor describes one dimension by three values:
-the element size, the lower bound on the index and the number of elements
-minus one.
-It depends on the EM implementation whether these bounds are checked:
-.I1
-\*(ONchecked (array bound error, trap 0, non-fatal).
-.br
-\*(OFnot checked
-.I2
-not checked.
-.IE
-The other places where assignment-compatibility is required are:
-.IS
-.CS
-assignment
-.CS
-value parameters
-.CS
-procedures read and readln
-.CS
-the final value of the for-statement
-.IE
-For these places the compiler generates an EM range check instruction, except
-when the r-option is turned off, or when the range of values of T2
-is enclosed in the range of T1.
-If the expression consists of a single variable and if that variable
-is of a subrange type,
-then the subrange type itself is taken as T2, not its host-type.
-Therefore, a range instruction is only generated if T1 is a subrange type
-and if the expression is a constant, an expression with two or more
-operands, or a single variable with a type not enclosed in T1.
-If a constant is assigned, then the EM optimizer removes the range check
-instruction, except when the value is out of bounds.
-.PP
-It depends on the EM implementation whether the range check instruction
-is executed or skipped:
-.I1
-\*(ONchecked (range bound error, trap 1, non-fatal).
-.br
-\*(OFskipped
-.I2
-skipped
-.IE
-.IT 6.4.6
-It shall be an error if a value of type T2 must be
-assignment-compatible with type T1, while T1 and T2 are compatible
-set-types and any member of the value of type T2
-is not in the closed interval specified by the base-type
-of the type T1.
-.IS
-This error is not detected.
-.IT 6.5.4
-It shall be an error if
-the pointer-variable has a nil-value or is undefined at the time
-it is de-referenced.
-.IS
-The EM definition does not specify the binary representation of pointer
-values, so that it is not possible to choose an otherwise illegal
-binary representation for the pointer value NIL.
-Rather arbitrary the compiler uses the integer value zero to represent NIL.
-For all current implementations this does not cause problems.
-.PP
-The size of pointers depends on the implementation and is
-preset in the compiler by \fIack\fP [4].
-The compiler can be instructed, by the p-option, to use
-any size for pointer objects.
-NIL is represented here by the appropriate number of zero words.
-.PP
-It depends on the EM implementation whether de-referencing of a pointer
-with value NIL causes an error:
-.I1
-\*(ONfor every de-reference the pointer value is checked to be legal.
-The value NIL is always illegal.
-Objects addressed by a NIL pointer always cause an error, except
-when they are part of some extraordinary sized structure
-(bad pointer, trap 22, fatal).
-.br
-\*(OFde-referencing for fetching will not cause
-an error to occur.
-However, if the pointer value is used for a store operation,
-a segmentation violation probably results (memory fault, trap 21, fatal).
-(Note: this is only true if the interpreter is executed with coinciding
-address spaces and protected text part. The interpreter must therefore
-be loaded with the '-n' option of the UNIX loader [5]).
-.I2
-de-referencing for a fetch operation will not cause an error.
-A store operation probably causes an error if the '-n' flag is
-specified to \fIack\fP [4] or ld [5] while loading your program.
-.IE
-Some implementations of EM initialize all memory cells for newly
-created variables with a constant that probably causes an error if that variable
-is not initialized with a value of its own type before use.
-For each implementation we give whether memory cells are initialized,
-with what value, and whether this value causes an error if de-referenced.
-.I1
-each memory word is initialized with the bit representation 1000000000000000,
-representing -32768 in 2's complement notation.
-For most small and medium sized programs this value will cause a segmentation
-violation (memory fault, trap 21, fatal).
-.I2
-no initialization.
-Whenever a pointer is de-referenced, without being properly initialized,
-a segmentation violation (memory fault, trap 21, fatal)
-or 'bus error' are possible.
-.IE
-.IT 6.5.5
-It shall be an error if the value of a file-variable f is altered
-while the buffer-variable is an actual variable parameter, or
-an element of the record-variable-list of a with-statement, or both.
-.IS
-This error is not detected
-.IT 6.5.5
-It shall be an error if the value of a file-variable f is altered
-by an assignment-statement which contains the buffer-variable f^ in
-its left-hand side.
-.IS
-This error is not detected.
-.IT 6.6.5.2
-It shall be an error if
-the stated pre-assertion does not hold immediately
-prior to any use of the file handling procedures
-rewrite, put, reset and get.
-.IS
-For each of these four operations the pre-assertions
-can be reformulated as:
-.sp
-rewrite(f):~no pre-assertion.
-.br
-put(f):~~~~~f is opened for writing and f^ is not undefined.
-.br
-reset(f):~~~f exists.
-.br
-get(f):~~~~~f is opened for reading and eof(f) is false.
-.sp
-The following errors are detected for these operations:
-.sp
-rewrite(f):
-.in +10
-.ti -5
-more args expected, trap 64, fatal:
-.br
-f is a program-parameter and the corresponding
-file name is not supplied by the caller of the program.
-.ti -5
-rewrite error, trap 101, fatal:
-.br
-the caller of the program lacks the necessary
-access rights to create the file in the file system
-or operating system problems like table overflow
-prevent creation of the file.
-.in -10
-.sp
-put(f):
-.in +10
-.ti -5
-file not yet open, trap 72, fatal:
-.br
-reset or rewrite are never applied to the file.
-The checks performed by the run time system are not foolproof.
-.ti -5
-not writable, trap 96, fatal:
-.br
-f is opened for reading.
-.ti -5
-write error, trap 104, fatal:
-.br
-probably caused by file system problems.
-For instance, the file storage is exhausted.
-Because IO is buffered to improve performance,
-it might happen that this error occurs if the
-file is closed.
-Files are closed whenever they are rewritten or reset, or on
-program termination.
-.in -10
-.sp
-reset(f):
-.in +10
-.ti -5
-more args expected, trap 64, fatal:
-.br
-same as for rewrite(f).
-.ti -5
-reset error, trap 100, fatal:
-.br
-f does not exist, or the caller has insufficient access rights, or
-operating system tables are exhausted.
-.in -10
-.sp
-get(f):
-.in +10
-.ti -5
-file not yet open, trap 72, fatal:
-.br
-as for put(f).
-.ti -5
-not readable, trap 97, fatal:
-.br
-f is opened for writing.
-.ti -5
-end of file, trap 98, fatal:
-.br
-eof(f) is true just before the call to get(f).
-.ti -5
-read error, trap 103, fatal:
-.br
-unlikely to happen. Probably caused by hardware problems
-or by errors elsewhere in your program that destroyed
-the file information maintained by the run time system.
-.ti -5
-truncated, trap 99, fatal:
-.br
-the file is not properly formed by an integer
-number of file elements.
-For instance, the size of a file of integer is odd.
-.ti -5
-non-ASCII char read, trap 106, non-fatal:
-.br
-the character value of the next character-type
-file element is out of range (0..127).
-Only for text files.
-.in -10
-.IT 6.6.5.3
-It shall be an error to change any variant-part of a variable
-allocated by the form new(p,c1,...,cn) from the variant specified.
-.IS
-This error is not detected.
-.IT 6.6.5.3
-It shall be an error if a variable to be disposed had been allocated
-using the form new(p,c1,...,cn) with more variants specified than
-specified to dispose.
-.IS
-This error can cause more memory to be freed then was allocated.
-Dispose causes a fatal trap 73 when memory already on the free
-list is freed again.
-.IT 6.6.5.3
-It shall be an error if the variants of a variable to be disposed
-are different from those specified by the case-constants to dispose.
-.IS
-This error is not detected.
-.IT 6.6.5.3
-It shall be an error if the value of the pointer parameter of dispose has
-nil-value or is undefined.
-.IS
-The same comments apply as for de-referencing NIL or undefined pointers.
-.IT 6.6.5.3
-It shall be an error if a variable that is identified by the pointer parameter
-of dispose (or a component thereof) is currently either an actual
-variable parameter, or an element of the record-variable-list of a
-with-statement, or both.
-.IS
-This error is not detected.
-.IT 6.6.5.3
-It shall be an error if a referenced-variable created using the second form
-of new is used in its entirety
-as an operand in an expression, or as the variable in an assignment-statement
-or as an actual-parameter.
-.IS
-This error is not detected.
-.IT 6.6.6.2
-It shall be an error if the mathematical defined result of an
-arithmetic function would fall outside the set of values
-of the indicated result.
-.IS
-Except for the errors for undefined arguments,
-the following errors may occur for the arithmetic functions:
-.in +16
-.ti -11
-abs(x):~~~~none.
-.ti -11
-sqr(x):~~~~real underflow, trap 5, non-fatal;
-.br
-real overflow, trap 4, non-fatal
-.ti -11
-sin(x):~~~~real underflow, trap 5, non-fatal
-.ti -11
-cos(x):~~~~real underflow, trap 5, non-fatal
-.ti -11
-exp(x):~~~~error in exp, trap 65, non-fatal (if x>10000);
-.br
-real underflow, trap 5, non-fatal;
-.br
-real overflow, trap 4, non-fatal
-.ti -11
-ln(x):~~~~~error in ln, trap 66, non-fatal ( if x<=0)
-.ti -11
-sqrt(x):~~~error in sqrt, trap 67, non-fatal (if x<0)
-.ti -11
-arctan(x):~real underflow, trap 5, non-fatal;
-.br
-real overflow, trap 4, non-fatal
-.in -16
-.IE
-.IT 6.6.6.2
-It shall be an error if x in ln(x) is not greater than zero.
-.IS
-See above.
-.IT 6.6.6.2
-It shall be an error if x in sqrt(x) is negative.
-.IS
-See above.
-.IT 6.6.6.2
-It shall be an error if
-the integer value of trunc(x) does not exist.
-.IS
-This error is detected (conversion error, trap 10, non-fatal).
-.IT 6.6.6.2
-It shall be an error if
-the integer value of round(x) does not exist.
-.IS
-This error is detected (conversion error, trap 10, non-fatal).
-.IT 6.6.6.2
-It shall be an error if
-the integer value of ord(x) does not exist.
-.IS
-This error can not occur, because the compiler will not allow
-such ordinal types.
-.IT 6.6.6.2
-It shall be an error if
-the character value of chr(x) does not exist.
-.IS
-Except when the r-option is turned off, the compiler generates an EM
-range check instruction. The effect of this instruction depends on the
-EM implementation as described before.
-.IT 6.6.6.2
-It shall be an error if the value of succ(x) does not exist.
-.IS
-Same comments as for chr(x).
-.IT 6.6.6.2
-It shall be an error if the value of pred(x) does not exist.
-.IS
-Same comments as for chr(x).
-.IT 6.6.6.5
-It shall be an error if
-f in eof(f) is undefined.
-.IS
-This error is detected (file not yet open, trap 72, fatal).
-.IT 6.6.6.5
-It shall be an error if
-f in eoln(f) is undefined, or if eof(f) is true at that time.
-.IS
-The following errors may occur:
-.IS
-file not yet open, trap 72, fatal;
-.br
-not readable, trap 97, fatal;
-.br
-end of file, trap 98, fatal.
-.IE
-.IT 6.7.1
-It shall be an error if any variable or function used as an operand in an expression is
-undefined at the time of its use.
-.IS
-Detection of undefined operands is only possible if there is at least one bit
-representation that is not allowed as legal value.
-The set of legal values depends on the type of the operand.
-To detect undefined operands, all newly created variables must be assigned
-a value illegal for the type of the created variable.
-The compiler itself does not generate code to initialize newly created variables.
-Instead, the compiler generates code to allocate some new memory cells.
-It is up to the EM implementation to initialize these memory cells.
-However, the EM machine does not know the types of the variables for which
-memory cells are allocated.
-Therefore, the best an EM implementation can do is to initialize with a value
-that is illegal for the most common types of operands.
-.PP
-For all current EM implementations we will describe whether memory cells
-are initialized, which value is used to initialize, for each operand type
-whether that value is illegal, and for all operations on all operand
-types whether that value is detected as undefined.
-.I1
-\*(ONnew memory words are initialized with -32768.
-Assignment of this value is always allowed. Errors may occur
-whenever undefined operands are used in operations.
-.br
-.ul
-integer:
--32768 is illegal. All arithmetic operations (except unary +) cause
-an error (undefined integer, trap 8, non-fatal).
-Relational operations do not, except for IN when the left operand is undefined.
-Printing of -32768 using write is allowed.
-.br
-.ul
-real:
-the bit representation of a real, caused by initializing the constituent
-memory words with -32768, is illegal.
-All arithmetic and relational operations (except unary +) cause an error
-(real undefined, trap 9, non-fatal).
-Printing causes the same error.
-.br
-.ul
-char:
-the value -32768 is illegal. For objects of type 'packed array[] of char'
-half the characters will have the value chr(0), which is legal, and the
-others will have the value chr(128), outside the valid ASCII range.
-The relational operators, however, do not cause an error.
-.br
-.ul
-Boolean:
-the value -32768 is illegal. For objects of type 'packed array[] of boolean'
-half the booleans will have the value false, while the others have the value v,
-where ord(v) = 128, naturally illegal.
-However, the Boolean and relational operations do not cause an error.
-.br
-.ul
-set:
-undefined operands of type set can not be distinguished from
-properly initialized ones.
-The set and relational operations, therefore, can never cause an error.
-However, if one forgets to initialize a set of character, then spurious
-characters like '/', '?', 'O', '_' and 'o' appear.
-.sp
-\*(OFnew memory cells are initialized with -32768.
-The only cases where this value causes an error are when
-an undefined operand of type real is used in an arithmetic or relational
-operation (except unary +) or when an undefined real is used as an
-argument to a standard function.
-.I2
-Newly created memory cells are not initialized and therefore
-they have a random value.
-.IT 6.7.1
-It shall be an error if
-the value of any member denoted by any member-designator of the
-set-constructor is outside the implementation-defined limits.
-.IS
-This error is detected (set bound error, trap 2, non-fatal).
-.IT 6.7.1
-It shall be an error if
-the possible types of an set-constructor do not permit it
-to assume a suitable type.
-.IS
-The compiler allocates as many bits as are necessary to store all
-elements of the host-type of the base-type of the set, not the
-base-type itself.
-Therefore, all possible errors can be detected at compile time.
-.IT 6.7.2.2
-It shall be an error if j is zero in 'i div j'.
-.IS
-It depends on the EM implementation whether this error is detected:
-.I1
-\*(ONdetected (divide by 0, trap 6, non-fatal).
-.br
-\*(OFnot detected.
-.I2
-not detected.
-.IE
-.IT 6.7.2.2
-It shall be an error if
-j is zero or negative in i MOD j.
-.IS
-This error is detected (only positive j in 'i mod j', trap 71, non-fatal).
-.IT 6.7.2.2
-It shall be an error if the result of any operation on integer
-operands is not performed according to the mathematical
-rules for integer arithmetic.
-.IS
-The reaction depends on the EM implementation:
-.I1
-\*(ONerror detected if
-.EQ
- (result >= 32768) or (result < -32768).
-.EN
-(integer overflow, trap 3, non-fatal).
-Note that if the result is -32768 the use of this value in further operations
-may cause an error.
-.br
-\*(OFnot detected.
-.I2
-not detected.
-.IT 6.8.3.5
-It shall be an error if none of the case-constants is equal to the value of the
-case-index upon entry to the case-statement.
-.IS
-This error is detected (case error, trap 20, fatal).
-.IT 6.8.3.9
-It shall be an error if the final-value of a for-statement is not
-assignment-compatible with the control-variable when the
-initial-value is assigned to the control-variable.
-.IS
-It is detected if the control variable leaves
-its allowed range of values while stepping
-from initial to final value.
-This is equivalent with the requirements if the
-for-statement is not terminated before
-the final value is reached.
-.IT 6.9.2
-It shall be an error if the sequence of characters read looking for an integer does not
-form a signed-integer as specified in 6.1.5.
-.IS
-This error is detected (digit expected, trap 105, non-fatal).
-.IT 6.9.2
-It shall be an error if the sequence of characters read looking for a real does not
-form a signed-number as specified in 6.1.5.
-.IS
-This error is detected (digit expected, trap 105, non-fatal).
-.IT 6.9.2
-It shall be an error if read is applied to f while f is undefined or
-not opened for reading.
-.IS
-This error is detected (see get(f)).
-.IT 6.9.4
-It shall be an error if write is applied to f while f is undefined or
-not opened for writing.
-.IS
-This error is detected (see put(f)).
-.IT 6.9.4
-It shall be an error if TotalWidth or FracDigits as specified in
-write or writeln procedure calls are less than one.
-.IS
-This error is not detected. Moreover, it is considered an extension to
-allow zero or negative values.
-.IT 6.9.6
-It shall be an error if page is applied to f while f is undefined or
-not opened for writing.
-.IS
-This error is detected (see put(f)).
-.CH "Extensions to the standard"
-.IS
-.ti -3
-1.~\
-Separate compilation.
-.sp
-The compiler is able to (separately) compile a collection of declarations,
-procedures and functions to form a library.
-The library may be linked with the main program, compiled later.
-The syntax of these modules is
-.EQ
- module = [constant-definition-part]
- [type-definition-part]
- [var-declaration-part]
- [procedure-and-function-declaration-part]
-.EN
-The compiler accepts a program or a module:
-.EQ
- unit = program | module
-.EN
-All variables declared outside a module must be imported
-by parameters, even the files input and output.
-Access to a variable declared in a module is only possible
-using the procedures and functions declared in that same module.
-By giving the correct procedure/function heading followed by the
-directive 'extern' you may use procedures and functions declared in
-other units.
-.sp
-.ti -3
-2.~\
-Assertions.
-.sp
-The Ack-Pascal compiler recognizes an additional statement, the assertion.
-Assertions can be used as an aid in debugging and documentation.
-The syntax is:
-.EQ
- assertion = 'assert' Boolean-expression
-.EN
-An assertion is a simple-statement, so
-.EQ
- simple-statement = [assignment-statement |
- procedure-statement |
- goto-statement |
- assertion
- ]
-.EN
-An assertion causes an error if the Boolean-expression is false.
-That is its only purpose.
-It does not change any of the variables, at least it should not.
-Therefore, do not use functions with side-effects in the Boolean-expression.
-If the a-option is turned off, then assertions are skipped by the
-compiler. 'assert' is not a word-symbol (keyword) and may be used as identifier.
-However, assignment to a variable and calling of a procedure with that name will be impossible.
-.sp
-.ti -3
-3.~\
-Additional procedures.
-.sp
-Three additional standard procedures are available:
-.IS
-.IS
-.ti -8
-halt:~~~a call of this procedure is equivalent to jumping to the
-end of your program. It is always the last statement executed.
-The exit status of the program may be supplied
-as optional argument.
-.ti -8
-release:
-.ti -8
-mark:~~~for most applications it is sufficient to use the heap as second stack.
-Mark and release are suited for this type of use, more suited than dispose.
-mark(p), with p of type pointer, stores the current value of the
-heap pointer in p. release(p), with p initialized by a call
-of mark(p), restores the heap pointer to its old value.
-All the heap objects, created by calls of new between the call of
-mark and the call of release, are removed and the space they used
-can be reallocated.
-Never use mark and release together with dispose!
-.sp
-.in -10
-.ti -3
-4.~\
-UNIX interfacing.
-.sp
-If the c-option is turned on, then some special features are available
-to simplify an interface with the UNIX environment.
-First of all, the compiler allows you to use a different type
-of string constants.
-These string constants are delimited by double quotes ('"').
-To put a double quote into these strings, you must repeat the double quote,
-like the single quote in normal string constants.
-These special string constants are terminated by a zero byte (chr(0)).
-The type of these constants is a pointer to a packed array of characters,
-with lower bound 1 and unknown upper bound.
-.br
-Secondly, the compiler predefines a new type identifier 'string' denoting
-this just described string type.
-.PP
-The only thing you can do with these features is declaration of
-constants and variables of type 'string'.
-String objects may not be allocated on the heap and string pointers
-may not be de-referenced.
-Still these strings are very useful in combination with external routines.
-The procedure write is extended to print these zero-terminated strings correctly.
-.sp
-.ti -3
-5.~\
-Double length (32 bit) integers.
-.sp
-If the d-option is turned on, then the additional type 'long' is known to the compiler.
-Long variables have integer values in the range -2147483647..+2147483647.
-Long constants may be declared.
-It is not allowed to form subranges of type long.
-All operations allowed on integers are also
-allowed on longs and are indicated by the same
-operators: '+', '-', '*', '/', 'div', 'mod'.
-The procedures read and write have been extended to handle long arguments correctly.
-The default width for longs is 11.
-The standard procedures 'abs' and 'sqr' have been extended to work on long arguments.
-Conversion from integer to long, long to real,
-real to long and long to integer are automatic, like the conversion from integer to real.
-These conversions may cause a
-.IS
-conversion error, trap 10, non-fatal
-.IE
-This last error is only detected in implementation 1, with 'test on'.
-Note that all current implementations use target
-machine floating point instructions
-to perform some of the long operations.
-.sp
-.ti -3
-6.~\
-Underscore as letter.
-.sp
-The character '_' may be used in forming identifiers, if the u-option is turned on.
-.sp
-.ti -3
-7.~\
-Zero field width in write.
-.sp
-Zero or negative TotalWidth arguments to write
-are allowed.
-No characters are written for character, string or Boolean type arguments then.
-A zero or negative FracDigits argument for fixed-point representation of reals causes the
-fraction and the character '.' to be suppressed.
-.sp
-.ti -3
-8.~\
-Alternate symbol representation.
-.sp
-The comment delimiters '(*' and '*)' are recognized and treated like '{' and '}'.
-The other alternate representations of symbols are not recognized.
-.CH "Deviations from the standard"
-Ack-Pascal deviates from the (March 1980) standard proposal in the following ways:
-.IS
-.ti -3
-1.~\
-Only the first 8 characters of identifiers are significant,
-as requested by all standard proposals prior to March 1980.
-In that proposal, however, the sentence
-.DS
-"A conforming program should not have its meaning altered
-by the truncation of its identifiers to eight characters
-or the truncation of its labels to four digits."
-.DE
-is missing.
-.sp
-.ti -3
-2.~\
-The character sequences 'procedur', 'procedur8', 'functionXyZ' etc. are
-all erroneously classified as the word-symbols 'procedure' and 'function'.
-.sp
-.ti -3
-3.~\
-Standard procedures and functions are not allowed as parameters in Ack-Pascal,
-conforming to all previous standard proposals.
-You can obtain the same result with negligible loss of performance
-by declaring some user routines like:
-.EQ
- function sine(x:real):real;
- begin
- sine:=sin(x)
- end;
-.EN
-.sp
-.ti -3
-4.~\
-The scope of identifiers and labels should start at the beginning of the block
-in which these identifiers or labels are declared.
-The Ack-Pascal compiler, as most other one pass compilers, deviates in this respect,
-because the scope of variables and labels start
-at their defining-point.
-.CH "Compiler options"
-Some options of the compiler may be controlled by using "{$....}".
-Each option consists of a lower case letter followed by +, - or an unsigned
-number.
-Options are separated by commas.
-The following options exist:
-.in 8
-.sp
-.ti -8
-a~+/-~~~\
-this option switches assertions on and off.
-If this option is on, then code is included to test these assertions
-at run time. Default +.
-.sp
-.ti -8
-c~+/-~~~\
-this option, if on, allows you to use C-type string constants
-surrounded by double quotes.
-Moreover, a new type identifier 'string' is predefined.
-Default -.
-.sp
-.ti -8
-d~+/-~~~\
-this option, if on, allows you to use variables of type 'long'.
-Default -.
-.sp
-.ti -8
-f~<num>~\
-the size of reals can be changed by this option. <num> should be specified in 8-bit bytes.
-The default in most implementations is 8, but other values can
-occur.
-.sp
-.ti -8
-i~<num>~\
-with this flag the setsize for a set of integers can be
-manipulated.
-The number must be the number of bits per set.
-The default value is 16, just fitting in one word on the PDP and many other minis.
-.sp
-.ti -8
-l~+/-~~~\
-if + then code is inserted to keep track of the source line number.
-When this flag is switched on and off, an incorrect line number may appear
-if the error occurs in a part of your program for which this flag is off.
-These same line numbers are used for the profile, flow and count options
-of the EM interpreter em [6].
-Default +.
-.sp
-.ti -8
-p~<num>~the size of pointers can be changed by this option. <num> should be specified in bytes.
-Default 2 in most implementations.
-.sp
-.ti -8
-r~+/-~~~\
-if + then code is inserted to check subrange variables against
-lower and upper subrange limits.
-Default +.
-.sp
-.ti -8
-s~+/-~~~\
-if + then the compiler will hunt for places in your program
-where non-standard features are used, and for each place found
-it will generate a warning. Default -.
-.sp
-.ti -8
-t~+/-~~~\
-if + then each time a procedure is entered, the routine 'procentry'
-is called.
-The compiler checks this flag just before the first symbol that follows the
-first 'begin' of the body of the procedure.
-Also, when the procedure exits, then the procedure 'procexit' is called
-if the t flag is on just before the last 'end' of the procedure body.
-Both 'procentry' and 'procexit' have a packed array of 8 characters as a parameter.
-Default procedures are present in the run time library.
-Default -.
-.sp
-.ti -8
-u~+/-~~~\
-if + then the character '_' is treated like a lower case letter,
-so that it may be used in identifiers.
-Procedure and function identifiers starting with an underscore may cause problems,
-because they may collide with library routine names.
-Default -.
-.in 0
-.sp
-Seven of these flags (c, d, f, i, p, s and u) are only effective when they appear
-before the 'program' symbol. The others may be switched on and off.
-.PP
-A second method of passing options to the compiler ia available.
-This method uses the file on which the compact EM code will be written.
-The compiler starts reading from this file scanning for options
-in the same format as used normally, except for the comment delimiters and
-the dollar sign.
-All options found on the file override the options set in your program.
-Note that the compact code file must always exist before the compiler is called.
-.PP
-The user interface program \fIack\fP[4]
-takes care of creating this file normally
-and also writes one of its options onto this file.
-The user can specify, for instance, without changing any character in its
-Pascal program, that the compiler must include code for
-procedure/function tracing.
-.PP
-Another very powerful debugging tool is the knowledge that inaccessible
-statements and useless tests are removed by the EM optimizer.
-For instance, a statement like:
-.sp
-.nf
- if debug then
- writeln('initialization done');
-.fi
-.sp
-is completely removed by the optimizer if debug is a constant with
-value false.
-The first line is removed if debug is a constant with value true.
-Of course, if debug is a variable nothing can be removed.
-.PP
-A disadvantage of Pascal, the lack of preinitialized data, can be
-diminished by making use of the possibilities of the EM optimizer.
-For instance, initializing an array of reserved words is sometimes
-optimized into 3 EM instructions. To maximize this effect you must initialize
-variables as much as possible in order of declaration and array entries
-in order of decreasing index.
-.CH "References"
-.in +5
-.ti -5
-[1]~~\
-ISO standard proposal ISO/TC97/SC5-N462, dated February 1979.
-The same proposal, in slightly modified form, can be found in:
-A.M.Addyman e.a., "A draft description of Pascal",
-Software, practice and experience, May 1979.
-An improved version, received March 1980,
-is followed as much as possible for the
-current Ack-Pascal.
-.sp
-.ti -5
-[2]~~\
-A.S.Tanenbaum, J.W.Stevenson, Hans van Staveren, E.G.Keizer,
-"Description of a machine architecture for use with block structured languages",
-Informatica rapport IR-81.
-.sp
-.ti -5
-[3]~~\
-W.S.Brown, S.I.Feldman, "Environment parameters and basic functions
-for floating-point computation",
-Bell Laboratories CSTR #72.
-.sp
-.ti -5
-[4]~~\
-UNIX manual ack(I).
-.sp
-.ti -5
-[5]~~\
-UNIX manual ld(I).
-.sp
-.ti -5
-[6]~~\
-UNIX manual em(I).
-.sp
-.ti -5
-[7]~~\
-UNIX manual libpc(VII)
-.sp
-.ti -5
-[8]~~\
-UNIX manual pc_prlib(VII)
+++ /dev/null
-.TL
-Internal documentation on the peephole optimizer
-.br
-from the Amsterdam Compiler Kit
-.NH 1
-Introduction
-.PP
-Part of the Amsterdam Compiler Kit is a program to do
-peephole optimization on an EM program.
-The optimizer scans the program to match patterns from a table
-and if found makes the optimization from the table,
-and with the result of the optimization
-it tries to find yet another optimization
-continuing until no more optimizations are found.
-.PP
-Furthermore it does some optimizations that can not be called
-peephole optimizations for historical reasons,
-like branch chaining and the deletion of unreachable code.
-.PP
-The peephole optimizer consists of three parts
-.IP 1)
-A driving table
-.IP 2)
-A program translating the table to internal format
-.IP 3)
-C code compiled with the table to make the optimizer proper
-.PP
-In this document the table format, internal format and
-data structures in the optimizer will be explained,
-plus a hint on what the code does where it might not be obvious.
-It is a simple program mostly.
-.NH 1
-Table format
-.PP
-The driving table consists of pattern/replacement pairs,
-in principle one per line,
-although a line starting with white space is considered
-a continuation line for the previous.
-The general format is:
-.DS
-optimization : pattern ':' replacement '\en'
-.sp
-pattern : EMlist optional_boolean_expression
-.sp
-replacement : EM_plus_operand_list
-.DE
-Example of a simple one
-.DS
-loc stl $1==0 : zrl $2
-.DE
-There is no real limit for the length of the pattern or the replacement,
-the replacement might even be longer than the pattern,
-and expressions can be made arbitrarily complicated.
-.PP
-The expressions in the table are made of the following pieces:
-.IP -
-Integer constants
-.IP -
-$\fIn\fP, standing for the operand of the \fIn\fP'th EM
-instruction in the pattern,
-undefined if that instruction has no operand.
-.IP -
-w, standing for the wordsize of the code optimized.
-.IP -
-p, for the pointersize.
-.IP -
-defined(expr), true if expression is defined
-.IP -
-samesign(expr,expr), true if expressions have the same sign.
-.IP -
-sfit(expr,expr), ufit(expr,expr),
-true if the first expression fits signed or unsigned in the number
-of bits given in the second expression.
-.IP -
-rotate(expr,expr),
-first expression rotated left the number of bits given by the second expression.
-.IP -
-notreg(expr),
-true if the local with the expression as number is not a candidate to put
-in a register.
-.IP -
-rom(\fIn\fP,expr), contents of the rom descriptor at index expr that
-is associated with the global label that should be the argument of
-the \fIn\fP'th EM instruction.
-Undefined if such a thing does not exist.
-.PP
-The usual arithmetic operators may be used on integer values,
-if any operand is undefined the expression is undefined,
-except for the defined() function above.
-An undefined expression used for its truth value is false.
-All arithmetic on local label operands is forbidden,
-only things allowed are tests for equality.
-Arithmetic on global labels makes sense,
-i.e. one can add a global label and a constant,
-but not two global labels.
-.PP
-In the table one can use five additional EM instructions in patterns.
-These are:
-.IP lab
-Stands for a local label
-.IP LLP
-Load Local Pointer, translates into a
-.B lol
-or into a
-.B ldl
-depending on the relationship between wordsize and pointersize.
-.IP LEP
-Load External Pointer, translates into a
-.B loe
-or into a
-.B lde .
-.IP SLP
-Store Local Pointer,
-.B stl
-or
-.B sdl .
-.IP SEP
-Store External Pointer,
-.B ste
-or
-.B sde .
-.PP
-There is only one peephole optimizer,
-so the substitutions to be made for the last four instructions
-are made at run time before the first optimizations are made.
-.NH 1
-Internal format
-.PP
-The translating program,
-.I mktab
-converts the table into an array of bytes where all
-patterns follow unaligned.
-Format of a pattern is:
-.IP 1)
-One byte for high byte of hash value,
-will be explained later on.
-.IP 2)
-Two bytes for the index of the next pattern in a chain.
-.IP 3)
-An integer\u*\d,
-.FS
-* An integer is encoded as a byte when less than 255,
-otherwise as a byte containing 255 followed by two
-bytes with the real value.
-.FE
-pattern length.
-.IP 4)
-The list of pattern opcodes, one per byte.
-.IP 5)
-An integer expression index, 0 if not used.
-.IP 6)
-An integer, replacement length.
-.IP 7)
-A list of pairs consisting of a one byte opcode and an integer
-expression index.
-.PP
-The expressions are kept in an array of triples,
-implementing a binary tree.
-The
-.I mktab
-program tries to minimize the number of triples by reusing
-duplicates and even reverses the operands of commutative operators
-when doing so would spare a triple.
-.NH 1
-A tour through the sources
-.PP
-Now we will walk through the sources and note things of interest.
-.NH 2
-The header files
-.PP
-The header files are the place where data structures and options reside.
-.NH 3
-alloc.h
-.PP
-In the header file alloc.h several defines can be used to select various
-kinds of core allocation schemes.
-This is important on small machines like the PDP-11 since a complete
-procedure must be in core at the same space,
-and the peephole optimizer should not be the limiting factor in
-determining the maximum size of procedures if possible.
-Options are:
-.IP -
-USEMALLOC, standard malloc() and free() are used instead of the own
-core allocation package.
-Not recommended unless the own package does not work on some bizarre
-machine.
-.IP -
-COREDEBUG, prints large amounts of information about core management.
-Better not define it unless you change the code and it stops working.
-.IP -
-SEPID, if you define this you will get an extra procedure that will
-go through a lot of work to scrape the last bytes together if the
-system won't provide more.
-This is not a good idea if memory is scarce and code and data reside
-in the same spaces, since the room used by the procedure might well
-be more than the room saved.
-.IP -
-STACKROOM, number of shorts used in stack space.
-This is used if memory is scarce and stack space and data space are
-different.
-On the PDP-11 a UNIX process starts with an 8K stack segment which
-cannot be transferred to the data segment.
-Under these conditions one can use a lot of the stack space for storage.
-.NH 3
-assert.h
-.PP
-Just defines the assert macro.
-When compiled with -DNDEBUG all asserts will be off.
-.NH 3
-ext.h
-.PP
-Gives external definitions of variables used by more than one module.
-.NH 3
-line.h
-.PP
-Defines the structures used to keep instructions,
-one structure per line of EM code,
-and the structure to keep arguments of pseudos,
-one structure per argument.
-Both structures essentially contain a pointer to the next,
-a type,
-and a union containing information depending on the type.
-Core is allocated only for the part of the union used.
-.PP
-The
-.I
-struct line
-.R
-has a very compact encoding for small integers,
-they are encoded in the type field.
-On the PDP-11 this gives a line structure of only 4 bytes for most
-instructions.
-.NH 3
-lookup.h
-.PP
-Contains definition of the struct used for symbol table management,
-global labels and procedure names are kept in one table.
-.NH 3
-optim.h
-.PP
-If one defines the DIAGOPT option in this header file,
-for every optimization performed a number is written on stderr.
-The number gives the number of the pattern in the table
-or one of the four special numbers in this header file.
-.NH 3
-param.h
-.PP
-Contains one settable option,
-LONGOFF.
-If this is not defined the optimizer can only optimize programs
-with wordsize 2 and pointersize 2.
-Set this only if it must be run on a Z80 or something pathetic like that.
-.PP
-Other defines here should not be touched.
-.NH 3
-pattern.h
-.PP
-Contains defines of indices in a pattern,
-definition of the expression triples,
-definitions of the various expression operators
-and definition of the result struct where expression results are put.
-.PP
-This header file is the main one that is also included by
-.I mktab .
-.NH 3
-proinf.h
-.PP
-This one contains definitions
-for the local label table structs
-and for the struct where all information for one procedure is kept.
-This is in one struct so it can be saved easily when recursive
-procedures have to be resolved.
-.NH 3
-types.h
-.PP
-Collection of typedefs to be used by almost all modules.
-.NH 2
-The C code itself.
-.PP
-The C code will now be the center of our attention.
-We will make a walk through the sources and we will try
-to follow the sources in a logical order.
-So we will start at
-.NH 3
-main.c
-.PP
-The main.c module contains the main() function.
-Here nothing spectacular happens,
-only thing of interest is the handling of flags:
-.IP -L
-This is an instruction to the peephole optimizer to perform
-one of its auxiliary functions, the generation of a library module.
-This makes the peephole optimizer write its output on a temporary file,
-and at the end making the real output by first generating a list
-of exported symbols and then copying the temporary file behind it.
-.IP -n
-Disables all optimization.
-Only thing the optimizer does now is filling in the blank after the
-.I END
-pseudo and resolving recursive procedures.
-.PP
-The place where main() is left is the call to getlines() which brings
-us to
-.NH 3
-getline.c
-.PP
-This module reads the EM code and constructs a list of
-.I
-struct line
-.R
-records,
-linked together backwards,
-i.e. the first instruction read is the last in the list.
-Pseudos are handled here also,
-for most pseudos this just means that a chain of argument records
-is linked into the linked line list but some pseudos get special attention:
-.IP exc
-This pseudo is acted upon right away.
-Lines read are shuffled around according to instruction.
-.IP mes
-Some messages are acted upon.
-These are:
-.RS
-.IP ms_err 8
-The input is drained, just in case it is a pipe.
-After that the optimizer exits.
-.IP ms_opt
-The do not optimize flag is set.
-Acts just like -n on the command line.
-.IP ms_emx
-The word- and pointersize are read,
-complain if we are not able to handle this.
-.IP ms_reg
-We take notice of the offset of this local.
-See also comments in the description of peephole.c
-.RE
-.IP pro
-A new procedure starts, if we are already in one save the status,
-else process collected input.
-Collect information about this procedure and if already in a procedure
-call getlines() recursively.
-.IP end
-Process collected input.
-.PP
-The phrase "process collected input" is used twice,
-which brings us to
-.NH 3
-process.c
-.PP
-This module contains the entry point process() which is called at any
-time the collected input must be processed.
-It calls a variety of other routines to get the real work done.
-Routines in this module are in chronological order:
-.IP symknown 12
-Marks all symbols seen until now as known,
-i.e. it is now known whether their scope is local or global.
-This information is used again during output.
-.IP symvalue
-Runs through the chain of pseudos to give values to data labels.
-This needs an extra pass.
-It cannot be done during the getlines pass, since an
-.B exc
-pseudo could destroy things.
-Nor can it be done during the backward pass since it is impossible
-to do good fragment numbering backward.
-.IP checklocs
-Checks whether all local labels referenced are defined.
-It needs to be sure about this since otherwise the
-semi global optimizations made cannot work.
-.IP relabel
-This routine finds the final destination for each label in the procedure.
-Labels followed by unconditional branches or other labels are marked during
-the peephole fase and this leeds to chains of identical labels.
-These chains are followed here, and in the local label table each label
-has associated with it its replacement label, after this procedure is run.
-Care is taken in this routine to prevent a loop in the program to
-cause the optimizer to loop.
-.IP cleanlocals
-This routine empties the local label table after everything
-is processed.
-.PP
-But before this can all be done,
-the backward linked list of instructions first has to be reversed,
-so here comes
-.NH 3
-backward.c
-.PP
-The routine backward has a number of functions:
-.IP -
-It reverses the backward linked list, making two forward linked lists,
-one for the instructions and one for the pseudos.
-.IP -
-It notes the last occurrence of data labels in the backward linked list
-and puts it in the global symbol table.
-This is of course the first occurence in the procedure.
-This information is needed to decide whether the symbols are global
-or local to this module.
-.IP -
-It decides about the fragment boundaries of data blocks.
-Fragments are numbered backwards starting at 3.
-This is done to be able to make the type of an expression
-containing a symbol equal to its fragment.
-This type can then not clash with the types integer and local label.
-.IP -
-It allocates a rom buffer to every data label with a rom behind
-it, if that rom contains only plain integers at the start.
-.PP
-The first thing done after process() has called backward() and some
-of its own little routines is a call to the real routine,
-the one that does the work the program was written for
-.NH 3
-peephole.c
-.PP
-The first routines in peephole.c
-implement a linked list for the offsets of local variables
-that are candidates for a register implementation.
-Several patterns use the notreg() function,
-since it is forbidden to combine a load of that variable
-with the load of another and
-it is not allowed to take the address of that variable.
-.PP
-The routine peephole hashes the patterns the first time it is called
-after which it doesn't do much more than calling optimize.
-But first hashpatterns().
-.PP
-The patterns are hashed at run time of the optimizer because of
-the
-.B LLP ,
-.B LEP ,
-.B SLP
-and
-.B SEP
-instructions added to the instruction set in this optimizer.
-These are first replaced everywhere in the table by the correct
-replacement after which the first three instructions of the
-pattern are hashed and the pattern is linked into one of the
-256 linked lists.
-There is a define CHK_HASH in this module that you
-can set if you do not trust the randomness of the hashing
-function.
-.PP
-The attention now shifts to optimize().
-This routine calls basicblock() for every piece of code between two labels.
-It also notes which labels have another label or a branch behind them
-so the relabel() routine from process.c can do something with that.
-.PP
-Basicblock() keeps making passes over its basic block
-until no more optimizations are found.
-This might be inefficient if there is a long basicblock with some
-deep recursive optimization in one part of it.
-The entire basic block is then scanned a lot of times just for
-that one piece.
-The alternative is backing up after making an optimization and running
-through the same code again, but that is difficult
-in a single linked list.
-.PP
-It hashes instructions and calls trypat() for every pattern that has
-a full hash value match,
-i.e. lower byte and upper byte equal.
-Longest pattern is tried first.
-.PP
-Trypat() checks length and opcodes of the pattern.
-If correct it fills the iargs[] array with argument values
-and calculates the expression.
-If that is also correct the work shifts to tryrepl().
-.PP
-Tryrepl() generates the list of replacement instructions,
-links it into the list and returns true.
-Why then the name tryrepl() if it always succeeds?
-Well, there is a mechanism in the optimizer,
-unused until today that makes it possible to do optimizations that cannot
-be described by the table.
-It is possible to give a number as a replacement which will cause the
-optimizer to call a routine special() to do some work.
-This routine might decide not to do an optimization and return false.
-.PP
-The last routine that is called from process() is putline()
-to write the optimized code, bringing us to
-.NH 3
-putline.c
-.PP
-The major part of putline.c is the standard set of routines
-that makes EM compact code.
-The extra functions performed are:
-.IP -
-For every occurence of a global symbol it might be necessary to
-output a
-.B exa ,
-.B exp ,
-.B ina
-or
-.B inp
-pseudo instruction.
-That task is performed.
-.IP -
-The
-.B lin
-instructions are optimized here,
-.B lni
-instructions added for
-.B lin
-instructions and superfluous
-.B lin
-instructions deleted.
-
+++ /dev/null
-.TL
-Addition of register variables to an existing table.
-.NH 1
-Introduction
-.PP
-This is a short description of the newest feature in the
-table driven code generator for the Amsterdam Compiler Kit.
-It describes how to add register variables to an existing table.
-This assumes you have the distribution of October 1983 or later.
-It is not clear whether you should read this when starting with
-a table for a new machine,
-or whether you should wait till the table is well debugged already.
-.NH 1
-Modifications to the table itself.
-.NH 2
-Register section
-.PP
-You can add just before the properties of the register one
-of the following:
-.IP - 2
-regvar
-.IP -
-regvar ( pointer )
-.IP -
-regvar ( loop )
-.IP -
-regvar ( float )
-.LP
-All register variables of one type must be of the same size,
-and they may have no subregisters.
-.NH 2
-Codesection
-.PP
-.IP - 2
-Two pseudo functions are added to the list allowed inside expressions:
-.RS
-.IP 1) 3
-inreg ( expr ) has as a parameter the offset of a local,
-and returns 0,1 or 2:
-.RS
-.IP 2: 3
-if the variable is in a register.
-.IP 1:
-if the variable could be in a register but isn't.
-.IP 0:
-if the variable cannot be in a register.
-.RE
-.IP 2)
-regvar ( expr ) returns the register associated with the variable.
-Undefined if it is not in a register.
-So regvar ( expr ) is defined if and only if inreg (expr ) == 2.
-.RE
-.IP -
-It is now possible to remove() a register expression,
-this is of course needed for a store into a register local.
-.IP -
-The return out of a procedure may now involve register restores,
-so the special word 'return' in the table will invoke a user defined
-function.
-.NH 1
-Modifications to mach.c
-.PP
-If register variables are used in a table, the program
-.I cgg
-will define the word REGVARS during compilation of the sources.
-So the following functions described here should be bracketed
-by #ifdef REGVARS and #endif.
-.IP - 2
-regscore(off,size,typ,freq,totyp) long off;
-.br
-This function should assign a score to a register variable,
-the score should preferably be the estimated number of bytes
-gained when it is put in a register.
-Off and size are the offset and size of the variable,
-typ is the type, that is reg_any, reg_pointer, reg_loop or reg_float.
-Freq is the number of times it occurs statically, and totyp
-is the type of the register it is planned to go into.
-.br
-Keep in mind that the gain should be net, that is the cost for
-register save/restore sequences and the cost of initialisation
-in the case of parameters should already be included.
-.IP -
-i_regsave()
-.br
-This function is called at the start of a procedure, just before
-register saves are done.
-It can be used to initialise some variables if needed.
-.IP -
-f_regsave()
-.br
-This function is called at end of the register save sequence.
-It can be used to do the real saving if multiple register move
-instructions are available.
-.IP -
-regsave(regstr,off,size) char *regstr; long off;
-.br
-Should either do the real saving or set up a table to have
-it done by f_regsave.
-Note that initialisation of parameters should also be done,
-or planned here.
-.IP -
-regreturn()
-.br
-Should restore saved registers and return.
-The function result is already in the function return area by now.
-.NH 1
-Examples
-.PP
-Here are some examples out of the PDP 11 table
-.DS
-lol inreg($1)==2| | | regvar($1) | |
-
-lil inreg($1)==2| | | {regdef2, regvar($1)} | |
-
-stl inreg($1)==2| xsource2 |
- remove(regvar($1))
- move(%[1],regvar($1)) | | |
-
-inl inreg($1)==2| | remove(regvar($1))
- "inc %(regvar($1)%)"
- setcc(regvar($1)) | | |
-.DE
-.NH 1
-Afterthoughts.
-.PP
-At the time of this writing the tables for the PDP 11 and the M68000 and
-the VAX are converted, in all cases the two byte wordsize versions.
-No big problems have occurred, but experience has shown that it is
-necessary to check your table carefully for all patterns with locals in them
-because if you forget one code will be generated by that one coderule
-to use the memoryslot the local is not in.
-
+++ /dev/null
-.RP
-.ND
-.nr LL 78m
-.tr ~
-.ds as *
-.TL
-A Practical Tool Kit for Making Portable Compilers
-.AU
-Andrew S. Tanenbaum
-Hans van Staveren
-E. G. Keizer
-Johan W. Stevenson
-.AI
-Mathematics Dept.
-Vrije Universiteit
-Amsterdam, The Netherlands
-.AB
-The Amsterdam Compiler Kit is an integrated collection of programs designed to
-simplify the task of producing portable (cross) compilers and interpreters.
-For each language to be compiled, a program (called a front end)
-must be written to
-translate the source program into a common intermediate code.
-This intermediate code can be optimized and then either directly interpreted
-or translated to the assembly language of the desired target machine.
-The paper describes the various pieces of the tool kit in some detail, as well
-as discussing the overall strategy.
-.sp
-Keywords: Compiler, Interpreter, Portability, Translator
-.sp
-CR Categories: 4.12, 4.13, 4.22
-.sp 12
-Author's present addresses:
- A.S. Tanenbaum, H. van Staveren, E.G. Keizer: Mathematics
- Dept., Vrije Universiteit, Postbus 7161, 1007 MC Amsterdam,
- The Netherlands
-
- J.W. Stevenson: NV Philips, S&I, T&M, Building TQ V5, Eindhoven,
- The Netherlands
-.AE
-.NH 1
-Introduction
-.PP
-As more and more organizations acquire many micro- and minicomputers,
-the need for portable compilers is becoming more and more acute.
-The present situation, in which each hardware vendor provides its own
-compilers -- each with its own deficiencies and extensions, and none of them
-compatible -- leaves much to be desired.
-The ideal situation would be an integrated system containing a family
-of (cross) compilers, each compiler accepting a standard source language and
-producing code for a wide variety of target machines.
-Furthermore, the compilers should be compatible, so programs written in
-one language can call procedures written in another language.
-Finally, the system should be designed so as to make adding new languages
-and new machines easy.
-Such an integrated system is being built at the Vrije Universiteit.
-Its design and implementation is the subject of this article.
-.PP
-Our compiler building system, which is called the "Amsterdam Compiler Kit"
-(ACK), can be thought of as a "tool kit."
-It consists of a number of parts that can be combined to form compilers
-(and interpreters) with various properties.
-The tool kit is based on an idea (UNCOL) that was first suggested in 1960
-[7], but which never really caught on then.
-The problem which UNCOL attempts to solve is how to make a compiler for
-each of
-.I N
-languages on
-.I M
-different machines without having to write
-.I N
-x
-.I M
-programs.
-.PP
-As shown in Fig. 1, the UNCOL approach is to write
-.I N
-"front ends," each
-of which translates one source language to a common intermediate language,
-UNCOL (UNiversal Computer Oriented Language), and
-.I M
-"back ends," each
-of which translates programs in UNCOL to a specific machine language.
-Under these conditions, only
-.I N
-+
-.I M
-programs must be written to provide all
-.I N
-languages on all
-.I M
-machines, instead of
-.I N
-x
-.I M
-programs.
-.PP
-Various researchers have attempted to design a suitable UNCOL
-[2,8], but none of these have become popular.
-It is our belief that previous attempts have failed because they have been
-too ambitious, that is, they have tried to cover all languages
-and all machines using a single UNCOL.
-Our approach is more modest: we cater only to algebraic languages
-and machines whose memory consists of 8-bit bytes, each with its own address.
-Typical languages that could be handled include
-Ada, ALGOL 60, ALGOL 68, BASIC, C, FORTRAN,
-Modula, Pascal, PL/I, PL/M, PLAIN, and RATFOR,
-whereas COBOL, LISP, and SNOBOL would be less efficient.
-Examples of machines that could be included are the Intel 8080 and 8086,
-Motorola 6800, 6809, and 68000, Zilog Z80 and Z8000, DEC PDP-11 and VAX,
-and IBM 370 but not the Burroughs 6700, CDC Cyber, or Univac 1108 (because
-they are not byte-oriented).
-With these restrictions, we believe the old UNCOL idea can be used as the
-basis of a practical compiler-building system.
-.KF
-.sp 15P
-.ce 1
-Fig. 1. The UNCOL model.
-.sp
-.KE
-.NH 1
-An Overview of the Amsterdam Compiler Kit
-.PP
-The tool kit consists of eight components:
-.sp
- 1. The preprocessor.
- 2. The front ends.
- 3. The peephole optimizer.
- 4. The global optimizer.
- 5. The back end.
- 6. The target machine optimizer.
- 7. The universal assembler/linker.
- 8. The utility package.
-.sp
-.PP
-A fully optimizing compiler,
-depicted in Fig. 2, has seven cascaded phases.
-Conceptually, each component reads an input file and writes a
-transformed output file to be used as input to the next component.
-In practice, some components may use temporary files to allow multiple
-passes over the input or internal intermediate files.
-.KF
-.sp 12P
-.ce 1
-Fig. 2. Structure of the Amsterdam Compiler Kit.
-.sp
-.KE
-.PP
-In the following paragraphs we will briefly describe each component.
-After this overview, we will look at all of them again in more detail.
-A program to be compiled is first fed into the (language independent)
-preprocessor, which provides a simple macro facility,
-and similar textual facilties.
-The preprocessor's output is a legal program in one of the programming
-languages supported, whereas the input is a program possibly augmented
-with macros, etc.
-.PP
-This output goes into the appropriate front end, whose job it is to
-produce intermediate code.
-This intermediate code (our UNCOL) is the machine language for a simple
-stack machine called EM (Encoding Machine).
-A typical front end might build a parse tree from the input, and then
-use the parse tree to generate EM code, which is similar to reverse Polish.
-In order to perform this work, the front end has to maintain tables of
-declared variables, labels, etc., determine where to place the
-data structures in memory, and so on.
-.PP
-The EM code generated by the front end is fed into the peephole optimizer,
-which scans it with a window of a few instructions, replacing certain
-inefficient code sequences by better ones.
-Such a search is important because EM contains instructions to handle
-numerous important special cases efficiently
-(e.g., incrementing a variable by 1).
-It is our strategy to relieve the front ends of the burden of hunting for
-special cases because there are many front ends and only one peephole
-optimizer.
-By handling the special cases in the peephole optimizer,
-the front ends become simpler, easier to write and easier to maintain.
-.PP
-Following the peephole optimizer is a global optimizer [5], which
-unlike the peephole optimizer, examines the program as a whole.
-It builds a data flow graph to make possible a variety of
-global optimizations,
-among them, moving invariant code out of loops, avoiding redundant
-computations, live/dead analysis and eliminating tail recursion.
-Note that the output of the global optimizer is still EM code.
-.PP
-Next comes the back end, which differs from the front ends in a
-fundamental way.
-Each front end is a separate program, whereas the back end is a single
-program that is driven by a machine dependent driving table.
-The driving table for a specific machine tells how the EM code is mapped
-onto the machine's assembly language.
-Although a simple driving table might just macro expand each EM instruction
-into a sequence of target machine instructions, a much more sophisticated
-translation strategy is normally used, as described later.
-For speed, the back end does not actually read in the driving table at run time.
-Instead, the tables are compiled along with the back end in advance, resulting
-in one binary program per machine.
-.PP
-The output of the back end is a program in the assembly language of some
-particular machine.
-The next component in the pipeline reads this program and performs peephole
-optimization on it.
-The optimizations performed here involve idiosyncracies
-of the target machine that cannot be performed in the machine-independent
-EM-to-EM peephole optimizer.
-Typically these optimizations take advantage of special instructions or special
-addressing modes.
-.PP
-The optimized target machine assembly code then goes into the final
-component in the pipeline, the universal assembler/linker.
-This program assembles the input to object format, extracting routines from
-libraries and including them as needed.
-.PP
-The final component of the tool kit is the utility package, which contains
-various test programs, interpreters for EM code,
-EM libraries, conversion programs, and other aids for the implementer and
-user.
-.NH 1
-The Preprocessor
-.PP
-The function of the preprocessor is to extend all the programming languages
-by adding certain generally useful facilities to them in a uniform way.
-One of these is a simple macro system, in which the user can give names to
-character strings.
-The names can be used in the program, with the knowledge that they will be
-macro expanded prior to being input to the front end.
-Macros can be used for named constants, expanding short "procedures"
-in line, etc.
-.PP
-Another useful facility provided by the preprocessor is the ability to
-include compile-time libraries.
-On large projects, it is common to have all the declarations and definitions
-gathered together in a few files that are textually included in the programs
-by instructing the preprocessor to read them in, thus fooling the front end
-into thinking that they were part of the source program.
-.PP
-A third feature of the preprocessor is conditional compilation.
-The input program can be split up into labeled sections.
-By setting flags, some of the sections can be deleted by the preprocessor,
-thus allowing a family of slightly different programs to be conveniently stored
-on a single file.
-.NH 1
-The Front Ends
-.PP
-A front end is a program that converts input in some source language to a
-program in EM.
-At present, front ends
-exist or are in preparation for Pascal, C, and Plain, and are being considered
-for Ada, ALGOL 68, FORTRAN 77, and Modula 2.
-Each of the present front ends is independent of all the other ones,
-although a general-purpose, table-driven front end is conceivable, provided
-one can devise a way to express the semantics of the source language in the
-driving tables.
-The Pascal front end uses a top-down parsing algorithm (recursive descent),
-whereas the C and Plain front ends are bottom-up.
-.PP
-All front ends, independent of the language being compiled,
-produce a common intermediate code called EM, which is
-the assembly language for a simple stack machine.
-The EM machine is based on a memory architecture
-containing a stack for local variables, a (static) data area for variables
-declared in the outermost block and global to the whole program, and a heap
-for dynamic data structures.
-In some ways EM resembles P-code [6], but is more general, since it is
-intended for a wider class of languages than just Pascal.
-.PP
-The EM instruction set has been described elsewhere
-[9,10,11]
-so we will only briefly summarize it here.
-Instructions exist to:
-.sp
- 1. Load a variable or constant of some length onto the stack.
- 2. Store the top item on the stack in memory.
- 3. Add, subtract, multiply, divide, etc. the top two stack items.
- 4. Examine the top one or two stack items and branch conditionally.
- 5. Call procedures and return from them.
-.sp
-.PP
-Loads and stores come in several variations, corresponding to the most common
-programming language semantics, for example, constants, simple variables,
-fields of a record, elements of an array, and so on.
-Distinctions are also made between variables local to the current block
-(i.e., stack frame), those in the outermost block (static storage), and those
-at intermediate lexicographic levels, which are accessed by following the
-static chain at run time.
-.PP
-All arithmetic instructions have a type (integer, unsigned, real,
-pointer, or set) and an
-operand length, which may either be explicit or may be popped from the stack
-at run time.
-Monadic branch instructions pop an item from the stack and branch if it is
-less than zero, less than or equal to zero, etc.
-Dyadic branch instructions pop two items, compare them, and branch accordingly.
-.PP
-In addition to these basic EM instructions, there is a collection of special
-purpose instructions (e.g., to increment a local variable), which are typically
-produced from the simple ones by the peephole optimizer.
-Although the complete EM instruction set contains nearly 150 instructions,
-only about 60 of them are really primitive; the rest are simply abbreviations
-for commonly occurring EM instruction sequences.
-.PP
-Of particular interest is the way object sizes are parametrized.
-The front ends allow the user to indicate how many bytes an integer, real, etc.
-should occupy.
-Given this information, the front ends can allocate memory, determining
-the placement of variables within the stack frame.
-Sizes for primitive types are restricted to 8, 16, 32, 64, etc. bits.
-The front ends are also parametrized by the target machine's word length
-and address size so they can tell, for example, how many "load" instructions
-to generate to move a 32-bit integer.
-In the examples used henceforth,
-we will assume a 16-bit word size and 16-bit integers.
-.PP
-Since only byte-addressable target machines are permitted,
-it is nearly
-always possible to implement any requested sizes on any target machine.
-For example, the designer of the back end tables for the Z80 should provide
-code for 8-, 16-, and 32-bit arithmetic.
-In our view, the Pascal, C, or Plain programmer specifies what lengths
-are needed,
-without reference to the target machine,
-and the back end provides it.
-This approach greatly enhances portability.
-While it is true that doing all arithmetic using 32-bit integers on the Z80
-will not be terribly fast, we feel that if that is what the programmer needs,
-it should be possible to implement it.
-.PP
-Like all assembly languages, EM has not only machine instructions, but also
-pseudoinstructions.
-These are used to indicate the start and end of each procedure, allocate
-and initialize storage for data, and similar functions.
-One particularly important pseudoinstruction is the one that is used to
-transmit information to the back end for optimization purposes.
-It can be used to suggest variables that are good candidates to assign to
-registers, delimit the scope of loops, indicate that certain variables
-contain a useful value (next operation is a load) or not (next operation is
-a store), and various other things.
-.NH 1
-The Peephole Optimizer
-.PP
-The peephole optimizer reads in unoptimized EM programs and writes out
-optimized ones.
-Both the input and output are expressed in a highly compact code, rather than
-in ASCII, to reduce the i/o time, which would otherwise dominate the CPU
-time.
-The program itself is table driven, and is, by and large, ignorant of the
-semantics of EM.
-The knowledge of EM is contained in a
-language- and machine-independent table consisting of about 400
-pattern-replacement pairs.
-We will briefly describe the kinds of optimizations it performs below;
-a more complete discussion can be found in [9].
-.PP
-Each line in the driving table describes one optimization, consisting of a
-pattern part and a replacement part.
-The pattern part is a series of one or more EM instructions and a boolean
-expression.
-The replacement part is a series of EM instructions with operands.
-A typical optimization might be:
-.sp
- LOL LOC ADI STL ($1 = $4) and ($2 = 1) and ($3 = 2) ==> INL $1
-.sp
-where the text prior to the ==> symbol is the pattern and the text after it is
-the replacement.
-LOL loads a local variable onto the stack, LOC loads a constant onto the stack,
-ADI is integer addition, and STL is store local.
-The pattern specifies that four consecutive EM instructions are present, with
-the indicated opcodes, and that furthermore the operand of the first
-instruction (denoted by $1) and the fourth instruction (denoted by $4) are the
-same, the constant pushed by LOC is 1, and the size of the integers added by
-ADI is 2 bytes.
-(EM instructions have at most one operand, so it is not necessary to specify
-the operand number.)
-Under these conditions, the four instructions can be replaced by a single INL
-(increment local) instruction whose operand is equal to that of LOL.
-.PP
-Although the optimizations cover a wide range, the main ones
-can be roughly divided into the following categories.
-\fIConstant folding\fR
-is used to evaluate constant expressions, such as 2*3~+~7 at
-compile time instead of run time.
-\fIStrength reduction\fR
-is used to replace one operation, such as multiply, by
-another, such as shift.
-\fIReordering of expressions\fR
-helps in cases like -K/5, which can be better
-evaluated as K/-5, because the former requires
-a division and a negation, whereas the latter requires only a division.
-\fINull instructions\fR
-include resetting the stack pointer after a call with 0 parameters,
-offsetting zero bytes to access the
-first element of a record, or jumping to the next instruction.
-\fISpecial instructions\fR
-are those like INL, which deal with common special cases
-such as adding one to a variable or comparing something to zero.
-\fIGroup moves\fR
-are useful because a sequence
-of consecutive moves can often be replaced with EM code
-that allows the back end to generate a loop instead of in line code.
-\fIDead code elimination\fR
-is a technique for removing unreachable statements, possibly made unreachable
-by previous optimizations.
-\fIBranch chain compression\fR
-can be applied when a branch instruction jumps to another branch instruction.
-The first branch can jump directly to the final destination instead of
-indirectly.
-.PP
-The last two optimizations logically belong in the global optimizer but are
-in the local optimizer for historical reasons (meaning that the local
-optimizer has been the only optimizer for many years and the optimizations were
-easy to do there).
-.NH 1
-The Global Optimizer
-.PP
-In contrast to the peephole optimizer, which examines the EM code a few lines
-at a time through a small window, the global optimizer examines the
-program's large scale structure.
-Three distinct types of optimizations can be found here:
-.sp
- 1. Interprocedural optimizations.
- 2. Intraprocedural optimizations.
- 3. Basic block optimizations.
-.sp
-We will now look at each of these in turn.
-.PP
-Interprocedural optimizations are those spanning procedure boundaries.
-The most important one is deciding to expand procedures in line,
-especially short procedures that occur in loops and pass several parameters.
-If it takes more time or memory to pass the parameters than to do the work,
-the program can be improved by eliminating the procedure.
-The inverse optimization -- discovering long common code sequences and
-turning them into a procedure -- is also possible, but much more difficult.
-Like much of the global optimizer's work, the decision to make or not make
-a certain program transformation is a heuristic one, based on knowledge of
-how the back end works, how most target machines are organized, etc.
-.PP
-The heart of the global optimizer is its analysis of individual
-procedures.
-To perform this analysis, the optimizer must locate the basic blocks,
-instruction sequences which can be entered only at the top and exited
-only at the bottom.
-It then constructs a data flow graph, with the basic blocks as nodes and
-jumps between blocks as arcs.
-.PP
-From the data flow graph, many important properties of the program can be
-discovered and exploited.
-Chief among these is the presence of loops, indicated by cycles in the graph.
-One important optimization is looking for code that can be moved outside the
-loop, either prior to it or subsequent to it.
-Such code motion saves execution time, although it does not save memory.
-Unrolling loops is also possible and desirable in some cases.
-.PP
-Another area in which global analysis of loops is especially important is
-in register allocation.
-While it is true that EM does not have any registers to allocate,
-the optimizer can easily collect information to allow the
-back end to allocate registers wisely.
-For example, the global optimizer can collect static frequency-of-use
-and live/dead information about variables.
-(A variable is dead at some point in the program if its current value is
-not needed, i.e., the next reference to it overwrites it rather than
-reading it; if the current value will eventually be used, the variable is
-live.)
-If two variables are never simultaneously live over some interval of code
-(e.g., the body of a loop), they can be packed into a single variable,
-which, if used often enough, may warrant being assigned to a register.
-.PP
-Many loops involve arrays: this leads to other optimizations.
-If an array is accessed sequentially, with each iteration using the next
-higher numbered element, code improvement is often possible.
-Typically, a pointer to the bottom element of each array can be set up
-prior to the loop.
-Within the loop the element is accessed indirectly via the pointer, which is
-also incremented by the element size on each iteration.
-If the target machine has an autoincrement addressing mode and the pointer
-is assigned to a register, an array access can often be done in a single
-instruction.
-.PP
-Other intraprocedural optimizations include removing tail recursion
-(last statement is a recursive call to the procedure itself),
-topologically sorting the basic blocks to minimize the number of branch
-instructions, and common subexpression recognition.
-.PP
-The third general class of optimizations done by the global optimizer is
-improving the structure of a basic block.
-For the most part these involve transforming arithmetic or boolean
-expressions into forms that are likely to result in better target code.
-As a simple example, A~+~B*C can be converted to B*C~+~A.
-The latter can often
-be handled by loading B into a register, multiplying the register by C, and
-then adding in A, whereas the former may involve first putting A into a
-temporary, depending on the details of the code generation table.
-Another example of this kind of basic block optimization is transforming
--B~+~A~<~0 into the equivalent, but simpler, A~<~B.
-.NH 1
-The Back End
-.PP
-The back end reads a stream of EM instructions and generates assembly code
-for the target machine.
-Although the algorithm itself is machine independent, for each target
-machine a machine dependent driving table must be supplied.
-The driving table effectively defines the mapping of EM code to target code.
-.PP
-It will be convenient to think of the EM instructions being read as a
-stream of tokens.
-For didactic purposes, we will concentrate on two kinds of tokens:
-those that load something onto the stack, and those that perform some operation
-on the top one or two values on the stack.
-The back end maintains at compile time a simulated stack whose behavior
-mirrors what the stack of a hardware EM machine would do at run time.
-If the current input token is a load instruction, a new entry is pushed onto
-the simulated stack.
-.PP
-Consider, as an example, the EM code produced for the statement K~:=~I~+~7.
-If K and I are
-2-byte local variables, it will normally be LOL I; LOC 7; ADI~2; STL K.
-Initially the simulated stack is empty.
-After the first token has been read and processed, the simulated stack will
-contain a stack token of type MEM with attributes telling that it is a local,
-giving its address, etc.
-After the second token has been read and processed, the top two tokens on the
-simulated stack will be CON (constant) on top and MEM directly underneath it.
-.PP
-At this point the back end reads the ADI~2 token and
-looks in the driving table to find a line or lines that define the
-action to be taken for ADI~2.
-For a typical multiregister machine, instructions will exist to add constants
-to registers, but not to memory.
-Consequently, the driving table will not contain an entry for ADI~2 with stack
-configuration CON, MEM.
-.PP
-The back end is now faced with the problem of how to get from its
-current stack configuration, CON, MEM, which is not listed, to one that is
-listed.
-The table will normally contain rules (which we call "coercions")
-for converting between CON, REG, MEM, and similar tokens.
-Therefore the back end attempts to "coerce" the stack into a configuration
-that
-.I is
-present in the table.
-A typical coercion rule might tell how to convert a MEM into
-a REG, namely by performing the actions of allocating a
-register and emitting code to move the memory word to that register.
-Having transformed the compile-time stack into a configuration allowed for
-ADI~2, the rule can be carried out.
-A typical rule
-for ADI~2 might have stack configuration REG, MEM
-and would emit code to add the MEM to the REG, leaving the stack
-with a single REG token instead of the REG and MEM tokens present before the
-ADI~2.
-.PP
-In general, there will be more than one possible coercion path.
-Assuming reasonable coercion rules for our example,
-we might be able to convert
-CON MEM into CON REG by loading the variable I into a register.
-Alternatively, we could coerce CON to REG by loading the constant into a register.
-The first coercion path does the add by first loading I into a register and
-then adding 7 to it.
-The second path first loads 7 into a register and then adds I to it.
-On machines with a fast LOAD IMMEDIATE instruction for small constants
-but no fast ADD IMMEDIATE, or vice
-versa, one code sequence will be preferable to the other.
-.PP
-In fact, we actually have more choices than suggested above.
-In both coercion paths a register must be allocated.
-On many machines, not every register can be used in every operation, so the
-choice may be important.
-On some machines, for example, the operand of a multiply must be in an odd
-register.
-To summarize, from any state (i.e., token and stack configuration), a
-variety of choices can be made, leading to a variety of different target
-code sequences.
-.PP
-To decide which of the various code sequences to emit, the back end must have
-some information about the time and memory cost of each one.
-To provide this information, each rule in the driving table, including
-coercions, specifies both the time and memory cost of the code emitted when
-the rule is applied.
-The back end can then simply try each of the legal possibilities (including all
-the possible register allocations) to find the cheapest one.
-.PP
-This situation is similar to that found in a chess or other game-playing
-program, in which from any state a finite number of moves can be made.
-Just as in a chess program, the back end can look at all the "moves" that can
-be made from each state reachable from the original state, and thus find the
-sequence that gives the minimum cost to a depth of one.
-More generally, the back end can evaluate all paths corresponding to accepting
-the next
-.I N
-input tokens, find the cheapest one, and then make the first move along
-that path, precisely the way a chess program would.
-.PP
-Since the back end is analogous to both a parser and a chess playing program,
-some clarifying remarks may be helpful.
-First, chess programs and the back end must do some look ahead, whereas the
-parser for a well-designed grammar can usually suffice with one input token
-because grammars are supposed to be unambiguous.
-In contrast, many legal mappings
-from a sequence of EM instructions to target code may exist.
-Second, like a parser but unlike a chess program, the back end has perfect
-information -- it does not have to contend with an unpredictable opponent's
-moves.
-Third, chess programs normally make a static evaluation of the board and
-label the
-.I nodes
-of the tree with the resulting scores.
-The back end, in contrast, associates costs with
-.I arcs
-(moves) rather than nodes (states).
-However, the difference is not essential, since it could
-also label each node with the cumulative cost from the root to that node.
-.PP
-As mentioned above, the cost field in the table contains
-.I both
-the time and memory costs for the code emitted.
-It should be clear that the back end could use either one
-or some linear combination of them as the scoring function for evaluating moves.
-A user can instruct the compiler to optimize for time or for memory or
-for, say, 0.3 x time + 0.7 x memory.
-Thus the same compiler can provide a wide range of performance options to
-the user.
-The writer of the back end table can take advantage of this flexibility by
-providing several code sequences with different tradeoffs for each EM
-instruction (e.g., in line code vs. call to a run time routine).
-.PP
-In addition to the time-space tradeoffs, by specifying the depth of search
-parameter,
-.I N ,
-the user can effectively also tradeoff compile time vs. object
-code quality, for whatever code metric has been chosen.
-In summary, by combining the properties of a parser and a game playing program,
-it is possible to make a code generator that is table driven,
-highly flexible, and has the ability to produce good code from a
-stack machine intermediate code.
-.NH 1
-The Target Machine Optimizer
-.PP
-In the model of Fig 2., the peephole optimizer comes before the global
-optimizer.
-It may happen that the code produced by the global optimizer can also
-be improved by another round of peephole optimization.
-Conceivably, the system could have been designed to iterate peephole and
-global optimizations until no more of either could be performed.
-.PP
-However, both of these optimizations are done on the machine independent
-EM code.
-Neither is able to take advantage of the peculiarities and idiosyncracies with
-which most target machines are well endowed.
-It is the function of the final
-optimizer to do any (peephole) optimizations that still remain.
-.PP
-The algorithm used here is the same as in the EM peephole optimizer.
-In fact, if it were not for the differences between EM syntax, which is
-very restricted, and target assembly language syntax,
-which is less so, precisely the same program could be used for both.
-Nevertheless, the same ideas apply concerning patterns and replacements, so
-our discussion of this optimizer will be restricted to one example.
-.PP
-To see what the target optimizer might do, consider the
-PDP-11 instruction sequence sub #2,r0; mov (r0),x.
-First 2 is subtracted from register 0, then the word pointed to by it
-is moved to x.
-The PDP-11 happens to have an addressing mode to perform this sequence in
-one instruction: mov -(r0),x.
-Although it is conceivable that this instruction could be included in the
-back end driving table for the PDP-11, it is awkward to do so because it
-can occur in so many contexts.
-It is much easier to catch things like this in a separate program.
-.NH 1
-The Universal Assembler/Linker
-.PP
-Although assembly languages for different machines may appear very different
-at first glance, they have a surprisingly large intersection.
-We have been able to construct an assembler/linker that is almost entirely
-independent of the assembly language being processed.
-To tailor the program to a specific assembly language, it is necessary to
-supply a table giving the list of instructions, the bit patterns required for
-each one, and the language syntax.
-The machine independent part of the assembler/linker is then compiled with the
-table to produce an assembler and linker for a particular target machine.
-Experience has shown that writing the necessary table for a new machine can be
-done in less than a week.
-.PP
-To enforce a modicum of uniformity, we have chosen to use a common set of
-pseudoinstructions for all target machines.
-They are used to initialize memory, allocate uninitialized memory, determine the
-current segment, and similar functions found in most assemblers.
-.PP
-The assembler is also a linker.
-After assembling a program, it checks to see if there are any
-unsatisfied external references.
-If so, it begins reading the libraries to find the necessary routines, including
-them in the object file as it finds them.
-This approach requires libraries to be maintained in assembly language form,
-but eliminates the need for inventing a language to express relocatable
-object programs in a machine independent way.
-It also simplifies the assembler, since producing absolute object code is
-easier than producing relocatable object code.
-Finally, although assembly language libraries may be somewhat larger than
-relocatable object module libraries, the loss in speed due to having more
-input may be more than compensated for by not having to pass an intermediate
-file between the assembler and linker.
-.NH 1
-The Utility Package
-.PP
-The utility package is a collection of programs designed to aid the
-implementers of new front ends or new back ends.
-The most useful ones are the test programs.
-For example, one test set, EMTEST, systematically checks out a back end by
-executing an ever larger subset of the EM instructions.
-It starts out by testing LOC, LOL and a few of the other essential instructions.
-If these appear to work, it then tries out new instructions one at a time,
-adding them to the set of instructions "known" to work as they pass the tests.
-.PP
-Each instruction is tested with a variety of operands chosen from values
-where problems can be expected.
-For example, on target machines which have 16-bit index registers but only
-allow 8-bit displacements, a fundamentally different algorithm may be needed
-for accessing
-the first few bytes of local variables and those with offsets of thousands.
-The test programs have been carefully designed to thoroughly test all relevant
-cases.
-.PP
-In addition to EMTEST, test programs in Pascal, C, and other languages are also
-available.
-A typical test is:
-.sp
- i := 9; \fBif\fP i + 250 <> 259 \fBthen\fP error(16);
-.sp
-Like EMTEST, the other test programs systematically exercise all features of the
-language being tested, and do so in a way that makes it possible to pinpoint
-errors precisely.
-While it has been said that testing can only demonstrate the presence of errors
-and not their absence, our experience is that
-the test programs have been invaluable in debugging new parts of the system
-quickly.
-.PP
-Other utilities include programs to convert
-the highly compact EM code produced by front ends to ASCII and vice versa,
-programs to build various internal tables from human writable input formats,
-a variety of libraries written in or compiled to EM to make them portable,
-an EM assembler, and EM interpreters for various machines.
-.PP
-Interpreting the EM code instead of translating it to target machine language
-is useful for several reasons.
-First, the interpreters provide extensive run time diagnostics including
-an option to list the original source program (in Pascal, C, etc.) with the
-execution frequency or execution time for each source line printed in the
-left margin.
-Second, since an EM program is typically about one-third the size of a
-compiled program, large programs can be executed on small machines.
-Third, running the EM code directly makes it easier to pinpoint errors in
-the EM output of front ends still being debugged.
-.NH 1
-Summary and Conclusions
-.PP
-The Amsterdam Compiler Kit is a tool kit for building
-portable (cross) compilers and interpreters.
-The main pieces of the kit are the front ends, which convert source programs
-to EM code, optimizers, which improve the EM code, and back ends, which convert
-the EM code to target assembly language.
-The kit is highly modular, so writing one front end
-(and its associated runtime routines)
-is sufficient to implement
-a new language on a dozen or more machines, and writing one back end table
-and one universal assembler/linker table is all that is needed to bring up all
-the previously implemented languages on a new machine.
-In this manner, the contents, and hopefully the usefulness, of the toolkit
-will increase in time.
-.PP
-We believe the principal lesson to be learned from our work is that the old
-UNCOL idea is basically a sound way to produce compilers, provided suitable
-restrictions are placed on the source languages and target machines.
-We also believe that although compilers produced by this technology may not
-be equal to the very best handcrafted compilers,
-in terms of object code quality, they are certainly
-competitive with many existing compilers.
-However, when one factors in the cost of producing the compiler,
-the possible slight loss in performance may be more than compensated for by the
-large decrease in production cost.
-As a consequence of our work and similar work by other researchers [1,3,4],
-we expect integrated compiler building kits to become increasingly popular
-in the near future.
-.PP
-The toolkit is now available for various computers running the
-.UX
-operating system.
-For information, contact the authors.
-.NH 1
-References
-.LP
-.nr r 0 1
-.in +4
-.ti -4
-\fB~\n+r.\fR Graham, S.L.
-Table-Driven Code Generation.
-.I "Computer~13" ,
-8 (August 1980), 25-34.
-.PP
-A discussion of systematic ways to do code generation,
-in particular, the idea of having a table with templates that match parts of
-the parse tree and convert them into machine instructions.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Haddon, B.K., and Waite, W.M.
-Experience with the Universal Intermediate Language Janus.
-.I "Software Practice & Experience~8" ,
-5 (Sept.-Oct. 1978), 601-616.
-.PP
-An intermediate language for use with ALGOL 68, Pascal, etc. is described.
-The paper discusses some problems encountered and how they were dealt with.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Johnson, S.C.
-A Portable Compiler: Theory and Practice.
-.I "Ann. ACM Symp. Prin. Prog. Lang." ,
-Jan. 1978.
-.PP
-A cogent discussion of the portable C compiler.
-Particularly interesting are the author's thoughts on the value of
-computer science theory.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Leverett, B.W., Cattell, R.G.G, Hobbs, S.O., Newcomer, J.M.,
-Reiner, A.H., Schatz, B.R., and Wulf, W.A.
-An Overview of the Production-Quality Compiler-Compiler Project.
-.I Computer~13 ,
-8 (August 1980), 38-49.
-.PP
-PQCC is a system for building compilers similar in concept but differing in
-details from the Amsterdam Compiler Kit.
-The paper describes the intermediate representation used and the code generation
-strategy.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Lowry, E.S., and Medlock, C.W.
-Object Code Optimization.
-.I "Commun.~ACM~12",
-(Jan. 1969), 13-22.
-.PP
-A classic paper on global object code optimization.
-It covers data flow analysis, common subexpressions, code motion, register
-allocation and other techniques.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Nori, K.V., Ammann, U., Jensen, K., Nageli, H.
-The Pascal P Compiler Implementation Notes.
-Eidgen. Tech. Hochschule, Zurich, 1975.
-.PP
-A description of the original P-code machine, used to transport the Pascal-P
-compiler to new computers.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Steel, T.B., Jr. UNCOL: the Myth and the Fact. in
-.I "Ann. Rev. Auto. Prog."
-Goodman, R. (ed.), vol 2., (1960), 325-344.
-.PP
-An introduction to the UNCOL idea by its originator.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Steel, T.B., Jr.
-A First Version of UNCOL.
-.I "Proc. Western Joint Comp. Conf." ,
-(1961), 371-377.
-.PP
-The first detailed proposal for an UNCOL. By current standards it is a
-primitive language, but it is interesting for its historical perspective.
-.sp 2
-.ti -4
-\fB~\n+r.\fR Tanenbaum, A.S., van Staveren, H., and Stevenson, J.W.
-Using Peephole Optimization on Intermediate Code.
-.I "ACM Trans. Prog. Lang. and Sys. 3" ,
-1 (Jan. 1982) pp. 21-36.
-.PP
-A detailed description of a table-driven peephole optimizer.
-The driving table provides a list of patterns to match as well as the
-replacement text to use for each successful match.
-.sp 2
-.ti -4
-\fB\n+r.\fR Tanenbaum, A.S., Stevenson, J.W., Keizer, E.G., and van Staveren, H.
-Description of an Experimental Machine Architecture for use with Block
-Structured Languages.
-Informatica Rapport 81, Vrije Universiteit, Amsterdam, 1983.
-.PP
-The defining document for EM.
-.sp 2
-.ti -4
-\fB\n+r.\fR Tanenbaum, A.S.
-Implications of Structured Programming for Machine Architecture.
-.I "Comm. ACM~21" ,
-3 (March 1978), 237-246.
-.PP
-The background and motivation for the design of EM.
-This early version emphasized the idea of interpreting the intermediate
-code (then called EM-1) rather than compiling it.
+++ /dev/null
-.wh 0 hd
-.wh 60 fo
-.de hd
-'sp 5
-..
-.de fo
-'bp
-..
-.nr e 0 1
-.de ER
-.br
-.ne 20
-.sp 2
-.in 5
-.ti -5
-ERROR \\n+e:
-..
-.de PS
-.sp
-.nf
-.in +5
-..
-.de PE
-.sp
-.fi
-.in -5
-..
-.sp 3
-.ce
-UNIX version 7 bugs
-.sp 3
-This document describes the UNIX version 7 errors fixed at the
-Vrije Universiteit, Amsterdam.
-Several of these are discovered at the VU.
-Others are quoted from a list of bugs distributed by BellLabs.
-.sp
-For each error the differences between the original and modified
-source files are given,
-as well as a test program.
-.ER
-C optimizer bug for unsigned comparison
-.sp
-The following C program caused an IOT trap, while it should not
-(compile with 'cc -O prog.c'):
-.PS
-unsigned i = 0;
-
-main() {
- register j;
-
- j = -1;
- if (i > 40000)
- abort();
-}
-.PE
-BellLabs suggests to make the following patch in c21.c:
-.PS
-/* modified /usr/src/cmd/c/c21.c */
-
-189 if (r==0) {
-190 /* next 2 lines replaced as indicated by
-191 * Bell Labs bug distribution ( v7optbug )
-192 p->back->back->forw = p->forw;
-193 p->forw->back = p->back->back;
-194 End of lines changed */
-195 if (p->forw->op==CBR
-196 || p->forw->op==SXT
-197 || p->forw->op==CFCC) {
-198 p->back->forw = p->forw;
-199 p->forw->back = p->back;
-200 } else {
-201 p->back->back->forw = p->forw;
-202 p->forw->back = p->back->back;
-203 }
-204 /* End of new lines */
-205 decref(p->ref);
-206 p = p->back->back;
-207 nchange++;
-208 } else if (r>0) {
-.PE
-Use the previous program to test before and after the modification.
-.ER
-The loader fails for large data or text portions
-.sp
-The loader 'ld' produces a "local symbol botch" error
-for the following C program.
-.PS
-int big1[10000] = {
- 1
-};
-int big2[10000] = {
- 2
-};
-
-main() {
- printf("loader is fine\\n");
-}
-.PE
-We have made the following fix:
-.PS
-/* original /usr/src/cmd/ld.c */
-
-113 struct {
-114 int fmagic;
-115 int tsize;
-116 int dsize;
-117 int bsize;
-118 int ssize;
-119 int entry;
-120 int pad;
-121 int relflg;
-122 } filhdr;
-
-/* modified /usr/src/cmd/ld.c */
-
-113 /*
-114 * The original Version 7 loader had problems loading large
-115 * text or data portions.
-116 * Why not include <a.out.h> ???
-117 * then they would be declared unsigned
-118 */
-119 struct {
-120 int fmagic;
-121 unsigned tsize; /* not int !!! */
-122 unsigned dsize; /* not int !!! */
-123 unsigned bsize; /* not int !!! */
-124 unsigned ssize; /* not int !!! */
-125 unsigned entry; /* not int !!! */
-126 unsigned pad; /* not int !!! */
-127 unsigned relflg; /* not int !!! */
-128 } filhdr;
-.PE
-.ER
-Floating point registers
-.sp
-When a program is swapped to disk if it needs more memory,
-then the floating point registers were not saved, so that
-it may have different registers when it is restarted.
-A small assembly program demonstrates this for the status register.
-If the error is not fixed, then the program generates an IOT error.
-A "memory fault" is generated if all is fine.
-.PS
-start: ldfps $7400
-1: stfps r0
- mov r0,-(sp)
- cmp r0,$7400
- beq 1b
- 4
-.PE
-You have to dig into the kernel to fix it.
-The following patch will do:
-.PS
-/* original /usr/sys/sys/slp.c */
-
-563 a2 = malloc(coremap, newsize);
-564 if(a2 == NULL) {
-565 xswap(p, 1, n);
-566 p->p_flag |= SSWAP;
-567 qswtch();
-568 /* no return */
-569 }
-
-/* modified /usr/sys/sys/slp.c */
-
-590 a2 = malloc(coremap, newsize);
-591 if(a2 == NULL) {
-592 #ifdef FPBUG
-593 /*
-594 * copy floating point register and status,
-595 * but only if you must switch processes
-596 */
-597 if(u.u_fpsaved == 0) {
-598 savfp(&u.u_fps);
-599 u.u_fpsaved = 1;
-600 }
-601 #endif
-602 xswap(p, 1, n);
-603 p->p_flag |= SSWAP;
-604 qswtch();
-605 /* no return */
-606 }
-.PE
-.ER
-Floating point registers.
-.sp
-A similar problem arises when a process forks.
-The child will have random floating point registers as is
-demonstrated by the following assembly language program.
-The child process will die by an IOT trap and the father prints
-the message "child failed".
-.PS
-exit = 1.
-fork = 2.
-write = 4.
-wait = 7.
-
-start: ldfps $7400
- sys fork
- br child
- sys wait
- tst r1
- bne bad
- stfps r2
- cmp r2,$7400
- beq start
- 4
-child: stfps r2
- cmp r2,$7400
- beq ex
- 4
-bad: clr r0
- sys write;mess;13.
-ex: clr r0
- sys exit
-
- .data
-mess: <child failed\\n>
-.PE
-The same file slp.c should be patched as follows:
-.PS
-/* original /usr/sys/sys/slp.c */
-
-499 /*
-500 * When the resume is executed for the new process,
-501 * here's where it will resume.
-502 */
-503 if (save(u.u_ssav)) {
-504 sureg();
-505 return(1);
-506 }
-507 a2 = malloc(coremap, n);
-508 /*
-509 * If there is not enough core for the
-510 * new process, swap out the current process to generate the
-511 * copy.
-512 */
-
-/* modified /usr/sys/sys/slp.c */
-
-519 /*
-520 * When the resume is executed for the new process,
-521 * here's where it will resume.
-522 */
-523 if (save(u.u_ssav)) {
-524 sureg();
-525 return(1);
-526 }
-527 #ifdef FPBUG
-528 /* copy the floating point registers and status to child */
-529 if(u.u_fpsaved == 0) {
-530 savfp(&u.u_fps);
-531 u.u_fpsaved = 1;
-532 }
-533 #endif
-534 a2 = malloc(coremap, n);
-535 /*
-536 * If there is not enough core for the
-537 * new process, swap out the current process to generate the
-538 * copy.
-539 */
-.PE
-.ER
-/usr/src/libc/v6/stat.c
-.sp
-Some system calls are changed from version 6 to version 7.
-A library of system call entries, that make a version 6 UNIX look like
-a version 7 system, is provided to enable you to run some
-useful version 7 utilities, like 'tar', on UNIX-6.
-The entry for 'stat' contained two bugs:
-the 24-bit file size was incorrectly converted to 32 bits
-(sign extension of bit 15)
-and the uid/gid fields suffered from sign extension.
-.sp
-Transferring your files from version 6 to version 7 using 'tar'
-will fail for all files for which
-.sp
- ( (size & 0100000) != 0 )
-.sp
-These two errors are fixed if stat.c is modified as follows:
-.PS
-/* original /usr/src/libc/v6/stat.c */
-
-11 char os_size0;
-12 short os_size1;
-13 short os_addr[8];
-
-49 buf->st_nlink = osbuf.os_nlinks;
-50 buf->st_uid = osbuf.os_uid;
-51 buf->st_gid = osbuf.os_gid;
-52 buf->st_rdev = 0;
-
-/* modified /usr/src/libc/v6/stat.c */
-
-11 char os_size0;
-12 unsigned os_size1;
-13 short os_addr[8];
-
-49 buf->st_nlink = osbuf.os_nlinks;
-50 buf->st_uid = osbuf.os_uid & 0377;
-51 buf->st_gid = osbuf.os_gid & 0377;
-52 buf->st_rdev = 0;
-.PE
+++ /dev/null
-.ll 72
-.wh 0 hd
-.wh 60 fo
-.de hd
-'sp 5
-..
-.de fo
-'bp
-..
-.tr ~
-. PARAGRAPH
-.de PP
-.sp
-..
-. CHAPTER
-.de CH
-.br
-.ne 15
-.sp 3
-.in 0
-\\fB\\$1\\fR
-.in 5
-.PP
-..
-. SUBCHAPTER
-.de SH
-.br
-.ne 10
-.sp
-.in 5
-\\fB\\$1\\fR
-.in 10
-.PP
-..
-. INDENT START
-.de IS
-.sp
-.in +5
-..
-. INDENT END
-.de IE
-.in -5
-.sp
-..
-. DOUBLE INDENT START
-.de DS
-.sp
-.in +5
-.ll -5
-..
-. DOUBLE INDENT END
-.de DE
-.ll +5
-.in -5
-.sp
-..
-. EQUATION START
-.de EQ
-.sp
-.nf
-..
-. EQUATION END
-.de EN
-.fi
-.sp
-..
-. TEST
-.de TT
-.ti -5
-Test~\\$1:~
-.br
-..
-. IMPLEMENTATION 1
-.de I1
-.br
-Implementation~1:
-..
-. IMPLEMENTATION 2
-.de I2
-.br
-Implementation~2:
-..
-.de CS
-.br
-~-~\\
-..
-.br
-.fi
-.sp 5
-.ce
-\fBPascal Validation Suite Report\fR
-.CH "Pascal processor identification"
-The ACK-Pascal compiler produces code for an EM machine
-as defined in [1].
-It is up to the implementor of the EM machine whether errors like
-integer overflow, undefined operand and range bound error are recognized or not.
-Therefore it depends on the EM machine implementation whether these errors
-are recognized in Pascal programs or not.
-The validation suite results of all known implementations are given.
-.PP
-There does not (yet) exist a hardware EM machine.
-Therefore, EM programs must be interpreted, or translated into
-instructions for a target machine.
-The following implementations currently exist:
-.IS
-.I1
-an interpreter running on a PDP-11 (using UNIX).
-The normal mode of operation for this interpreter is to check
-for undefined integers, overflow, range errors etc.
-.sp
-.I2
-a translator into PDP-11 instructions (using UNIX).
-Less checks are performed than in the interpreter, because the translator
-is intended to speed up the execution of well-debugged programs.
-.IE
-.CH "Test Conditions"
-Tester: E.G. Keizer
-.br
-Date: October 1983
-.br
-Validation Suite version: 3.0
-.PP
-The final test run is made with a slightly
-modified validation suite.
-.SH "Erroneous programs"
-Some test did not conform to the standard proposal of February 1979.
-It is this version of the standard proposal that is used
-by the authors of the validation suite.
-.IS
-.TT 6.6.3.7-4
-The semicolon between high and integer on line 17 is replaced
-by a colon.
-.sp
-.TT 6.7.2.2-13
-The div operator on line 14 replaced by mod.
-.CH "Conformance tests"
-Number of tests passed = 150
-.br
-Number of tests failed = 6
-.SH "Details of failed tests"
-.IS
-.TT 6.1.2-1
-Character sequences starting with the 8 characters 'procedur'
-or 'function' are
-erroneously classified as the word-symbols 'procedure' and 'function'.
-.sp
-.TT 6.1.3-2
-Identifiers identical in the first eight characters, but
-differing in ninth or higher numbered characters are treated as
-identical.
-.sp
-.TT 6.5.1-1
-ACK-Pascal requires all formal program parameters to be
-declared with type \fIfile\fP.
-.sp
-.TT 6.6.6.5-1
-Gives run-time error eof seen at call to eoln.
-A have a hunch that this is a error in the suit.
-.sp
-.TT 6.6.4.1-1
-Redefining the names of some standard procedures leads to incorrect
-behaviour of the runtime system.
-In this case it crashes without a sensible error message.
-.sp
-.TT 6.9.3.5.1-1
-This test can not be translated by our compiler because two
-non-identical variables are used in the same block with the same first eight
-characters.
-The test passed after replacement of one of those names.
-.IE
-.CH "Deviance tests"
-Number of deviations correctly detected = 120
-.br
-Number of tests not detecting deviations = 20
-.SH "Details of deviations"
-The following tests are compiled without a proper error
-indication although they do
-not conform to the standard.
-.IS
-.TT 6.1.6-5
-ACK-Pascal allows labels in the range 0..32767.
-A warning is produced when testing for deviations from the
-standard.
-.sp
-.TT 6.1.8-5
-A missing space between a number and a word symbol is not
-detected.
-.sp
-.TT 6.2.2-8
-.TT 6.3-6
-.TT 6.4.1-3
-.TT 6.6.1-3
-.TT 6.6.1-4
-Undetected scope error. The scope of an identifier should start at the
-beginning of the block in which it is declared.
-In the ACK-Pascal compiler the scope starts just after the declaration,
-however.
-.sp
-.TT 6.4.3.3-7
-The values of fields from one variant are accessible from
-another variant.
-The correlation is exact.
-.sp
-.TT 6.6.3.3-4
-The passing as a variable parameter of the selector of a
-variant part is not detected.
-A runtime error is produced because the variant selector is not
-initialized.
-.sp
-.TT 6.8.2.4-2
-.TT 6.8.2.4-3
-.TT 6.8.2.4-4
-.TT 6.8.2.4-5
-.TT 6.8.2.4-6
-The ACK-Pascal compiler does not restrict the places from where
-you may jump to a label by means of a goto-statement.
-.sp
-.TT 6.8.3.9-5
-.TT 6.8.3.9-6
-.TT 6.8.3.9-7
-.TT 6.8.3.9-16
-There are no errors produced for assignments to a variable
-in use as control-variable of a for-statement.
-.TT 6.8.3.9-8
-.TT 6.8.3.9-9
-Use of a controlled variable after leaving the loop without
-intervening initialization is not detected.
-.IE
-.CH "Error handling"
-The results depend on the EM implementation.
-.sp
-Number of errors correctly detected =
-.in +5
-.I1
-32
-.I2
-17
-.in -5
-Number of errors not detected =
-.in +5
-.I1
-21
-.I2
-36
-.in -5
-Number of errors incorrectly detected =
-.in +5
-.I1
-2
-.I2
-2
-.in -5
-.SH "Details of errors not detected"
-The following test fails because the ACK-Pascal compiler only
-generates a warning that does not prevent to run the tests.
-.IS
-.TT 6.6.2-8
-A warning is produced if there is no assignment to a function-identifier.
-.IE
-With this test the ACK-Pascal compiler issues an error message for a legal
-construct not directly related to the error to be detected.
-.IS
-.TT 6.5.5-2
-Program does not compile.
-Buffer variable of text file is not allowed as variable
-parameter.
-.IE
-The following errors are not detected at all.
-.IS
-.TT 6.2.1-11
-.I2
-The use of an undefined integer is not caught as an error.
-.sp
-.TT 6.4.3.3-10
-.TT 6.4.3.3-11
-.TT 6.4.3.3-12
-.TT 6.4.3.3-13
-The notion of 'current variant' is not implemented, not even if a tagfield
-is present.
-.sp
-.TT 6.4.5-15
-.TT 6.4.6-9
-.TT 6.4.6-10
-.TT 6.4.6-11
-.TT 6.5.3.2-2
-.I2
-Subrange bounds are not checked.
-.sp
-.TT 6.4.6-12
-.TT 6.4.6-13
-.TT 6.7.2.4-4
-If the base-type of a set is a subrange, then the set elements are not checked
-against the bounds of the subrange.
-Only the host-type of this subrange-type is relevant for ACK-Pascal.
-.sp
-.TT 6.5.4-1
-.I2
-Nil pointers are not detected.
-.sp
-.TT 6.5.4-2
-.I2
-Undefined pointers are not detected.
-.sp
-.TT 6.5.5-3
-Changing the file position while the window is in use as actual variable
-parameter or as an element of the record variable list of a with-statement
-is not detected.
-.sp
-.TT 6.6.2-9
-An undefined function result is not detected,
-because it is never used in an expression.
-.sp
-.TT 6.6.5.3-6
-.TT 6.6.5.3-7
-Disposing a variable while it is in use as actual variable parameter or
-as an element of the record variable list of a with-statement is not detected.
-.sp
-.TT 6.6.5.3-8
-.TT 6.6.5.3-9
-.TT 6.6.5.3-10
-It is not detected that a record variable, created with the variant form
-of new, is used as an operand in an expression or as the variable in an
-assignment or as an actual value parameter.
-.sp
-.TT 6.6.5.3-11
-Use of a variable that is not reinitialized after a dispose is
-not detected.
-.sp
-.TT 6.6.6.4-4
-.TT 6.6.6.4-5
-.TT 6.6.6.4-7
-.I2
-There are no range checks for pred, succ and chr.
-.sp
-.TT 6.6.6.5-6
-ACK-Pascal considers a rewrite of a file as a defining
-occurence.
-.sp
-.TT 6.7.2.2-8
-.TT 6.7.2.2-9
-.TT 6.7.2.2-10
-.TT 6.7.2.2-12
-.I2
-Division by 0 or integer overflow is not detected.
-.sp
-.TT 6.8.3.9-18
-The use of the some control variable in two nested for
-statements in not detected.
-.sp
-.TT 6.8.3.9-19
-Access of a control variable after leaving the loop results in
-the final-value, although an error should be produced.
-.sp
-.TT 6.9.3.2-3
-The program stops with a file not open error.
-The rewrite before the write is missing in the program.
-.sp
-.TT 6.9.3.2-4
-.TT 6.9.3.2-5
-Illegal FracDigits values are not detected.
-.CH "Implementation dependence"
-Number of tests run = 14
-.br
-Number of tests incorrectly handled = 0
-.SH "Details of implementation dependence"
-.IS
-.TT 6.1.9-5
-Alternate comment delimiters are implemented
-.sp
-.TT 6.1.9-6
-The equivalent symbols @ for ^, (. for [ and .) for ] are not
-implemented.
-.sp
-.TT 6.4.2.2-10
-Maxint = 32767
-.sp
-.TT 6.4.3.4-5
-Only elements with non-negative ordinal value are allowed in sets.
-.sp
-.TT 6.6.6.1-1
-Standard procedures and functions are not allowed as parameters.
-.sp
-.TT 6.6.6.2-11
-Details of the machine characteristics regarding real numbers:
-.IS
-.nf
-beta = 2
-t = 56
-rnd = 1
-ngrd = 0
-machep = -56
-negep = -56
-iexp = 8
-minexp = -128
-maxexp = 127
-eps = 1.387779e-17
-epsneg = 1.387779e-17
-xmin = 2.938736e-39
-xmax = 1.701412e+38
-.fi
-.IE
-.sp
-.TT 6.7.2.3-3
-.TT 6.7.2.3-4
-All operands of boolean expressions are evaluated.
-.sp
-.TT 6.8.2.2-1
-.TT 6.8.2.2-2
-The expression in an assignment statement is evaluated
-before the variable selection if this involves pointer
-dereferencing or array indexing.
-.sp
-.TT 6.8.2.3-2
-Actual parameters are evaluated in reverse order.
-.sp
-.TT 6.9.3.2-6
-The default width for integer, Boolean and real are 6, 5 and 13.
-.sp
-.TT 6.9.3.5.1-2
-The number of digits written in an exponent is 2.
-.sp
-.TT 6.9.3.6-1
-The representations of true and false are (~true) and (false).
-The parenthesis serve to indicate width.
-.IE
-.CH "Quality measurement"
-Number of tests run = 60
-.br
-Number of tests handled incorrectly = 1
-.SH "Results of tests"
-Several test perform operations on reals on indicate the error
-introduced by these operations.
-For each of these tests the following two quality measures are extracted:
-.sp
-.in +5
-maxRE:~~maximum relative error
-.br
-rmsRE:~~root-mean-square relative error
-.in -5
-.sp 2
-.IS
-.TT 1.2-1
-.I1
-25 thousand Whetstone instructions per second.
-.I2
-169 thousand Whetstone instructions per second.
-.sp
-.TT 1.2-2
-The value of (TRUEACC-ACC)*2^56/100000 is 1.4 .
-This is well within the bounds specified in [3].
-.br
-The GAMM measure is:
-.I1
-238 microseconds
-.I2
-26.3 microseconds.
-.sp
-.TT 1.2-3
-The number of procedure calls calculated in this test exceeds
-the maximum integer value.
-The program stops indicating overflow.
-.sp
-.TT 6.1.3-3
-The number of significant characters for identifiers is 8.
-.sp
-.TT 6.1.5-8
-There is no maximum to the line length.
-.sp
-.TT 6.1.5-9
-The error message "too many digits" is given for numbers larger
-than maxint.
-.sp
-.TT 6.1.5-10
-.TT 6.1.5-11
-.TT 6.1.5-12
-Normal values are allowed for real constants and variables.
-.sp
-.TT 6.1.7-14
-A reasonably large number of strings is allowed.
-.sp
-.TT 6.1.8-6
-No warning is given for possibly unclosed comments.
-.sp
-.TT 6.2.1-12
-.TT 6.2.1-13
-.TT 6.2.1-14
-.TT 6.2.1-15
-.TT 6.5.1-2
-Large lists of declarations are possible in each block.
-.sp
-.TT 6.4.3.2-6
-An 'array[integer] of' is not allowed.
-.sp
-.TT 6.4.3.2-7
-.TT 6.4.3.2-8
-Large values are allowed for arrays and indices.
-.sp
-.TT 6.4.3.3-14
-Large amounts of case-constant values are allowed in variants.
-.sp
-.TT 6.4.3.3-15
-Large amounts of record sections can appear in the fixed part of
-a record.
-.sp
-.TT 6.4.3.3-16
-Large amounts of variants are allowed in a record.
-.TT 6.4.3.4-4
-Size and speed of Warshall's algorithm depend on the
-implementation of EM:
-.IS
-.I1
-.br
-size: 122 bytes
-.br
-speed: 5.2 seconds
-.sp
-.I2
-.br
-size: 196 bytes
-.br
-speed: 0.7 seconds
-.IE
-.TT 6.5.3.2-3
-Deep nesting of array indices is allowed.
-.sp
-.TT 6.5.3.2-4
-.TT 6.5.3.2-5
-Arrays can have at least 8 dimensions.
-.sp
-.TT 6.6.1-8
-Deep static nesting of procedure is allowed.
-.sp
-.TT 6.6.3.1-6
-Large amounts of formal parameters are allowed.
-.sp
-.TT 6.6.5.3-12
-Dispose is fully implemented.
-.sp
-.TT 6.6.6.2-6
-Test sqrt(x): no errors.
-The error is within acceptable bounds.
-.in +5
-maxRE:~~2~**~-55.50
-.br
-rmsRE:~~2~**~-57.53
-.in -5
-.sp
-.TT 6.6.6.2-7
-Test arctan(x): may cause underflow or overflow errors.
-The error is within acceptable bounds.
-.in +5
-.br
-maxRE:~~2~**~-55.00
-.br
-rmsRE:~~2~**~-56.36
-.in -5
-.sp
-.TT 6.6.6.2-8
-Test exp(x): may cause underflow or overflow errors.
-The error is not within acceptable bounds.
-.in +5
-maxRE:~~2~**~-50.03
-.br
-rmsRE:~~2~**~-51.03
-.in -5
-.sp
-.TT 6.6.6.2-9
-Test sin(x): may cause underflow errors.
-The error is not within acceptable bounds.
-.in +5
-maxRE:~~2~**~-38.20
-.br
-rmsRE:~~2~**~-43.68
-.in -5
-.sp
-Test cos(x): may cause underflow errors.
-The error is not within acceptable bounds.
-.in +5
-maxRE:~~2~**~-41.33
-.br
-rmsRE:~~2~**~-46.62
-.in -5
-.sp
-.TT 6.6.6.2-10
-Test ln(x):
-The error is not within acceptable bounds.
-.in +5
-maxRE:~~2~**~-54.05
-.br
-rmsRE:~~2~**~-55.77
-.in -5
-.sp
-.TT 6.7.1-3
-.TT 6.7.1-4
-.TT 6.7.1-5
-Complex nested expressions are allowed.
-.sp
-.TT 6.7.2.2-14
-Test real division:
-The error is within acceptable bounds.
-.in +5
-maxRE:~~0
-.br
-rmsRE:~~0
-.in -5
-.sp
-.TT 6.7.2.2-15
-Operations of reals in the integer range are exact.
-.sp
-.TT 6.7.3-1
-.TT 6.8.3.2-1
-.TT 6.8.3.4-2
-.TT 6.8.3.5-15
-.TT 6.8.3.7-4
-.TT 6.8.3.8-3
-.TT 6.8.3.9-20
-.TT 6.8.3.10-7
-Static deep nesting of function calls,
-compound statements, if statements, case statements, repeat
-loops, while loops, for loops and with statements is possible.
-.sp
-.TT 6.8.3.2-2
-Large amounts of statements are allowed in a compound
-statement.
-.sp
-.TT 6.8.3.5-12
-The compiler requires case constants to be compatible with
-the case selector.
-.sp
-.TT 6.8.3.5-13
-.TT 6.8.3.5-14
-Large case statements are possible.
-.sp
-.TT 6.9-2
-Recursive IO on the same file is well-behaved.
-.sp
-.TT 6.9.1-6
-The reading of real values from a text file is done with
-sufficient accuracy.
-.in +5
-maxRE:~~2~**~-54.61
-.br
-rmsRE:~~2~**~-56.32
-.in -5
-.sp
-.TT 6.9.1-7
-.TT 6.9.2-2
-.TT 6.9.3-3
-.TT 6.9.4-2
-Read, readln, write and writeln may have large amounts of
-parameters.
-.sp
-.TT 6.9.1-8
-The loss of precision for reals written on a text file and read
-back is:
-.in +5
-maxRE:~~2~**~-53.95
-.br
-rmsRE:~~2~**~-55.90
-.in -5
-.sp
-.TT 6.9.3-2
-File IO buffers without trailing marker are correctly flushed.
-.sp
-.TT 6.9.3.5.2-2
-Reals are written with sufficient accuracy.
-.in +5
-maxRE:~~0
-.br
-rmsRE:~~0
-.in -5
-.IE
-.CH "Level 1 conformance tests"
-Number of test passed = 4
-.br
-Number of tests failed = 1
-.SH "Details of failed tests"
-.IS
-.TT 6.6.3.7-4
-An expression indicated by parenthesis whose
-value is a conformant array is not allowed.
-.IE
-.CH "Level 1 deviance tests"
-Number of deviations correctly detected = 4
-.br
-Number of tests not detecting deviations = 0
-.IE
-.CH "Level 1 error handling"
-The results depend on the EM implementation.
-.sp
-Number of errors correctly detected =
-.in +5
-.I1
-1
-.I2
-0
-.in -5
-Number of errors not detected =
-.in +5
-.I1
-0
-.I2
-1
-.in -5
-.SH "Details of errors not detected"
-.IS
-.TT 6.6.3.7-9
-.I2
-Subrange bounds are not checked.
-.IE
-.CH "Level 1 quality measurement"
-Number of tests run = 1
-.SH "Results of test"
-.IS
-.TT 6.6.3.7-10
-Large conformant arrays are allowed.
-.IE
-.CH "Extensions"
-Number of tests run = 3
-.SH Details of test failed
-.IS
-.TT 6.1.9-7
-The alternative relational operators are not allowed.
-.sp
-.TT 6.1.9-8
-The alternative symbols for colon, semicolon and assignment are
-not allowed.
-.sp
-.TT 6.8.3.5-16
-The otherwise selector in case statements is not allowed.
-.IE
-.CH "References"
-.ti -5
-[1]~~\
-A.S.Tanenbaum, E.G.Keizer, J.W.Stevenson, Hans van Staveren,
-"Description of a machine architecture for use with block structured
-languages",
-Informatica rapport IR-81.
-.ti -5
-[2]~~\
-ISO standard proposal ISO/TC97/SC5-N462, dated February 1979.
-The same proposal, in slightly modified form, can be found in:
-A.M.Addyman e.a., "A draft description of Pascal",
-Software, practice and experience, May 1979.
-An improved version, received March 1980,
-is followed as much as possible for the
-current ACK-Pascal.
-.ti -5
-[3]~~\
-B. A. Wichman and J du Croz,
-A program to calculate the GAMM measure, Computer Journal,
-November 1979.
+++ /dev/null
-aar mwPo 1 34
-adf sP 1 35
-adi mwPo 2 36
-adp 2 38
-adp mPo 2 39
-adp sP 1 41
-adp sN 1 42
-ads mwPo 1 43
-and mwPo 1 44
-asp mwPo 5 45
-asp swP 1 50
-beq 2 51
-beq sP 1 52
-bge sP 1 53
-bgt sP 1 54
-ble sP 1 55
-blm sP 1 56
-blt sP 1 57
-bne sP 1 58
-bra 2 59
-bra sN 2 60
-bra sP 2 62
-cal mPo 28 64
-cal sP 1 92
-cff - 93
-cif - 94
-cii - 95
-cmf sP 1 96
-cmi mwPo 2 97
-cmp - 99
-cms sP 1 100
-csa mwPo 1 101
-csb mwPo 1 102
-dec - 103
-dee sw 1 104
-del swN 1 105
-dup mwPo 1 106
-dvf sP 1 107
-dvi mwPo 1 108
-fil 2 109
-inc - 110
-ine w2 111
-ine sw 1 112
-inl mwN 3 113
-inl swN 1 116
-inn sP 1 117
-ior mwPo 1 118
-ior sP 1 119
-lae 2 120
-lae sw 7 121
-lal P2 128
-lal N2 129
-lal m 1 130
-lal mN 1 131
-lal swP 1 132
-lal swN 2 133
-lar mwPo 1 135
-ldc mP 1 136
-lde w2 137
-lde sw 1 138
-ldl mP 1 139
-ldl swN 1 140
-lfr mwPo 2 141
-lfr sP 1 143
-lil swN 1 144
-lil swP 1 145
-lil mwP 2 146
-lin 2 148
-lin sP 1 149
-lni - 150
-loc 2 151
-loc mP 34 0
-loc mN 1 152
-loc sP 1 153
-loc sN 1 154
-loe w2 155
-loe sw 5 156
-lof 2 161
-lof mwPo 4 162
-lof sP 1 166
-loi 2 167
-loi mPo 1 168
-loi mwPo 4 169
-loi sP 1 173
-lol wP2 174
-lol wN2 175
-lol mwP 4 176
-lol mwN 8 180
-lol swP 1 188
-lol swN 1 189
-lxa mPo 1 190
-lxl mPo 2 191
-mlf sP 1 193
-mli mwPo 2 194
-rck mwPo 1 196
-ret mwP 2 197
-ret sP 1 199
-rmi mwPo 1 200
-sar mwPo 1 201
-sbf sP 1 202
-sbi mwPo 2 203
-sdl swN 1 205
-set sP 1 206
-sil swN 1 207
-sil swP 1 208
-sli mwPo 1 209
-ste w2 210
-ste sw 3 211
-stf 2 214
-stf mwPo 2 215
-stf sP 1 217
-sti mPo 1 218
-sti mwPo 4 219
-sti sP 1 223
-stl wP2 224
-stl wN2 225
-stl mwP 2 226
-stl mwN 5 228
-stl swN 1 233
-teq - 234
-tgt - 235
-tlt - 236
-tne - 237
-zeq 2 238
-zeq sP 2 239
-zer sP 1 241
-zge sP 1 242
-zgt sP 1 243
-zle sP 1 244
-zlt sP 1 245
-zne sP 1 246
-zne sN 1 247
-zre w2 248
-zre sw 1 249
-zrl mwN 2 250
-zrl swN 1 252
-zrl wN2 253
-aar e2 0
-aar e- 1
-adf e2 2
-adf e- 3
-adi e2 4
-adi e- 5
-ads e2 6
-ads e- 7
-adu e2 8
-adu e- 9
-and e2 10
-and e- 11
-asp ew2 12
-ass e2 13
-ass e- 14
-bge e2 15
-bgt e2 16
-ble e2 17
-blm e2 18
-bls e2 19
-bls e- 20
-blt e2 21
-bne e2 22
-cai e- 23
-cal e2 24
-cfi e- 25
-cfu e- 26
-ciu e- 27
-cmf e2 28
-cmf e- 29
-cmi e2 30
-cmi e- 31
-cms e2 32
-cms e- 33
-cmu e2 34
-cmu e- 35
-com e2 36
-com e- 37
-csa e2 38
-csa e- 39
-csb e2 40
-csb e- 41
-cuf e- 42
-cui e- 43
-cuu e- 44
-dee ew2 45
-del ewP2 46
-del ewN2 47
-dup e2 48
-dus e2 49
-dus e- 50
-dvf e2 51
-dvf e- 52
-dvi e2 53
-dvi e- 54
-dvu e2 55
-dvu e- 56
-fef e2 57
-fef e- 58
-fif e2 59
-fif e- 60
-inl ewP2 61
-inl ewN2 62
-inn e2 63
-inn e- 64
-ior e2 65
-ior e- 66
-lar e2 67
-lar e- 68
-ldc e2 69
-ldf e2 70
-ldl ewP2 71
-ldl ewN2 72
-lfr e2 73
-lil ewP2 74
-lil ewN2 75
-lim e- 76
-los e2 77
-los e- 78
-lor esP 1 79
-lpi e2 80
-lxa e2 81
-lxl e2 82
-mlf e2 83
-mlf e- 84
-mli e2 85
-mli e- 86
-mlu e2 87
-mlu e- 88
-mon e- 89
-ngf e2 90
-ngf e- 91
-ngi e2 92
-ngi e- 93
-nop e- 94
-rck e2 95
-rck e- 96
-ret e2 97
-rmi e2 98
-rmi e- 99
-rmu e2 100
-rmu e- 101
-rol e2 102
-rol e- 103
-ror e2 104
-ror e- 105
-rtt e- 106
-sar e2 107
-sar e- 108
-sbf e2 109
-sbf e- 110
-sbi e2 111
-sbi e- 112
-sbs e2 113
-sbs e- 114
-sbu e2 115
-sbu e- 116
-sde e2 117
-sdf e2 118
-sdl ewP2 119
-sdl ewN2 120
-set e2 121
-set e- 122
-sig e- 123
-sil ewP2 124
-sil ewN2 125
-sim e- 126
-sli e2 127
-sli e- 128
-slu e2 129
-slu e- 130
-sri e2 131
-sri e- 132
-sru e2 133
-sru e- 134
-sti e2 135
-sts e2 136
-sts e- 137
-str esP 1 138
-tge e- 139
-tle e- 140
-trp e- 141
-xor e2 142
-xor e- 143
-zer e2 144
-zer e- 145
-zge e2 146
-zgt e2 147
-zle e2 148
-zlt e2 149
-zne e2 150
-zrf e2 151
-zrf e- 152
-zrl ewP2 153
-dch e- 154
-exg esP 1 155
-exg e2 156
-exg e- 157
-lpb e- 158
-gto e2 159
-ldc 4 0
+++ /dev/null
-# $Header$
-d=../../..
-h=$d/h
-PEM=$d/lib/pc_pem
-PEM_OUT=$d/lib/pc_pem.out
-
-HEAD=$h/em_spec.h $h/em_pseu.h $h/em_mnem.h $h/em_mes.h $h/pc_size.h
-LDFLAG=-i
-
-all: pem pem.out
-
-pem.out: pem.m
- apc -mint --t -o pem.out pem.m
-
-pem: pem.m
- apc $(LDFLAG) -o pem pem.m
-
-# pem.m is system dependent and may NOT be distributed
-pem.m: pem.p $(HEAD)
- -rm -f pem.m
- -if apc -I$h -O -c.m pem.p ; then :; else \
- acc -o move move.c ; move ; rm move move.[oskm] ; \
- fi
-
-cmp: pem
- cmp pem $(PEM)
-
-install: pem
- cp pem $(PEM)
-
-distr:
- ln pem.p pem22.p ; apc -mpdp -c.m -I$h pem22.p ; rm pem22.p
- ln pem.p pem24.p ; apc -mvax2 -c.m -I$h pem24.p ; rm pem24.p
-clean:
- -rm -f pem pem.out *.[os] *.old
-
-pr:
- @pr pem.p
-
-xref:
- xref pem.p^pr -h "XREF PEM.P"
-
-opr:
- make pr ^ opr
+++ /dev/null
-/* A program to move the file pem??.m to pem.m */
-/* Called when "apc pem.p" fails. It is assumed that the binary
- file is incorrect in that case and has to be created from the compact
- code file.
- This program selects the correct compact code file for each combination
- of word and pointer size.
- It will return an error code if the move failed
-*/
-main(argc) {
- char copy[100] ;
-
- if ( argc!=1 ) {
- printf("No arguments allowed\n") ;
- exit(1) ;
- }
-
- sprintf(copy,"cp pem%d%d.m pem.m", EM_WSIZE, EM_PSIZE) ;
- printf("%s\n",copy) ;
- return system(copy) ;
-}
+++ /dev/null
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_mnem.h>
-#include <em_mes.h>
-#include <em_reg.h>
-#include <pc_size.h>
-
-{
- (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
-
- This product is part of the Amsterdam Compiler Kit.
-
- Permission to use, sell, duplicate or disclose this software must be
- obtained in writing. Requests for such permissions may be sent to
-
- Dr. Andrew S. Tanenbaum
- Wiskundig Seminarium
- Vrije Universiteit
- Postbox 7161
- 1007 MC Amsterdam
- The Netherlands
-
-}
-
-{if next line is included the compiler itself is written in standard pascal}
-{#define STANDARD 1}
-
-{Author: Johan Stevenson Version: 32}
-{$l- : no source line numbers}
-{$r- : no subrange checking}
-{$a- : no assertion checking}
-#ifdef STANDARD
-{$s+ : test conformancy to standard}
-#endif
-
-program pem(input,em,errors);
-{ This Pascal compiler produces EM code as described in
- - A.S.Tanenbaum, J.W.Stevenson & H. van Staveren,
- "Description of a machine architecture for use with
- block structured languages" Informatika rapport 81.
- NOTE: this version is modified to produce the modified EM code of
- januari 1981. it is not possible, using this compiler, to generate
- code for machines with 1 or 4 byte wordsize.
- A description of Pascal is given in
- - K.Jensen & N.Wirth, "PASCAL user manual and report", Springer-Verlag.
- Several options may be given in the normal pascal way. Moreover,
- a positive number may be used instead of + and -. The options are:
- a: interpret assertions (+)
- c: C-type strings allowed (-)
- d: type long may be used (-)
- i: controls the number of bits in integer sets (16)
- l: insert code to keep track of source lines (+)
- o: optimize (+)
- r: check subranges (+)
- s: accept only standard pascal programs (-)
- t: trace procedure entry and exit (-)
- u: treat '_' as letter (-)
-}
-{===================================================================}
-#ifdef STANDARD
-label 9999;
-#endif
-
-const
-{fundamental constants}
- MB1 = 7; MB2 = 15; {MB4 = 31}
- NB1 = 8; NB2 = 16; {NB4 = 32}
-
- MI1 = 127; MI2 = 32767; {MI4 = 2147483647}
- NI1 = 128; {NI2 = 32768} {NI4 = 2147483648}
-
- MU1 = 255; {MU2 = 65535} {MU4 = 4294967295}
- NU1 = 256; {NU2 = 65536} {NU4 = 4294967296}
-
-{maximal indices}
- idmax = 8;
- fnmax = 14;
- smax = 72;
-
-{opt values}
- off = 0;
- on = 1;
-
-{for push and pop: }
- global = false;
- local = true;
-
-{for sizeof and posaddr: }
- wordmult = false;
- wordpart = true;
-
-{ASCII characters}
- ascht = 9;
- ascnl = 10;
- ascvt = 11;
- ascff = 12;
- asccr = 13;
-
-{miscellaneous}
- maxcharord = 127; {maximal ordinal number of chars}
- maxargc = 13; {maximal index in argv}
- rwlim = 34; {number of reserved words}
- spaces = ' ';
-
-{-------------------------------------------------------------------}
-type
-{scalar types}
- symbol= (comma,semicolon,colon1,colon2,notsy,lbrack,ident,
- intcst,charcst,realcst,longcst,stringcst,nilcst,minsy,
- plussy,lparent,arrow,arraysy,recordsy,setsy,filesy,
- packedsy,progsy,labelsy,constsy,typesy,varsy,procsy,
- funcsy,beginsy,gotosy,ifsy,whilesy,repeatsy,forsy,
- withsy,casesy,becomes,starsy,divsy,modsy,slashsy,
- andsy,orsy,eqsy,nesy,gtsy,gesy,ltsy,
- lesy,insy,endsy,elsesy,untilsy,ofsy,dosy,
- downtosy,tosy,thensy,rbrack,rparent,period
- ); {the order is important}
- chartype= (lower,upper,digit,layout,tabch,
- quotech,dquotech,colonch,periodch,lessch,
- greaterch,lparentch,lbracech,
- {different entries}
- rparentch,lbrackch,rbrackch,commach,semich,arrowch,
- plusch,minch,slash,star,equal,
- {also symbols}
- others
- );
- standpf= (pread,preadln,pwrite,pwriteln,pput,pget,
- preset,prewrite,pnew,pdispose,ppack,punpack,
- pmark,prelease,ppage,phalt,
- {all procedures}
- feof,feoln,fabs,fsqr,ford,fchr,fpred,fsucc,fodd,
- ftrunc,fround,fsin,fcos,fexp,fsqt,flog,fatn
- {all functions}
- ); {the order is important}
- libmnem= (ELN ,EFL ,CLS ,WDW , {input and output}
- OPN ,GETX,RDI ,RDC ,RDR ,RDL ,RLN ,
- {on inputfiles}
- CRE ,PUTX,WRI ,WSI ,WRC ,WSC ,WRS ,WSS ,WRB ,
- WSB ,WRR ,WSR ,WRL, WSL, WRF ,WRZ ,WSZ ,WLN ,PAG ,
- {on outputfiles, order important}
- ABR ,RND ,SINX,COSX,EXPX,SQT ,LOG ,ATN ,
- {floating point}
- ABI ,ABL ,BCP ,BTS ,NEWX,SAV ,RST ,INI ,HLT ,
- ASS ,GTO ,PAC ,UNP, DIS, ASZ, MDI, MDL
- {miscellaneous}
- );
- structform= (scalar,subrange,pointer,power,files,arrays,carray,
- records,variant,tag); {order important}
- structflag= (spack,withfile);
- identflag= (refer,used,assigned,noreg,loopvar,samesect);
- idclass= (types,konst,vars,field,carrbnd,proc,func);
- kindofpf= (standard,formal,actual,extern,varargs,forward);
- where= (blck,rec,wrec);
- attrkind= (cst,fixed,pfixed,loaded,ploaded,indexed);
- twostruct= (eq,subeq,ir,ri,il,li,lr,rl,es,se,noteq); {order important}
-
-{subrange types}
- rwrange= 0..rwlim;
- byte= 0..MU1;
-
-{pointer types}
- sp= ^structure;
- ip= ^identifier;
- lp= ^labl;
- bp= ^blockinfo;
- np= ^nameinfo;
-
-{set types}
- sos= set of symbol;
- setofids= set of idclass;
- formset= set of structform;
- sflagset= set of structflag;
- iflagset= set of identflag;
-
-{array types}
- idarr=packed array[1..idmax] of char;
- fnarr=packed array[1..fnmax] of char;
-
-{record types}
- position=record {the addr info of certain variable}
- ad:integer; {for locals it is the byte offset}
- lv:integer; {the level of the beast}
- end;
-
-{records of type attr are used to remember qualities of
- expression parts to delay the loading of them.
- Reasons to delay the loading of one word constants:
- - bound checking
- - set building.
- Reasons to delay the loading of direct accessible objects:
- - efficient handling of read/write
- - efficient handling of the with statement.
-}
- attr=record
- asp:sp; {type of expression}
- packbit:boolean; {true for part of packed structure}
- ak:attrkind; {access method}
- pos:position; {lv and ad}
- {If ak=cst then the value is stored in ad}
- end;
-
- nameinfo=record {one for each separate name space}
- nlink:np; {one deeper}
- fname:ip; {first name: root of tree}
- case occur:where of
- blck:();
- rec: ();
- wrec:(wa:attr) {name space opened by with statement}
- end;
-
- blockinfo=record {all info of the current procedure}
- nextbp:bp; {pointer to blockinfo of surrounding proc}
- reglb:integer; {data location counter (from begin of proc) }
- minlb:integer; {keeps track of minimum of reglb}
- ilbno:integer; {number of last local label}
- forwcount:integer; {number of not yet specified forward procs}
- lchain:lp; {first label: header of chain}
- end;
-
- structure=record
- size:integer; {size of structure in bytes}
- sflag:sflagset; {flag bits}
- case form:structform of
- scalar :(scalno:integer; {number of range descriptor}
- fconst:ip {names of constants}
- );
- subrange:(min,max:integer; {lower and upper bound}
- rangetype:sp; {type of bounds}
- subrno:integer {number of subr descriptor}
- );
- pointer :(eltype:sp); {type of pointed object}
- power :(elset:sp); {type of set elements}
- files :(filtype:sp); {type of file elements}
- arrays,carray:
- (aeltype:sp; {type of array elements}
- inxtype:sp; {type of array index}
- arpos:position {position of array descriptor}
- );
- records :(fstfld:ip; {points to first field}
- tagsp:sp {points to tag if present}
- );
- variant :(varval:integer; {tag value for this variant}
- nxtvar:sp; {next equilevel variant}
- subtsp:sp {points to tag for sub-case}
- );
- tag :(fstvar:sp; {first variant of case}
- tfldsp:sp {type of tag}
- )
- end;
-
- identifier=record
- idtype:sp; {type of identifier}
- name:idarr; {name of identifier}
- llink,rlink:ip; {see enterid,searchid}
- next:ip; {used to make several chains}
- iflag:iflagset; {several flag bits}
- case klass:idclass of
- types :();
- konst :(value:integer); {for integers the value is
- computed and stored in this field.
- For strings and reals an assembler constant is
- defined labeled '.1', '.2', ... This '.' number is then
- stored in value. For reals value may be negated to
- indicate that the opposite of the assembler constant
- is needed. }
- vars :(vpos:position); {position of var}
- field :(foffset:integer); {offset to begin of record}
- carrbnd :(); {idtype points to carray struct}
- proc,func:
- (case pfkind:kindofpf of
- standard:(key:standpf); {identification}
- formal,actual,forward,extern,varargs:
- (pfpos:position; {lv gives declaration level.
- ad is relevant for formal pf's and for
- functions (no conflict!!).
- for functions: ad is the result address.
- for formal pf's: ad is the address of the
- descriptor }
- pfno:integer; {unique pf number}
- maxlb:integer; {bytes of parameters}
- parhead:ip {head of parameter list}
- )
- )
- end;
-
- labl=record
- nextlp:lp; {chain of labels}
- seen:boolean;
- labval:integer; {label number given by the programmer}
- labname:integer; {label number given by the compiler}
- labdlb:integer {zero means only locally used,
- otherwise dlbno of label information}
- end;
-
-{-------------------------------------------------------------------}
-var {the most frequent used externals are declared first}
- sy:symbol; {last symbol}
- a:attr; {type,access method,position,value of expr}
-{returned by insym}
- ch:char; {last character}
- chsy:chartype; {type of ch, used by insym}
- val:integer; {if last symbol is an constant }
- ix:integer; {string length}
- eol:boolean; {true of current ch is a space, replacing a newline}
- zerostring:boolean; {true for strings in " "}
- id:idarr; {if last symbol is an identifier}
-{some counters}
- lino:integer; {line number on code file (1..n) }
- dlbno:integer; {number of last global number}
- holeb:integer; {size of hol-area}
- level:integer; {current static level}
- argc:integer; {index in argv}
- lastpfno:integer; {unique pf number counter}
- copt:integer; {C-type strings allowed if on}
- dopt:integer; {longs allowed if on}
- iopt:integer; {number of bits in sets with base integer}
- sopt:integer; {standard option}
- srcchno:integer; {column count for errors}
- srclino:integer; {source line number after preprocessing}
- srcorig:integer; {source line number before preprocessing}
- fildlb:integer; {label number of source string}
-{pointers pointing to standard types}
- realptr,intptr,textptr,nullset,boolptr:sp;
- charptr,nilptr,zeroptr,procptr,longptr:sp;
-{flags}
- giveline:boolean; {give source line number at next statement}
- including:boolean; {no LIN's for included code}
- eofexpected:boolean; {quit without error if true (nextch) }
- main:boolean; {complete programme or a module}
- intypedec:boolean; {true if nested in typedefinition}
- fltused:boolean; {true if floating point instructions are used}
- seconddot:boolean; {indicates the second dot of '..'}
-{pointers}
- fwptr:ip; {head of chain of forward reference pointers}
- progp:ip; {program identifier}
- currproc:ip; {current procedure/function ip (see selector)}
- top:np; {pointer to the most recent name space}
- lastnp:np; {pointer to nameinfo of last searched ident }
-{records}
- b:blockinfo; {all info to be stacked at pfdeclaration}
- fa:attr; {attr for current file name}
-{arrays}
- sizes:array[0 .. sz_last] of integer;
- strbuf:array[1..smax] of char;
- rw:array[rwrange] of idarr;
- {reserved words}
- frw:array[0..idmax] of integer;
- {indices in rw}
- rsy:array[rwrange] of symbol;
- {symbol for reserved words}
- cs:array[char] of chartype;
- {chartype of a character}
- csy:array[rparentch..equal] of symbol;
- {symbol for single character symbols}
- lmn:array[libmnem] of packed array[1..4] of char;
- {mnemonics of pascal library routines}
- opt:array['a'..'z'] of integer;
- forceopt:array['a'..'z'] of boolean;
- {26 different options}
- undefip:array[idclass] of ip;
- {used in searchid}
- iop:array[boolean] of ip;
- {false:standard input, true:standard output}
- argv:array[0..maxargc] of
- record name:idarr; ad:integer end;
- {save here the external heading names}
-{files}
- em:file of byte; {the EM code}
- errors:text; {the compilation errors}
- source:fnarr;
-
-{===================================================================}
-
-procedure initpos(var p:position);
-begin p.lv:=level; p.ad:=0; end;
-
-procedure inita(fsp:sp; fad:integer);
-begin with a do begin
- asp:=fsp; packbit:=false; ak:=fixed; pos.ad:=fad; pos.lv:=level;
-end end;
-
-function newip(kl:idclass; n:idarr; idt:sp; nxt:ip):ip;
-var p:ip; f:iflagset;
-begin f:=[];
- case kl of
- types,carrbnd: {similar structure}
- new(p,types);
- konst:
- begin new(p,konst); p^.value:=0 end;
- vars:
- begin new(p,vars); f:=[used,assigned]; initpos(p^.vpos) end;
- field:
- begin new(p,field); p^.foffset:=0 end;
- proc,func: {same structure}
- begin new(p,proc,actual); p^.pfkind:=actual;
- initpos(p^.pfpos); p^.pfno:=0; p^.maxlb:=0; p^.parhead:=nil;
- end
- end;
- p^.name:=n; p^.klass:=kl; p^.idtype:=idt; p^.next:=nxt;
- p^.llink:=nil; p^.rlink:=nil; p^.iflag:=f; newip:=p
-end;
-
-function newsp(sf:structform; sz:integer):sp;
-var p:sp; sflag:sflagset;
-begin sflag:=[];
- case sf of
- scalar:
- begin new(p,scalar); p^.scalno:=0; p^.fconst:=nil end;
- subrange:
- new(p,subrange);
- pointer:
- begin new(p,pointer); p^.eltype:=nil end;
- power:
- new(p,power);
- files:
- begin new(p,files); sflag:=[withfile] end;
- arrays,carray: {same structure}
- new(p,arrays);
- records:
- new(p,records);
- variant:
- new(p,variant);
- tag:
- new(p,tag);
- end;
- p^.form:=sf; p^.size:=sz; p^.sflag:=sflag; newsp:=p;
-end;
-
-function sizeof(fsp:sp; partword:boolean):integer;
-var s:integer;
-begin if fsp=nil then s:=0 else s:=fsp^.size;
- if s<>0 then
- if partword and (s<sz_word) then
- while sz_word mod s <> 0 do s:=s+1
- else
- while s mod sz_word <> 0 do s:=s+1;
- sizeof:=s
-end;
-
-function formof(fsp:sp; forms:formset):boolean;
-begin if fsp=nil then formof:=false else formof:=fsp^.form in forms end;
-
-{===================================================================}
-
-procedure put1(b:byte);
-begin write(em,b) end;
-
-procedure put2(i:integer);
-var i1,i2:byte;
-begin
- if i<0 then
- begin i:=-(i+1); i1:=MU1 - i mod NU1; i2:=MU1 - i div NU1 end
- else
- begin i1:=i mod NU1; i2:=i div NU1 end;
- put1(i1); put1(i2)
-end;
-
-procedure argend;
-begin put1(sp_cend) end;
-
-procedure argcst(i:integer);
-begin
- if (i >= -sp_zcst0) and (i < sp_ncst0-sp_zcst0) then
- put1(i + sp_zcst0 + sp_fcst0)
- else
- begin put1(sp_cst2); put2(i) end
-end;
-
-procedure argnil;
-begin put1(sp_icon); argcst(sz_addr); argcst(1); put1(ord('0')) end;
-
-procedure argilb(i:integer);
-begin
- if i<=MU1 then
- begin put1(sp_ilb1); put1(i) end
- else
- begin put1(sp_ilb2); put2(i) end
-end;
-
-procedure argdlb(i:integer);
-begin
- if i<=MU1 then
- begin put1(sp_dlb1); put1(i) end
- else
- begin put1(sp_dlb2); put2(i) end
-end;
-
-procedure argident(var a:idarr);
-var i,j:integer;
-begin i:=idmax;
- while (a[i]=' ') and (i>1) do i:=i-1;
- put1(sp_pnam); argcst(i);
- for j:=1 to i do put1(ord(a[j]))
-end;
-
-procedure genop(b:byte);
-begin put1(b); lino:=lino+1 end;
-
-procedure gencst(b:byte; i:integer);
-begin genop(b); argcst(i) end;
-
-procedure gensp(m:libmnem; s:integer);
-var i:integer;
-begin genop(op_cal); put1(sp_pnam); argcst(4);
- for i:=1 to 4 do put1(ord(lmn[m][i]));
- gencst(op_asp,s)
-end;
-
-procedure genpnam(b:byte; fip:ip);
-var n:idarr; i,j:integer;
-begin
- if fip^.pfpos.lv<=1 then n:=fip^.name else
- begin n:='_ '; j:=1; i:=fip^.pfno;
- while i<>0 do
- begin j:=j+1; n[j]:=chr(i mod 10 + ord('0')); i:=i div 10 end;
- end;
- genop(b); argident(n)
-end;
-
-procedure genasp(m:byte);
-begin gencst(m,sizeof(a.asp,wordmult)) end;
-
-procedure genlin;
-begin giveline:=false;
- if opt['l']<>off then if main then gencst(op_lin,srcorig)
-end;
-
-procedure genreg(sz,ad,regval:integer);
-begin gencst(ps_mes,ms_reg);
- argcst(ad); argcst(sz); argcst(regval); argend
-end;
-
-procedure laedlb(d:integer);
-begin genop(op_lae); argdlb(d) end;
-
-procedure exchange(l1,l2:integer);
-var d1,d2:integer;
-begin d1:=l2-l1; d2:=lino-l2;
- if (d1<>0) and (d2<>0) then
- begin gencst(ps_exc,d1); argcst(d2) end
-end;
-
-procedure newilb(i:integer);
-begin lino:=lino+1;
- if i<sp_nilb0 then put1(i+sp_filb0) else argilb(i)
-end;
-
-function newdlb:integer;
-begin lino:=lino+1; dlbno:=dlbno+1; argdlb(dlbno); newdlb:=dlbno end;
-
-function romstr(typ:byte; siz:integer):integer;
-var i:integer;
-begin romstr:=newdlb; genop(ps_rom);
- put1(typ); if typ<>sp_scon then argcst(siz); argcst(ix);
- for i:=1 to ix do put1(ord(strbuf[i])); argend
-end;
-
-{===================================================================}
-
-procedure error(err:integer);
-{as you will notice, all error numbers are preceded by '+' and '0' to
- ease their renumbering in case of new errornumbers.
-}
-begin writeln(errors,err,srclino,srcchno);
- if err>0 then begin gencst(ps_mes,ms_err); argend end
-end;
-
-procedure errid(err:integer; var id:idarr);
-begin write(errors,'''',id); error(err) end;
-
-procedure errint(err:integer; i:integer);
-begin write(errors,i:1); error(err) end;
-
-procedure errasp(err:integer);
-begin if a.asp<>nil then begin error(err); a.asp:=nil end end;
-
-procedure teststandard;
-begin if sopt<>off then error(-(+01)) end;
-
-procedure enterid(fip: ip);
-{enter id pointed at by fip into the name-table,
- which on each declaration level is organised as
- an unbalanced binary tree}
-var nam:idarr; lip,lip1:ip; lleft,again:boolean;
-begin nam:=fip^.name; again:=false; assert nam[1]<>' ';
- lip:=top^.fname;
- if lip=nil then top^.fname:=fip else
- begin
- repeat lip1:=lip;
- if lip^.name>nam then
- begin lip:=lip^.llink; lleft:=true end
- else
- begin if lip^.name=nam then again:=true; {name conflict}
- lip:=lip^.rlink; lleft:=false;
- end;
- until lip=nil;
- if lleft then lip1^.llink:=fip else lip1^.rlink:=fip
- end;
- fip^.llink:=nil; fip^.rlink:=nil;
- if again then errid(+02,nam);
-end;
-
-{===================================================================}
-
-procedure trace(tname:idarr; fip:ip; var namdlb:integer);
-var i:integer;
-begin
- if opt['t']<>off then
- begin
- if namdlb=0 then
- begin namdlb:=newdlb; genop(ps_rom); put1(sp_scon); argcst(8);
- for i:=1 to 8 do put1(ord(fip^.name[i])); argend;
- end;
- laedlb(namdlb); genop(op_cal); argident(tname);
- gencst(op_asp,sz_addr);
- end;
-end;
-
-procedure expandnullset(fsp:sp);
-var s:integer;
-begin s:=sizeof(fsp,wordmult)-sz_word;
- if s<>0 then gencst(op_zer,s); a.asp:=fsp
-end;
-
-procedure push(local:boolean; ad:integer; sz:integer);
-begin assert sz mod sz_word = 0;
- if sz=sz_word then
- if local then gencst(op_lol,ad) else gencst(op_loe,ad)
- else if sz=2*sz_word then
- if local then gencst(op_ldl,ad) else gencst(op_lde,ad)
- else
- begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
- gencst(op_loi,sz)
- end
-end;
-
-procedure pop(local:boolean; ad:integer; sz:integer);
-begin assert sz mod sz_word = 0;
- if sz=sz_word then
- if local then gencst(op_stl,ad) else gencst(op_ste,ad)
- else if sz=2*sz_word then
- if local then gencst(op_sdl,ad) else gencst(op_sde,ad)
- else
- begin if local then gencst(op_lal,ad) else gencst(op_lae,ad);
- gencst(op_sti,sz)
- end
-end;
-
-procedure lexaddr(lv:integer; ad:integer);
-begin assert level>=lv;
- if ad>=0 then gencst(op_lxa,level-lv) else gencst(op_lxl,level-lv);
- gencst(op_adp,ad)
-end;
-
-procedure loadpos(var p:position; sz:integer);
-begin with p do
- if lv<=0 then push(global,ad,sz) else
- if lv=level then push(local,ad,sz) else
- begin lexaddr(lv,ad); gencst(op_loi,sz) end;
-end;
-
-procedure descraddr(var p:position);
-begin if p.lv=0 then laedlb(p.ad) else loadpos(p,sz_addr) end;
-
-procedure loadaddr;
-begin with a,pos do begin
- case ak of
- fixed:
- if lv<=0 then gencst(op_lae,ad) else
- if lv=level then gencst(op_lal,ad) else lexaddr(lv,ad);
- pfixed:
- loadpos(pos,sz_addr);
- ploaded:
- ;
- indexed:
- gencst(op_aar,sz_word);
- end; {case}
- ak:=ploaded;
-end end;
-
-procedure load;
-var sz:integer;
-begin with a do begin sz:=sizeof(asp,packbit);
- if asp<>nil then
- case ak of
- cst:
- gencst(op_loc,pos.ad); {only one-word scalars}
- fixed:
- loadpos(pos,sz);
- pfixed:
- begin loadpos(pos,sz_addr); gencst(op_loi,sz) end;
- loaded:
- ;
- ploaded:
- gencst(op_loi,sz);
- indexed:
- gencst(op_lar,sz_word);
- end; {case}
- ak:=loaded;
-end end;
-
-procedure store;
-var sz:integer;
-begin with a,pos do begin sz:=sizeof(asp,packbit);
- if asp<>nil then
- case ak of
- fixed:
- if lv<=0 then pop(global,ad,sz) else
- if level=lv then pop(local,ad,sz) else
- begin lexaddr(lv,ad); gencst(op_sti,sz) end;
- pfixed:
- begin loadpos(pos,sz_addr); gencst(op_sti,sz) end;
- ploaded:
- gencst(op_sti,sz);
- indexed:
- gencst(op_sar,sz_word);
- end; {case}
-end end;
-
-procedure fieldaddr(off:integer);
-begin with a do
- if (ak=fixed) and not packbit then pos.ad:=pos.ad+off else
- begin loadaddr; gencst(op_adp,off) end
-end;
-
-procedure loadcheap;
-begin if formof(a.asp,[arrays..records]) then loadaddr else load end;
-
-{===================================================================}
-
-procedure nextch;
-begin
- eol:=eoln(input); read(input,ch); srcchno:=srcchno+1; chsy:=cs[ch];
-end;
-
-procedure nextln;
-begin
- if eof(input) then
- begin
- if not eofexpected then error(+03) else
- if fltused then begin gencst(ps_mes,ms_flt); argend end;
-#ifdef STANDARD
- goto 9999
-#else
- halt
-#endif
- end;
- srcchno:=0; srclino:=srclino+1;
- if not including then
- begin srcorig:=srcorig+1; giveline:=true end;
-end;
-
-procedure options(normal:boolean);
-var ci:char; i:integer;
-
-procedure getc;
-begin if normal then nextch else read(errors,ch) end;
-
-begin
- repeat getc;
- if (ch>='a') and (ch<='z') then
- begin ci:=ch; getc; i:=0;
- if ch='+' then begin i:=1; getc end else
- if ch='-' then getc else
- if cs[ch]=digit then
- repeat i:=i*10 + ord(ch) - ord('0'); getc;
- until cs[ch]<>digit
- else i:=-1;
- if i>=0 then
- if not normal then
- begin forceopt[ci]:=true; opt[ci]:=i end
- else
- if not forceopt[ci] then opt[ci]:=i;
- end;
- until ch<>',';
-end;
-
-procedure linedirective;
-var i:integer; fname:fnarr;
-begin
- repeat nextch until (ch='"') or eol;
- if eol then error(+04) else
- begin nextch; i:=0;
- while (ch<>'"') and not eol do
- begin
- if ch='/' then i:=0 else
- begin i:=i+1; if i<=fnmax then fname[i]:=ch end;
- nextch
- end;
- while i<fnmax do begin i:=i+1; fname[i]:=' ' end;
- including:=fname<>source; while not eol do nextch
- end;
-end;
-
-procedure putdig;
-begin ix:=ix+1; if ix<=smax then strbuf[ix]:=ch; nextch end;
-
-procedure inident;
-label 1;
-var i,k:integer;
-begin k:=0; id:=spaces;
- repeat
- if chsy=upper then ch:=chr(ord(ch)-ord('A')+ord('a'));
- if k<idmax then begin k:=k+1; id[k]:=ch end;
- nextch
- until chsy>digit;
- {lower=0,upper=1,digit=2. ugly but fast}
- for i:=frw[k-1] to frw[k] - 1 do
- if rw[i]=id then
- begin sy:=rsy[i]; goto 1 end;
- sy:=ident;
-1:
-end;
-
-procedure innumber;
-label 1;
-const imax = 10;
- maxintstring = '0000032767';
- maxlongstring = '2147483647';
-var i,j:integer;
- is:packed array[1..imax] of char;
-begin ix:=0; sy:=intcst; val:=0;
- repeat putdig until chsy<>digit;
- if (ch='.') or (ch='e') or (ch='E') then
- begin
- if ch='.' then
- begin putdig;
- if ch='.' then
- begin seconddot:=true; ix:=ix-1; goto 1 end;
- if chsy<>digit then error(+05) else
- repeat putdig until chsy<>digit;
- end;
- if (ch='e') or (ch='E') then
- begin putdig;
- if (ch='+') or (ch='-') then putdig;
- if chsy<>digit then error(+06) else
- repeat putdig until chsy<>digit;
- end;
- if ix>smax then begin error(+07); ix:=smax end;
- sy:=realcst; fltused:=true; val:=romstr(sp_fcon,sz_real);
- end;
-1:if (chsy=lower) or (chsy=upper) then teststandard;
- if sy=intcst then
- if ix>imax then error(+08) else
- begin is:='0000000000'; i:=ix; j:=imax;
- repeat is[j]:=strbuf[i]; j:=j-1; i:=i-1 until i=0;
- if is<=maxintstring then
- repeat j:=j+1; val:=val*10 - ord('0') + ord(is[j]) until j=imax
- else if (is<=maxlongstring) and (dopt<>off) then
- begin sy:=longcst; val:=romstr(sp_icon,sz_long) end
- else error(+09)
- end
-end;
-
-procedure instring(qc:char);
-begin ix:=0; zerostring:=qc='"';
- repeat
- repeat nextch; ix:=ix+1; if ix<=smax then strbuf[ix]:=ch;
- until (ch=qc) or eol;
- if ch=qc then nextch else error(+010);
- until ch<>qc;
- if not zerostring then
- begin ix:=ix-1; if ix=0 then error(+011) end
- else
- begin strbuf[ix]:=chr(0); if copt=off then error(+012) end;
- if (ix=1) and not zerostring then
- begin sy:=charcst; val:=ord(strbuf[1]) end
- else
- begin if ix>smax then begin error(+013); ix:=smax end;
- sy:=stringcst; val:=romstr(sp_scon,0);
- end
-end;
-
-procedure incomment;
-var stopc:char;
-begin nextch; stopc:='}';
- if ch='$' then options(true);
- while (ch<>'}') and (ch<>stopc) do
- begin stopc:='}'; if ch='*' then stopc:=')';
- if eol then nextln; nextch
- end;
- if ch<>'}' then teststandard;
- nextch
-end;
-
-procedure insym;
- {read next basic symbol of source program and return its
- description in the global variables sy, op, id, val and ix}
-label 1;
-begin
-1:case chsy of
- tabch:
- begin srcchno:=srcchno - srcchno mod 8 + 8; nextch; goto 1 end;
- layout:
- begin if eol then nextln; nextch; goto 1 end;
- lower,upper: inident;
- digit: innumber;
- quotech,dquotech:
- instring(ch);
- colonch:
- begin nextch;
- if ch='=' then begin sy:=becomes; nextch end else sy:=colon1
- end;
- periodch:
- begin nextch;
- if seconddot then begin seconddot:=false; sy:=colon2 end else
- if ch='.' then begin sy:=colon2; nextch end else sy:=period
- end;
- lessch:
- begin nextch;
- if ch='=' then begin sy:=lesy; nextch end else
- if ch='>' then begin sy:=nesy; nextch end else sy:=ltsy
- end;
- greaterch:
- begin nextch;
- if ch='=' then begin sy:=gesy; nextch end else sy:=gtsy
- end;
- lparentch:
- begin nextch;
- if ch<>'*' then sy:=lparent else
- begin teststandard; incomment; goto 1 end;
- end;
- lbracech:
- begin incomment; goto 1 end;
- rparentch,lbrackch,rbrackch,commach,semich,arrowch,
- plusch,minch,slash,star,equal:
- begin sy:=csy[chsy]; nextch end;
- others:
- begin
- if (ch='#') and (srcchno=1) then linedirective else
- begin error(+014); nextch end;
- goto 1
- end;
- end {case}
-end;
-
-procedure nextif(fsy:symbol; err:integer);
-begin if sy=fsy then insym else error(-err) end;
-
-function find1(sys1,sys2:sos; err:integer):boolean;
-{symbol of sys1 expected. return true if sy in sys1}
-begin
- if not (sy in sys1) then
- begin error(err); while not (sy in sys1+sys2) do insym end;
- find1:=sy in sys1
-end;
-
-function find2(sys1,sys2:sos; err:integer):boolean;
-{symbol of sys1+sys2 expected. return true if sy in sys1}
-begin
- if not (sy in sys1+sys2) then
- begin error(err); repeat insym until sy in sys1+sys2 end;
- find2:=sy in sys1
-end;
-
-function find3(sy1:symbol; sys2:sos; err:integer):boolean;
-{symbol sy1 or one of sys2 expected. return true if sy1 found and skip it}
-begin find3:=true;
- if not (sy in [sy1]+sys2) then
- begin error(err); repeat insym until sy in [sy1]+sys2 end;
- if sy=sy1 then insym else find3:=false
-end;
-
-function endofloop(sys1,sys2:sos; sy3:symbol; err:integer):boolean;
-begin endofloop:=false;
- if find2(sys2+[sy3],sys1,err) then nextif(sy3,err+1)
- else endofloop:=true;
-end;
-
-function lastsemicolon(sys1,sys2:sos; err:integer):boolean;
-begin lastsemicolon:=true;
- if not endofloop(sys1,sys2,semicolon,err) then
- if find2(sys2,sys1,err+2) then lastsemicolon:=false
-end;
-
-{===================================================================}
-
-function searchid(fidcls: setofids):ip;
-{search for current identifier symbol in the name table}
-label 1;
-var lip:ip; ic:idclass;
-begin lastnp:=top;
- while lastnp<>nil do
- begin lip:=lastnp^.fname;
- while lip<>nil do
- if lip^.name=id then
- if lip^.klass in fidcls then
- begin
- if lip^.klass=vars then if lip^.vpos.lv<>level then
- lip^.iflag:=lip^.iflag+[noreg];
- goto 1
- end
- else lip:=lip^.rlink
- else
- if lip^.name< id then lip:=lip^.rlink else lip:=lip^.llink;
- lastnp:=lastnp^.nlink;
- end;
- errid(+015,id);
- if types in fidcls then ic:=types else
- if vars in fidcls then ic:=vars else
- if konst in fidcls then ic:=konst else
- if proc in fidcls then ic:=proc else
- if func in fidcls then ic:=func else ic:=field;
- lip:=undefip[ic];
-1:
- searchid:=lip
-end;
-
-function searchsection(fip: ip):ip;
-{to find record fields and forward declared procedure id's
- -->procedure pfdeclaration
- -->procedure selector}
-label 1;
-begin
- while fip<>nil do
- if fip^.name=id then goto 1 else
- if fip^.name< id then fip:=fip^.rlink else fip:=fip^.llink;
-1: searchsection:=fip
-end;
-
-function searchlab(flp:lp; val:integer):lp;
-label 1;
-begin
- while flp<>nil do
- if flp^.labval=val then goto 1 else flp:=flp^.nextlp;
-1:searchlab:=flp
-end;
-
-procedure opconvert(ts:twostruct);
-var op:integer;
-begin with a do begin genasp(op_loc);
- case ts of
- ir, lr: begin asp:=realptr; op:=op_cif; fltused:=true end;
- ri: begin asp:=intptr ; op:=op_cfi; fltused:=true end;
- rl: begin asp:=longptr; op:=op_cfi; fltused:=true end;
- li: begin asp:=intptr ; op:=op_cii end;
- il: begin asp:=longptr; op:=op_cii end;
- end;
- genasp(op_loc); genop(op)
-end end;
-
-procedure negate;
-begin if a.asp=realptr then genasp(op_ngf) else genasp(op_ngi) end;
-
-function desub(fsp:sp):sp;
-begin if formof(fsp,[subrange]) then fsp:=fsp^.rangetype; desub:=fsp end;
-
-function nicescalar(fsp:sp):boolean;
-begin
- if fsp=nil then nicescalar:=true else
- nicescalar:=(fsp^.form=scalar) and (fsp<>realptr) and (fsp<>longptr)
-end;
-
-function bounded(fsp:sp):boolean;
-begin bounded:=false;
- if fsp<>nil then
- if fsp^.form=subrange then bounded:=true else
- if fsp^.form=scalar then bounded:=fsp^.fconst<>nil
-end;
-
-procedure bounds(fsp:sp; var fmin,fmax:integer);
-begin
- if fsp=nil then
- begin fmin:=0; fmax:=0 end
- else
- case fsp^.form of
- subrange:
- begin fmin:=fsp^.min; fmax:=fsp^.max end;
- scalar:
- begin fmin:=0; fmax:=fsp^.fconst^.value end
- end
-end;
-
-procedure genrck(fsp:sp);
-var min,max,sno:integer;
-begin
- if opt['r']<>off then if bounded(fsp) then
- begin
- if fsp^.form=scalar then sno:=fsp^.scalno else sno:=fsp^.subrno;
- if sno=0 then
- begin bounds(fsp,min,max); sno:=newdlb;
- gencst(ps_rom,min); argcst(max); argend;
- if fsp^.form=scalar then fsp^.scalno:=sno else fsp^.subrno:=sno
- end;
- laedlb(sno); gencst(op_rck,sz_word);
- end
-end;
-
-procedure checkbnds(fsp:sp);
-var min1,max1,min2,max2:integer;
-begin
- if bounded(fsp) then
- if not bounded(a.asp) then genrck(fsp) else
- begin bounds(fsp,min1,max1); bounds(a.asp,min2,max2);
- if (min2<min1) or (max2>max1) then
- genrck(fsp);
- end;
- a.asp:=fsp;
-end;
-
-function eqstruct(p,q:sp):boolean;
-begin eqstruct:=(p=q) or (p=nil) or (q=nil) end;
-
-function string(fsp:sp):boolean;
-var lsp:sp;
-begin string:=false;
- if formof(fsp,[arrays]) then
- if eqstruct(fsp^.aeltype,charptr) then
- if spack in fsp^.sflag then
- begin lsp:=fsp^.inxtype;
- if lsp=nil then string:=true else
- if lsp^.form=subrange then
- if lsp^.rangetype=intptr then
- if lsp^.min=1 then
- string:=true
- end
-end;
-
-function compat(p,q:sp):twostruct;
-begin compat:=noteq;
- if eqstruct(p,q) then compat:=eq else
- begin p:=desub(p); q:=desub(q);
- if eqstruct(p,q) then compat:=subeq else
- if p^.form=q^.form then
- case p^.form of
- scalar:
- if (p=intptr) and (q=realptr) then compat:=ir else
- if (p=realptr) and (q=intptr) then compat:=ri else
- if (p=intptr) and (q=longptr) then compat:=il else
- if (p=longptr) and (q=intptr) then compat:=li else
- if (p=longptr) and (q=realptr) then compat:=lr else
- if (p=realptr) and (q=longptr) then compat:=rl else
- ;
- pointer:
- if (p=nilptr) or (q=nilptr) then compat:=eq;
- power:
- if p=nullset then compat:=es else
- if q=nullset then compat:=se else
- if compat(p^.elset,q^.elset) <= subeq then
- if p^.sflag=q^.sflag then compat:=eq;
- arrays:
- if string(p) and string(q) and (p^.size=q^.size) then compat:=eq;
- files,carray,records: ;
- end;
- end
-end;
-
-procedure checkasp(fsp:sp; err:integer);
-var ts:twostruct;
-begin
- ts:=compat(a.asp,fsp);
- case ts of
- eq:
- if fsp<>nil then if withfile in fsp^.sflag then errasp(err);
- subeq:
- checkbnds(fsp);
- li:
- begin opconvert(ts); checkasp(fsp,err) end;
- il,rl,lr,ir:
- opconvert(ts);
- es:
- expandnullset(fsp);
- noteq,ri,se:
- errasp(err);
- end
-end;
-
-procedure force(fsp:sp; err:integer);
-begin load; checkasp(fsp,err) end;
-
-function newident(kl:idclass; idt:sp; nxt:ip; err:integer):ip;
-begin newident:=nil;
- if sy<>ident then error(err) else
- begin newident:=newip(kl,id,idt,nxt); insym end
-end;
-
-function stringstruct:sp;
-var lsp:sp;
-begin {only used when ix and zerostring are still valid}
- if zerostring then lsp:=zeroptr else
- begin lsp:=newsp(arrays,ix*sz_char); lsp^.sflag:=[spack];
- lsp^.aeltype:=charptr; lsp^.inxtype:=nil;
- end;
- stringstruct:=lsp;
-end;
-
-function posaddr(var lb:integer; fsp:sp; partword:boolean):integer;
-var sz:integer;
-begin sz:=sizeof(fsp,partword);
- if lb >= MI2-sz then begin error(+016); lb:=0 end;
- if not partword or (sz>=sz_word) then
- while lb mod sz_word <> 0 do lb:=lb+1;
- posaddr:=lb;
- lb:=lb+sz
-end;
-
-function negaddr(fsp:sp):integer;
-var sz:integer;
-begin with b do begin
- sz:=sizeof(fsp,wordmult);
- if reglb <= -MI2+sz then begin error(+017); reglb:=0 end;
- reglb:=reglb-sz;
- while reglb mod sz_word <> 0 do reglb:=reglb-1;
- if reglb < minlb then minlb:=reglb;
- negaddr:=reglb
-end end;
-
-procedure temporary(fsp:sp;r:integer);
-begin inita(fsp,negaddr(fsp));
- if r>=0 then genreg(sizeof(fsp,wordmult),a.pos.ad,r)
-end;
-
-procedure genhol;
-begin gencst(ps_hol,posaddr(holeb,nil,false));
- argcst(-MI2-1); argcst(0); level:=1
-end;
-
-function arraysize(fsp:sp; pack:boolean):integer;
-var sz,min,max,tot,n:integer;
-begin sz:=sizeof(fsp^.aeltype,pack);
- bounds(fsp^.inxtype,min,max);
- fsp^.arpos.lv:=0; fsp^.arpos.ad:=newdlb;
- gencst(ps_rom,min); argcst(max-min); argcst(sz); argend;
- n:=max-min+1; tot:=sz*n;
- if sz<>0 then if tot div sz <> n then begin error(+018); tot:=0 end;
- arraysize:=tot
-end;
-
-procedure treewalk(fip:ip);
-var lsp:sp; i,sz:integer;
-begin
- if fip<>nil then
- begin treewalk(fip^.llink); treewalk(fip^.rlink);
- if fip^.klass=vars then
- begin if not (used in fip^.iflag) then errid(-(+019),fip^.name);
- if not (assigned in fip^.iflag) then errid(-(+020),fip^.name);
- lsp:=fip^.idtype;
- if level<>1 then if not (noreg in fip^.iflag) then
- if (refer in fip^.iflag) or formof(lsp,[pointer]) then
- genreg(sz_addr,fip^.vpos.ad,reg_pointer)
- else
- begin sz:=sizeof(lsp,wordmult);
- if loopvar in fip^.iflag then
- genreg(sz,fip^.vpos.ad,reg_loop)
- else if lsp=realptr then
- genreg(sz,fip^.vpos.ad,reg_float)
- else
- genreg(sz,fip^.vpos.ad,reg_any);
- end;
- if lsp<>nil then if withfile in lsp^.sflag then
- if lsp^.form=files then
- if level=1 then
- begin
- for i:=2 to argc do with argv[i] do
- if name=fip^.name then ad:=fip^.vpos.ad
- end
- else
- begin
- if not (refer in fip^.iflag) then
- begin gencst(op_lal,fip^.vpos.ad); gensp(CLS,sz_addr)
- end
- end
- else
- if level<>1 then errid(-(+021),fip^.name)
- end
- end
-end;
-
-procedure constant(fsys:sos; var fsp:sp; var fval:integer);
-var signed,min:boolean; lip:ip;
-begin signed:=(sy=plussy) or (sy=minsy);
- if signed then begin min:=sy=minsy; insym end else min:=false;
- if find1([ident..stringcst],fsys,+022) then
- begin fval:=val;
- case sy of
- stringcst: fsp:=stringstruct;
- charcst: fsp:=charptr;
- intcst: fsp:=intptr;
- realcst: fsp:=realptr;
- longcst: fsp:=longptr;
- ident:
- begin lip:=searchid([konst]);
- fsp:=lip^.idtype; fval:=lip^.value;
- end
- end; {case}
- if signed then
- if (fsp<>intptr) and (fsp<>realptr) and (fsp<>longptr) then
- error(+023)
- else if min then fval:= -fval;
- {note: negating the v-number for reals and longs}
- insym;
- end
- else begin fsp:=nil; fval:=0 end;
-end;
-
-function cstinteger(fsys:sos; fsp:sp; err:integer):integer;
-var lsp:sp; lval,min,max:integer;
-begin constant(fsys,lsp,lval);
- if fsp<>lsp then
- if not eqstruct(desub(fsp),lsp) then
- begin error(err); lval:=0 end
- else if bounded(fsp) then
- begin bounds(fsp,min,max);
- if (lval<min) or (lval>max) then error(+024)
- end;
- cstinteger:=lval
-end;
-
-{===================================================================}
-
-function typid(err:integer):sp;
-var lip:ip; lsp:sp;
-begin lsp:=nil;
- if sy<>ident then error(err) else
- begin lip:=searchid([types]); lsp:=lip^.idtype; insym end;
- typid:=lsp
-end;
-
-function simpletyp(fsys:sos):sp;
-var lsp,lsp1:sp; lip,hip:ip; min,max:integer; lnp:np;
- newsubrange:boolean;
-begin lsp:=nil;
- if find1([ident..lparent],fsys,+025) then
- if sy=lparent then
- begin insym; lnp:=top; {decl. consts local to innermost block}
- while top^.occur<>blck do top:=top^.nlink;
- lsp:=newsp(scalar,sz_word); hip:=nil; max:=0;
- repeat lip:=newident(konst,lsp,hip,+026);
- if lip<>nil then
- begin enterid(lip); hip:=lip; lip^.value:=max; max:=max+1 end;
- until endofloop(fsys+[rparent],[ident],comma,+027); {+028}
- if max<=MU1 then lsp^.size:=sz_byte;
- lsp^.fconst:=hip; top:=lnp; nextif(rparent,+029);
- end
- else
- begin newsubrange:=true;
- if sy=ident then
- begin lip:=searchid([types,konst]); insym;
- if lip^.klass=types then
- begin lsp:=lip^.idtype; newsubrange:=false end
- else
- begin lsp1:=lip^.idtype; min:=lip^.value end
- end
- else constant(fsys+[colon2,ident..plussy],lsp1,min);
- if newsubrange then
- begin lsp:=newsp(subrange,sz_word); lsp^.subrno:=0;
- if not nicescalar(lsp1) then
- begin error(+030); lsp1:=nil; min:=0 end;
- lsp^.rangetype:=lsp1;
- nextif(colon2,+031); max:=cstinteger(fsys,lsp1,+032);
- if min>max then begin error(+033); max:=min end;
- if (min>=0) and (max<=MU1) then lsp^.size:=sz_byte;
- lsp^.min:=min; lsp^.max:=max
- end
- end;
- simpletyp:=lsp
-end;
-
-function arraytyp(fsys:sos;
- artyp:structform;
- sflag:sflagset;
- function element(fsys:sos):sp
- ):sp;
-var lsp,lsp1,hsp:sp; ok:boolean; sepsy:symbol; lip:ip;
- oksys:sos;
-begin insym; nextif(lbrack,+034); hsp:=nil;
- repeat lsp:=newsp(artyp,0); initpos(lsp^.arpos);
- lsp^.aeltype:=hsp; hsp:=lsp; {link reversed}
- if artyp=carray then
- begin sepsy:=semicolon; oksys:=[ident];
- lip:=newident(carrbnd,lsp,nil,+035); if lip<>nil then enterid(lip);
- nextif(colon2,+036);
- lip:=newident(carrbnd,lsp,lip,+037); if lip<>nil then enterid(lip);
- nextif(colon1,+038); lsp1:=typid(+039);
- ok:=nicescalar(desub(lsp1));
- end
- else
- begin sepsy:=comma; oksys:=[ident..lparent];
- lsp1:=simpletyp(fsys+[comma,rbrack,ofsy,ident..packedsy]);
- ok:=bounded(lsp1)
- end;
- if not ok then begin error(+040); lsp1:=nil end;
- lsp^.inxtype:=lsp1
- until endofloop(fsys+[rbrack,ofsy,ident..packedsy],oksys,
- sepsy,+041); {+042}
- nextif(rbrack,+043); nextif(ofsy,+044);
- lsp:=element(fsys);
- if lsp<>nil then sflag:=sflag + lsp^.sflag * [withfile];
- repeat {reverse links and compute size}
- lsp1:=hsp^.aeltype; hsp^.aeltype:=lsp; hsp^.sflag:=sflag;
- if artyp=arrays then hsp^.size:=arraysize(hsp,spack in sflag);
- lsp:=hsp; hsp:=lsp1
- until hsp=nil; {lsp points to array with highest dimension}
- arraytyp:=lsp
-end;
-
-function typ(fsys:sos):sp;
-var lsp,lsp1:sp; off,sz,min,errno:integer;
- sflag:sflagset; lnp:np;
-
-function fldlist(fsys:sos):sp;
- {level 2: << typ}
-var fip,hip,lip:ip; lsp:sp;
-
-function varpart(fsys:sos):sp;
- {level 3: << fldlist << typ}
-var tip,lip:ip; lsp,headsp,hsp,vsp,tsp,tsp1,tfsp:sp;
- minoff,maxoff,int,nvar:integer; lid:idarr;
-begin insym; tip:=nil; lip:=nil;
- tsp:=newsp(tag,0);
- if sy<>ident then error(+045) else
- begin lid:=id; insym;
- if sy=colon1 then
- begin tip:=newip(field,lid,nil,nil); enterid(tip); insym;
- if sy<>ident then error(+046) else
- begin lid:=id; insym end;
- end;
- if sy=ofsy then {otherwise you may destroy id}
- begin id:=lid; lip:=searchid([types]) end;
- end;
- if lip=nil then tfsp:=nil else tfsp:=lip^.idtype;
- if bounded(tfsp) then
- begin bounds(tfsp,int,nvar); nvar:=nvar-int+1 end
- else
- begin nvar:=0; if tfsp<>nil then begin error(+047); tfsp:=nil end end;
- tsp^.tfldsp:=tfsp;
- if tip<>nil then {explicit tag}
- begin tip^.idtype:=tfsp;
- tip^.foffset:=posaddr(off,tfsp,spack in sflag)
- end;
- nextif(ofsy,+048); minoff:=off; maxoff:=minoff; headsp:=nil;
- repeat hsp:=nil; {for each caselabel list}
- repeat nvar:=nvar-1;
- int:=cstinteger(fsys+[ident..plussy,comma,colon1,lparent,
- semicolon,casesy,rparent],tfsp,+049);
- lsp:=headsp; {each label may occur only once}
- while lsp<>nil do
- begin if lsp^.varval=int then error(+050);
- lsp:=lsp^.nxtvar
- end;
- vsp:=newsp(variant,0); vsp^.varval:=int;
- vsp^.nxtvar:=headsp; headsp:=vsp; {chain of case labels}
- vsp^.subtsp:=hsp; hsp:=vsp;
- {use this field to link labels with same variant}
- until endofloop(fsys+[colon1,lparent,semicolon,casesy,rparent],
- [ident..plussy],comma,+051); {+052}
- nextif(colon1,+053); nextif(lparent,+054);
- tsp1:=fldlist(fsys+[rparent,semicolon,ident..plussy]);
- if off>maxoff then maxoff:=off;
- while vsp<>nil do
- begin vsp^.size:=off; hsp:=vsp^.subtsp;
- vsp^.subtsp:=tsp1; vsp:=hsp
- end;
- nextif(rparent,+055);
- off:=minoff;
- until lastsemicolon(fsys,[ident..plussy],+056); {+057 +058}
- if nvar>0 then error(-(+059));
- tsp^.fstvar:=headsp; tsp^.size:=minoff; off:=maxoff; varpart:=tsp;
-end;
-
-begin {fldlist}
- if find2([ident],fsys+[casesy],+060) then
- repeat lip:=nil; hip:=nil;
- repeat fip:=newident(field,nil,nil,+061);
- if fip<>nil then
- begin enterid(fip);
- if lip=nil then hip:=fip else lip^.next:=fip; lip:=fip;
- end;
- until endofloop(fsys+[colon1,ident..packedsy,semicolon,casesy],
- [ident],comma,+062); {+063}
- nextif(colon1,+064);
- lsp:=typ(fsys+[casesy,semicolon]);
- if lsp<>nil then if withfile in lsp^.sflag then
- sflag:=sflag+[withfile];
- while hip<>nil do
- begin hip^.idtype:=lsp;
- hip^.foffset:=posaddr(off,lsp,spack in sflag);
- hip:=hip^.next
- end;
- until lastsemicolon(fsys+[casesy],[ident],+065); {+066 +067}
- if sy=casesy then fldlist:=varpart(fsys) else fldlist:=nil;
-end;
-
-
-begin {typ}
- sflag:=[]; lsp:=nil;
- if sy=packedsy then begin sflag:=[spack]; insym end;
- if find1([ident..filesy],fsys,+068) then
- if sy in [ident..arrow] then
- begin if spack in sflag then error(+069);
- if sy=arrow then
- begin lsp:=newsp(pointer,sz_addr); insym;
- if not intypedec then lsp^.eltype:=typid(+070) else
- if sy<>ident then error(+071) else
- begin fwptr:=newip(types,id,lsp,fwptr); insym end
- end
- else lsp:=simpletyp(fsys);
- end
- else
- case sy of
-{<<<<<<<<<<<<}
-arraysy:
- lsp:=arraytyp(fsys,arrays,sflag,typ);
-recordsy:
- begin insym;
- new(lnp,rec); lnp^.occur:=rec; lnp^.nlink:=top; lnp^.fname:=nil; top:=lnp;
- off:=0; lsp1:=fldlist(fsys+[endsy]); {fldlist updates off}
- lsp:=newsp(records,off); lsp^.tagsp:=lsp1;
- lsp^.fstfld:=top^.fname; lsp^.sflag:=sflag;
- top:=top^.nlink; nextif(endsy,+072)
- end;
-setsy:
- begin insym; nextif(ofsy,+073);
- lsp:=simpletyp(fsys); lsp1:=desub(lsp); errno:=0;
- if bounded(lsp1) then
- begin bounds(lsp1,min,sz);
- if sz div NB1>=sz_mset then errno:=+074
- end
- else if bounded(lsp) then {subrange of integer}
- begin bounds(lsp,min,sz);
- if (min<0) or (sz>=iopt) then errno:=+075;
- sz:=iopt-1
- end
- else if lsp=intptr then
- begin sz:=iopt-1; errno:=-(+076) end
- else
- errno:=+077;
- if errno<>0 then
- begin error(errno); if errno>0 then begin lsp1:=nil; sz:=0 end end;
- lsp:=newsp(power,sz div NB1 +1); lsp^.elset:=lsp1;
- end;
-filesy:
- begin insym; nextif(ofsy,+078); lsp1:=typ(fsys);
- if lsp1<>nil then if withfile in lsp1^.sflag then error(-(+079));
- sz:=sizeof(lsp1,wordpart); if sz<sz_buff then sz:=sz_buff;
- lsp:=newsp(files,sz+sz_head); lsp^.filtype:=lsp1;
- end;
-{>>>>>>>>>>>>}
- end; {case}
- typ:=lsp;
-end;
-
-function vpartyp(fsys:sos):sp;
-begin
- if find2([arraysy],fsys+[ident],+080) then
- vpartyp:=arraytyp(fsys,carray,[],vpartyp)
- else
- vpartyp:=typid(+081)
-end;
-
-{===================================================================}
-
-procedure block(fsys:sos; fip:ip); forward;
- {pfdeclaration calls block. With a more obscure lexical
- structure this forward declaration can be avoided}
-
-procedure labeldeclaration(fsys:sos);
-var llp:lp;
-begin with b do begin
- repeat
- if sy<>intcst then error(+082) else
- begin
- if searchlab(lchain,val)<>nil then errint(+083,val) else
- begin new(llp); llp^.labval:=val;
- if val>9999 then teststandard;
- ilbno:=ilbno+1; llp^.labname:=ilbno; llp^.labdlb:=0;
- llp^.seen:=false; llp^.nextlp:=lchain; lchain:=llp;
- end;
- insym
- end
- until endofloop(fsys+[semicolon],[intcst],comma,+084); {+085}
- nextif(semicolon,+086)
-end end;
-
-procedure constdefinition(fsys:sos);
-var lip:ip;
-begin
- repeat lip:=newident(konst,nil,nil,+087);
- if lip<>nil then
- begin nextif(eqsy,+088);
- constant(fsys+[semicolon,ident],lip^.idtype,lip^.value);
- nextif(semicolon,+089); enterid(lip);
- end;
- until not find2([ident],fsys,+090);
-end;
-
-procedure typedefinition(fsys:sos);
-var lip:ip;
-begin fwptr:=nil; intypedec:=true;
- repeat lip:=newident(types,nil,nil,+091);
- if lip<>nil then
- begin nextif(eqsy,+092);
- lip^.idtype:=typ(fsys+[semicolon,ident]);
- nextif(semicolon,+093); enterid(lip);
- end;
- until not find2([ident],fsys,+094);
- while fwptr<>nil do
- begin assert sy<>ident;
- id:=fwptr^.name; lip:=searchid([types]);
- fwptr^.idtype^.eltype:=lip^.idtype; fwptr:=fwptr^.next
- end;
- intypedec:=false;
-end;
-
-procedure vardeclaration(fsys:sos);
-var lip,hip,vip:ip; lsp:sp;
-begin with b do begin
- repeat hip:=nil; lip:=nil;
- repeat vip:=newident(vars,nil,nil,+095);
- if vip<>nil then
- begin enterid(vip); vip^.iflag:=[];
- if lip=nil then hip:=vip else lip^.next:=vip; lip:=vip;
- end;
- until endofloop(fsys+[colon1,ident..packedsy],[ident],comma,+096); {+097}
- nextif(colon1,+098);
- lsp:=typ(fsys+[semicolon,ident]);
- while hip<>nil do
- begin hip^.idtype:=lsp;
- if level<=1 then
- hip^.vpos.ad:=posaddr(holeb,lsp,false)
- else
- hip^.vpos.ad:=negaddr(lsp);
- hip:=hip^.next
- end;
- nextif(semicolon,+099);
- until not find2([ident],fsys,+0100);
-end end;
-
-procedure pfhead(fsys:sos;var fip:ip;var again:boolean;param:boolean);
- forward;
-
-procedure parlist(fsys:sos; slink:boolean; var tip:ip; var maxlb:integer);
-var lastip,hip,lip,pip:ip; lsp,tsp:sp; iflag:iflagset; again:boolean;
-begin tip:=nil; lastip:=nil;
- maxlb:=0; if slink then maxlb:=sz_addr;
- repeat {once for each formal-parameter-section}
- if find1([ident,varsy,procsy,funcsy],fsys+[semicolon],+0101) then
- begin
- if (sy=procsy) or (sy=funcsy) then
- begin
- pfhead(fsys+[semicolon,ident,varsy,procsy,funcsy],hip,again,true);
- hip^.pfpos.ad:=posaddr(maxlb,procptr,false);
- hip^.pfkind:=formal; lip:=hip;
- top:=top^.nlink; level:=level-1
- end
- else
- begin hip:=nil; lip:=nil; iflag:=[assigned];
- if sy=varsy then
- begin iflag:=[refer,assigned,used]; insym end;
- repeat pip:=newident(vars,nil,nil,+0102);
- if pip<>nil then
- begin enterid(pip); pip^.iflag:=iflag;
- if lip=nil then hip:=pip else lip^.next:=pip; lip:=pip;
- end;
- iflag:=iflag+[samesect];
- until endofloop(fsys+[semicolon,colon1],[ident],comma,+0103);
- {+0104}
- nextif(colon1,+0105);
- if refer in iflag then
- begin lsp:=vpartyp(fsys+[semicolon]); tsp:=lsp;
- while formof(tsp,[carray]) do
- begin tsp^.arpos.ad:=posaddr(maxlb,nilptr,false);
- tsp:=tsp^.aeltype
- end;
- tsp:=nilptr;
- end
- else
- begin lsp:=typid(+0106); tsp:=lsp end;
- pip:=hip;
- while pip<>nil do
- begin pip^.vpos.ad:=posaddr(maxlb,tsp,false); pip^.idtype:=lsp;
- pip:=pip^.next
- end;
- end;
- if lastip=nil then tip:=hip else lastip^.next:=hip; lastip:=lip;
- end;
- until endofloop(fsys,[ident,varsy,procsy,funcsy],semicolon,+0107); {+0108}
-end;
-
-procedure pfhead; {forward declared}
-var lip:ip; lsp:sp; lnp:np; kl:idclass;
-begin lip:=nil; again:=false;
- if sy=procsy then kl:=proc else
- begin kl:=func; fsys:=fsys+[colon1,ident] end;
- insym;
- if sy<>ident then begin error(+0109); id:=spaces end;
- if not param then lip:=searchsection(top^.fname);
- if lip<>nil then
- if (lip^.klass<>kl) or (lip^.pfkind<>forward) then errid(+0110,id) else
- begin b.forwcount:=b.forwcount-1; again:=true end;
- if again then insym else
- begin lip:=newip(kl,id,nil,nil);
- if sy=ident then begin enterid(lip); insym end;
- lastpfno:=lastpfno+1; lip^.pfno:=lastpfno;
- end;
- level:=level+1;
- new(lnp,blck); lnp^.occur:=blck; lnp^.nlink:=top; top:=lnp;
- if again then lnp^.fname:=lip^.parhead else
- begin lnp^.fname:=nil;
- if find3(lparent,fsys,+0111) then
- begin parlist(fsys+[rparent],lip^.pfpos.lv>1,lip^.parhead,lip^.maxlb);
- nextif(rparent,+0112)
- end;
- end;
- if (kl=func) and not again then
- begin nextif(colon1,+0113); lsp:=typid(+0114);
- if formof(lsp,[power..tag]) then
- begin error(+0115); lsp:=nil end;
- lip^.idtype:=lsp;
- end;
- fip:=lip;
-end;
-
-procedure pfdeclaration(fsys:sos);
-var lip:ip; again,headonly:boolean; markp:^integer; lbp:bp; kind:kindofpf;
-begin with b do begin
- pfhead(fsys+[ident,semicolon,labelsy..beginsy],lip,again,false);
- nextif(semicolon,+0116);
- if find1([ident,labelsy..beginsy],fsys+[semicolon],+0117) then
- begin headonly:=sy=ident;
- if headonly then
- begin kind:=standard;
- if id='forward ' then kind:=forward else
- if id='extern ' then kind:=extern else
- if id='varargs ' then kind:=varargs else errid(+0118,id);
- if kind<>standard then
- begin insym; lip^.pfkind:=kind;
- if kind=forward then
- if again then errid(+0119,lip^.name) else
- forwcount:=forwcount+1
- else
- begin lip^.pfpos.lv:=1; teststandard end
- end;
- end;
- if not again then
- if lip^.pfpos.lv<=1 then genpnam(ps_exp,lip) else genpnam(ps_inp,lip);
- if not headonly then
- begin lip^.pfkind:=actual;
-#ifndef STANDARD
- mark(markp);
-#endif
- new(lbp); lbp^:=b; nextbp:=lbp;
- reglb:=0; minlb:=0; ilbno:=0; forwcount:=0; lchain:=nil;
- block(fsys+[semicolon],lip);
- b:=nextbp^;
-#ifndef STANDARD
- release(markp);
-#endif
- end;
- end;
- if not main then eofexpected:=forwcount=0;
- nextif(semicolon,+0120);
- level:=level-1; top:=top^.nlink;
-end end;
-
-{===================================================================}
-
-procedure expression(fsys:sos); forward;
- {this forward declaration cannot be avoided}
-
-procedure selectarrayelement(fsys:sos);
-var isp,lsp:sp;
-begin
- repeat loadaddr; isp:=nil;
- if formof(a.asp,[arrays,carray]) then isp:=a.asp^.inxtype else
- errasp(+0121);
- lsp:=a.asp;
- expression(fsys+[comma]); force(desub(isp),+0122);
- {no range check}
- if lsp<>nil then
- begin a.packbit:=spack in lsp^.sflag;
- descraddr(lsp^.arpos); lsp:=lsp^.aeltype
- end;
- a.asp:=lsp; a.ak:=indexed;
- until endofloop(fsys,[notsy..lparent],comma,+0123); {+0124}
-end;
-
-procedure selector(fsys: sos; fip:ip; iflag:iflagset);
-{selector computes the address of any kind of variable.
- Four possibilities:
- 1.for direct accessable variables (fixed), a contains offset and level,
- 2.for indirect accessable variables (ploaded), the address is on the stack.
- 3.for array elements, the top of stack gives the index (one word).
- The address of the array is beneath it.
- 4.for variables with address in direct accessible pointer variable (pfixed),
- the offset and level of the pointer is stored in a.
- If a.asp=nil then an error occurred else a.asp gives
- the type of the variable.
-}
-var lip:ip;
-begin inita(fip^.idtype,0);
- case fip^.klass of
- vars: with a do
- begin pos:=fip^.vpos; if refer in fip^.iflag then ak:=pfixed end;
- field:
- begin a:=lastnp^.wa; fieldaddr(fip^.foffset); a.asp:=fip^.idtype end;
- func: with a do
- if fip^.pfkind=standard then errasp(+0125) else
- if (fip^.pfpos.lv>=level-1) and (fip<>currproc) then error(+0126) else
- if fip^.pfkind<>actual then error(+0127) else
- begin pos:=fip^.pfpos; pos.lv:=pos.lv+1;
- if sy=arrow then error(+0128);
- end
- end; {case}
- if (sy=lbrack) or (sy=period) then iflag:=iflag+[noreg];
- while find2([lbrack,period,arrow],fsys,+0129) do with a do
- if sy=lbrack then
- begin insym; selectarrayelement(fsys+[rbrack,lbrack,period,arrow]);
- nextif(rbrack,+0130);
- end else
- if sy=period then
- begin insym;
- if sy<>ident then error(+0131) else
- begin
- if not formof(asp,[records]) then errasp(+0132) else
- begin lip:=searchsection(asp^.fstfld);
- if lip=nil then begin errid(+0133,id); asp:=nil end else
- begin packbit:=spack in asp^.sflag;
- fieldaddr(lip^.foffset); asp:=lip^.idtype
- end
- end;
- insym
- end
- end
- else
- begin insym; iflag:=[used];
- if asp<>nil then
- if asp=zeroptr then errasp(+0134) else
- if asp^.form=pointer then
- begin
- if ak=fixed then ak:=pfixed else
- begin load; ak:=ploaded end;
- asp:=asp^.eltype
- end else
- if asp^.form=files then
- begin loadaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
- asp:=asp^.filtype; ak:=ploaded; packbit:=true;
- end
- else errasp(+0135);
- end;
- fip^.iflag:=fip^.iflag+iflag;
-end;
-
-procedure variable(fsys:sos);
-var lip: ip;
-begin
- if sy=ident then
- begin lip:=searchid([vars,field]); insym;
- selector(fsys,lip,[used,assigned,noreg])
- end
- else begin error(+0136); inita(nil,0) end;
-end;
-
-{===================================================================}
-
-function plistequal(p1,p2:ip):boolean;
-var ok:boolean; q1,q2:sp;
-begin plistequal:=eqstruct(p1^.idtype,p2^.idtype);
- p1:=p1^.parhead; p2:=p2^.parhead;
- while (p1<>nil) and (p2<>nil) do
- begin ok:=false;
- if p1^.klass=p2^.klass then
- if p1^.klass<>vars then ok:=plistequal(p1,p2) else
- begin q1:=p1^.idtype; q2:=p2^.idtype; ok:=true;
- while ok and formof(q1,[carray]) and formof(q2,[carray]) do
- begin ok:=eqstruct(q1^.inxtype,q2^.inxtype);
- q1:=q1^.aeltype; q2:=q2^.aeltype;
- end;
- if not (eqstruct(q1,q2) and
- (p1^.iflag*[refer,samesect] = p2^.iflag*[refer,samesect]))
- then ok:=false;
- end;
- if not ok then plistequal:=false;
- p1:=p1^.next; p2:=p2^.next
- end;
- if (p1<>nil) or (p2<>nil) then plistequal:=false
-end;
-
-procedure callnonstandard(fsys:sos; moreargs:boolean; fip:ip);
-var nxt,lip:ip; l0,l1,l2,l3,sz:integer; lsp,savasp:sp;
-begin with a do begin
- l0:=lino; sz:=0; nxt:=fip^.parhead;
- while moreargs do
- begin l1:=lino;
- if nxt=nil then
- begin if fip^.pfkind<>varargs then error(+0137);
- expression(fsys); load; sz:=sz+sizeof(asp,wordmult)
- end
- else
- begin lsp:=nxt^.idtype;
- if nxt^.klass<>vars then {proc or func}
- begin inita(procptr,0); sz:=sz+sz_proc;
- if sy<>ident then error(+0138) else
- begin lip:=searchid([nxt^.klass]); insym;
- if lip^.pfkind=standard then error(+0139) else
- if not plistequal(nxt,lip) then error(+0140)
- else
- begin pos:=lip^.pfpos;
- if lip^.pfkind=formal then load else
- begin
- if lip^.pfpos.lv<=1 then gencst(op_zer,sz_addr) else
- gencst(op_lxl,level-lip^.pfpos.lv);
- genpnam(op_lpi,lip)
- end
- end
- end
- end
- else if not (refer in nxt^.iflag) then {call by value}
- begin expression(fsys); force(lsp,+0141);
- sz:=sz+sizeof(asp,wordmult);
- end
- else {call by reference}
- begin variable(fsys); loadaddr; sz:=sz+sz_addr;
- if samesect in nxt^.iflag then lsp:=savasp else
- begin savasp:=asp; l2:=lino;
- while formof(lsp,[carray])
- and formof(asp,[arrays,carray]) do
- if (compat(lsp^.inxtype,asp^.inxtype) > subeq) or
- (lsp^.sflag<>asp^.sflag) then errasp(+0142) else
- begin l3:=lino; descraddr(asp^.arpos); exchange(l2,l3);
- sz:=sz+sz_addr; asp:=asp^.aeltype; lsp:=lsp^.aeltype
- end
- end;
- if not eqstruct(asp,lsp) then errasp(+0143);
- if packbit then errasp(+0144);
- end;
- nxt:=nxt^.next
- end;
- exchange(l0,l1); moreargs:=find3(comma,fsys,+0145)
- end;
- if nxt<>nil then error(+0146);
- inita(procptr,0); pos:=fip^.pfpos;
- if fip^.pfkind=formal then
- with b do
- begin load; ilbno:=ilbno+2;
- gencst(op_exg,sz_addr);
- gencst(op_dup,sz_addr);
- gencst(op_zer,sz_addr);
- genop(op_cmp);
- gencst(op_zeq,ilbno-1);
- gencst(op_exg,sz_addr);
- genop(op_cai);
- gencst(op_asp,sz_addr);
- gencst(op_bra,ilbno);
- newilb(ilbno-1);
- gencst(op_asp,sz_addr);
- genop(op_cai);
- newilb(ilbno);
- end
- else
- begin
- if pos.lv>1 then
- begin gencst(op_lxl,level-pos.lv); sz:=sz+sz_addr end;
- genpnam(op_cal,fip)
- end;
- if sz<>0 then gencst(op_asp,sz);
- asp:=fip^.idtype;
- if asp<>nil then genasp(op_lfr)
-end end;
-
-procedure fileaddr;
-var la:attr;
-begin la:=a; a:=fa; loadaddr; a:=la end;
-
-procedure callr(l1,l2:integer);
-var la:attr; m:libmnem;
-begin with a do begin
- la:=a; asp:=desub(asp); fileaddr; m:=RDI;
- if asp<>intptr then
- if asp=charptr then m:=RDC else
- if asp=realptr then m:=RDR else
- if asp=longptr then m:=RDL else errasp(+0147);
- gensp(m,sz_addr); genasp(op_lfr);
- if asp<>la.asp then checkbnds(la.asp);
- a:=la; exchange(l1,l2); store;
-end end;
-
-procedure callw(fsys:sos; l1,l2:integer);
-var m:libmnem; s:integer;
-begin with a do begin
- fileaddr; exchange(l1,l2); loadcheap; asp:=desub(asp);
- if string(asp) then
- begin gencst(op_loc,asp^.size); m:=WRS; s:=sz_addr+sz_word end
- else
- begin m:=WRI; s:=sizeof(asp,wordmult);
- if asp<>intptr then
- if asp=charptr then m:=WRC else
- if asp=realptr then m:=WRR else
- if asp=boolptr then m:=WRB else
- if asp=zeroptr then m:=WRZ else
- if asp=longptr then m:=WRL else errasp(+0148);
- end;
- if find3(colon1,fsys,+0149) then
- begin expression(fsys+[colon1]); force(intptr,+0150);
- m:=succ(m); s:=s+sz_int
- end;
- if find3(colon1,fsys,+0151) then
- begin expression(fsys); force(intptr,+0152); s:=s+sz_int;
- if m<>WSR then error(+0153) else m:=WRF;
- end;
- gensp(m,s+sz_addr);
-end end;
-
-procedure callrw(fsys:sos; lpar,w,ln:boolean);
-var l1,l2,errno:integer; ftype,lsp,fsp:sp; savlb:integer; m:libmnem;
-begin with b do begin savlb:=reglb; ftype:=textptr;
- inita(textptr,argv[ord(w)].ad); a.pos.lv:=0; fa:=a;
- if lpar then
- begin l1:=lino; if w then expression(fsys+[colon1]) else variable(fsys);
- l2:=lino;
- if formof(a.asp,[files]) then
- begin ftype:=a.asp;
- if (a.ak<>fixed) and (a.ak<>pfixed) then
- begin loadaddr; temporary(nilptr,reg_pointer);
- store; a.ak:=pfixed
- end;
- fa:=a; {store doesn't change a}
- if (sy<>comma) and not ln then error(+0154);
- end
- else
- begin if iop[w]=nil then error(+0155);
- if w then callw(fsys,l1,l2) else callr(l1,l2)
- end;
- while find3(comma,fsys,+0156) do with a do
- begin l1:=lino;
- if w then expression(fsys+[colon1]) else variable(fsys);
- l2:=lino;
- if ftype=textptr then
- if w then callw(fsys,l1,l2) else callr(l1,l2)
- else
- begin errno:=+0157; fsp:=ftype^.filtype;
- if w then force(fsp,errno) else
- begin store; lsp:=asp; l2:=lino end;
- fileaddr; gensp(WDW,sz_addr); gencst(op_lfr,sz_addr);
- ak:=ploaded; packbit:=true; asp:=fsp;
- if w then store else
- begin force(lsp,errno); exchange(l1,l2) end;
- fileaddr; if w then m:=PUTX else m:=GETX; gensp(m,sz_addr)
- end
- end;
- end
- else
- if not ln then error(+0158) else
- if iop[w]=nil then error(+0159);
- if ln then
- begin if ftype<>textptr then error(+0160);
- fileaddr; if w then m:=WLN else m:=RLN; gensp(m,sz_addr)
- end;
- reglb:=savlb
-end end;
-
-procedure callnd(fsys:sos);
-label 1;
-var lsp:sp; int:integer;
-begin with a do begin
- if asp=zeroptr then errasp(+0161) else asp:=asp^.eltype;
- while find3(comma,fsys,+0162) do
- begin
- if asp<>nil then {asp of form record or variant}
- if asp^.form=records then asp:=asp^.tagsp else
- if asp^.form=variant then asp:=asp^.subtsp else errasp(+0163);
- if asp=nil then constant(fsys,lsp,int) else
- begin assert asp^.form=tag;
- int:=cstinteger(fsys,asp^.tfldsp,+0164); lsp:=asp^.fstvar;
- while lsp<>nil do
- if lsp^.varval<>int then lsp:=lsp^.nxtvar else
- begin asp:=lsp; goto 1 end;
- end;
-1: end;
- genasp(op_loc)
-end end;
-
-procedure call(fsys: sos; fip: ip);
-var lkey: standpf; lpar:boolean; lsp,sp1,sp2:sp;
- m:libmnem; s:integer; b:byte;
-begin with a do begin fsys:=fsys+[comma];
- lpar:=find3(lparent,fsys,+0165); if lpar then fsys:=fsys+[rparent];
- if fip^.pfkind<>standard then callnonstandard(fsys,lpar,fip) else
- begin lkey:=fip^.key; m:=CLS; lsp:=nil;
- if not lpar then
- if lkey in [pput..prelease,fabs..fatn] then error(+0166);
- if lkey in [pput..ppage,feof,feoln] then
- begin s:=sz_addr;
- if lpar then
- begin variable(fsys); loadaddr end
- else
- begin asp:=textptr;
- if iop[lkey=ppage]=nil then errasp(+0167) else
- gencst(op_lae,argv[ord(lkey=ppage)].ad)
- end;
- if lkey in [pput..prewrite,ppage,feof,feoln] then
- if not formof(asp,[files]) then
- begin error(+0168); asp:=textptr end;
- if lkey in [pnew,pdispose,pmark,prelease] then
- if not formof(asp,[pointer]) then
- begin error(+0169); asp:=nilptr end;
- end;
- case lkey of
- pread, preadln, pwrite, pwriteln: {0,1,2,3 resp}
- callrw(fsys,lpar,lkey>=pwrite,odd(ord(lkey)));
- pput: m:=PUTX;
- pget: m:=GETX;
- ppage: m:=PAG;
- preset: m:=OPN;
- prewrite: m:=CRE;
- pnew: m:=NEWX;
- pdispose: m:=DIS;
- ppack:
- begin sp2:=asp; nextif(comma,+0170); expression(fsys); load;
- lsp:=asp; nextif(comma,+0171); variable(fsys); loadaddr;
- sp1:=asp; asp:=lsp; m:=PAC
- end;
- punpack:
- begin sp1:=asp; nextif(comma,+0172); variable(fsys); loadaddr;
- sp2:=asp; nextif(comma,+0173); expression(fsys); load;
- m:=UNP
- end;
- pmark: m:=SAV;
- prelease: m:=RST;
- phalt:
- begin m:=HLT; teststandard;
- if lpar then lsp:=intptr else gencst(op_loc,0);
- end;
- feof: m:=EFL;
- feoln: m:=ELN;
- fodd, fchr: lsp:=intptr;
- fpred: b:=op_dec;
- fsucc: b:=op_inc;
- fround: m:=RND;
- fsin, fcos, fexp, fsqt, flog, fatn: lsp:=realptr;
- fabs, fsqr, ford, ftrunc: ;
- end;
- if lpar then if lkey in [phalt,fabs..fatn] then
- begin expression(fsys);
- force(lsp,+0174); s:=sizeof(asp,wordmult)
- end;
- if lkey in [ppack,punpack,fabs..fodd] then
- asp:=desub(asp);
- case lkey of
- ppage, feoln:
- begin if asp<>textptr then error(+0175); asp:=boolptr end;
- preset, prewrite:
- begin s:=sz_addr+sz_word;
- if asp=textptr then gencst(op_loc,0) else
- gencst(op_loc,sizeof(asp^.filtype,wordpart));
- end;
- pnew, pdispose:
- begin callnd(fsys); s:=sz_addr+sz_word end;
- ppack, punpack:
- begin s:=2*sz_addr+sz_int;
- if formof(sp1,[arrays,carray])
- and formof(sp2,[arrays,carray]) then
- if (spack in (sp1^.sflag - sp2^.sflag)) and
- eqstruct(sp1^.aeltype,sp2^.aeltype) and
- eqstruct(desub(sp1^.inxtype),asp) and
- eqstruct(desub(sp2^.inxtype),asp) then
- begin descraddr(sp1^.arpos); descraddr(sp2^.arpos) end
- else error(+0176)
- else error(+0177)
- end;
- pmark, prelease: teststandard;
- feof: asp:=boolptr;
- fabs:
- if asp=intptr then m:=ABI else
- if asp=longptr then m:=ABL else
- if asp=realptr then m:=ABR else errasp(+0178);
- fsqr:
- begin
- if (asp=intptr) or (asp=longptr) then b:=op_mli else
- if asp=realptr then begin b:=op_mlf; fltused:=true end
- else errasp(+0179);
- genasp(op_dup); genasp(b)
- end;
- ford:
- begin if not nicescalar(asp) then errasp(+0180); asp:=intptr end;
- fchr: checkbnds(charptr);
- fpred, fsucc:
- begin genop(b);
- if nicescalar(asp) then genrck(asp) else errasp(+0181)
- end;
- fodd:
- begin gencst(op_loc,1); asp:=boolptr; genasp(op_and) end;
- ftrunc, fround: if asp<>realptr then errasp(+0182);
- fsin: m:=SINX;
- fcos: m:=COSX;
- fexp: m:=EXPX;
- fsqt: m:=SQT;
- flog: m:=LOG;
- fatn: m:=ATN;
- phalt:s:=0;
- pread, preadln, pwrite, pwriteln, pput, pget: ;
- end;
- if m<>CLS then
- begin gensp(m,s);
- if lkey>=feof then genasp(op_lfr)
- end;
- if (lkey=fround) or (lkey=ftrunc) then
- opconvert(ri);
- end;
- if lpar then nextif(rparent,+0183);
-end end;
-
-{===================================================================}
-
-procedure convert(fsp:sp; l1:integer);
-{Convert tries to make the operands of some operator of the same type.
- The operand types are given by fsp and a.asp. The resulting type
- is put in a.asp.
- l1 gives the lino of the first instruction of the right operand.
-}
-var l2:integer; ts:twostruct; lsp:sp;
-begin with a do begin asp:=desub(asp);
- ts:=compat(asp,fsp);
- case ts of
- eq,subeq:
- ;
- il,ir,lr:
- opconvert(ts);
- es:
- expandnullset(fsp);
- li,ri,rl,se:
- begin l2:=lino; lsp:=asp; asp:=fsp;
- convert(lsp,l1); exchange(l1,l2); asp:=lsp
- end;
- noteq:
- errasp(+0184);
- end;
- if asp=realptr then fltused:=true
-end end;
-
-procedure buildset(fsys:sos);
-{This is a bad construct in pascal. Two objections:
- - expr..expr very difficult to implement on most machines
- - this construct makes it hard to implement sets of different size
-}
-const ncsw = 16; {tunable}
-type wordset = set of 0..MB2;
-var i,j,val1,val2,ncst,l1,l2,sz:integer;
- cst1,cst2,cst12,varpart:boolean;
- cstpart:array[1..ncsw] of wordset;
-
-procedure genwordset(s:wordset);
- {level 2: << buildset}
-var b,i,w:integer;
-begin i:=0; w:=0; b:=-1;
- repeat
- if i in s then w:=w-b; b:=b+b; i:=i+1
- until i=MB2;
- if i in s then w:=w+b;
- gencst(op_loc,w)
-end;
-
-procedure setexpr(fsys:sos; var c:boolean; var v:integer);
- {level 2: << buildset}
-var min:integer; lsp:sp;
-begin with a do begin c:=false; v:=0; lsp:=asp;
- expression(fsys); asp:=desub(asp);
- if not eqstruct(asp,lsp^.elset) then
- begin error(+0185); lsp:=nullset end;
- if lsp=nullset then
- begin
- if bounded(asp) then bounds(asp,min,sz) else
- if asp=intptr then sz:=iopt-1 else begin errasp(+0186); sz:=0 end;
- sz:=sz div NB1 + 1; while sz mod sz_word <> 0 do sz:=sz+1;
- if sz>sz_mset then errasp(+0187);
- lsp:=newsp(power,sz); lsp^.elset:=asp
- end;
- if asp<>nil then if ak=cst then
- if (pos.ad<0) or (pos.ad div NB1>=sizeof(lsp,wordmult)) then
- error(+0188)
- else if sz<=ncsw*sz_word then
- begin c:=true; v:=pos.ad end;
- if not c then load; asp:=lsp
-end end;
-
-begin with a do begin {buildset}
- varpart:=false; ncst:=0; asp:=nullset;
- for i:=1 to ncsw do cstpart[i]:=[];
- if find2([notsy..lparent],fsys,+0189) then
- repeat l1:=lino;
- setexpr(fsys+[colon2,comma],cst1,val1); cst12:=cst1;
- if find3(colon2,fsys+[comma,notsy..lparent],+0190) then
- begin setexpr(fsys+[comma,notsy..lparent],cst2,val2);
- cst12:=cst12 and cst2;
- if not cst12 then
- begin
- if cst2 then gencst(op_loc,val2);
- if cst1 then
- begin l2:=lino; gencst(op_loc,val1); exchange(l1,l2) end;
- l2:=lino; genasp(op_zer); exchange(l1,l2);
- genasp(op_loc); gensp(BTS,3*sz_word)
- end;
- end
- else
- if cst12 then val2:=val1 else genasp(op_set);
- if cst12 then
- for i:=val1 to val2 do
- begin j:=i div NB2 + 1; ncst:=ncst+1;
- cstpart[j]:=cstpart[j] + [i mod NB2]
- end
- else
- if varpart then genasp(op_ior) else varpart:=true;
- until endofloop(fsys,[notsy..lparent],comma,+0191); {+0192}
- ak:=loaded;
- if ncst>0 then
- begin
- for i:=sizeof(asp,wordmult) div sz_word downto 1 do
- genwordset(cstpart[i]);
- if varpart then genasp(op_ior);
- end
- else
- if not varpart then genasp(op_zer); {empty set}
-end end;
-
-procedure factor(fsys: sos);
-var lip:ip; lsp:sp;
-begin with a do begin
- asp:=nil; packbit:=false; ak:=loaded;
- if find1([notsy..nilcst,lparent],fsys,+0193) then
- case sy of
- ident:
- begin lip:=searchid([konst,vars,field,func,carrbnd]); insym;
- case lip^.klass of
- func: {call moves result to top stack}
- begin call(fsys,lip); ak:=loaded; packbit:=false end;
- konst:
- begin asp:=lip^.idtype;
- if nicescalar(asp) then {including asp=nil}
- begin ak:=cst; pos.ad:=lip^.value end
- else
- begin ak:=ploaded; laedlb(abs(lip^.value));
- if asp^.form=scalar then
- begin load; if lip^.value<0 then negate end
- else
- if asp=zeroptr then ak:=loaded
- end
- end;
- field,vars:
- selector(fsys,lip,[used]);
- carrbnd:
- begin lsp:=lip^.idtype; assert formof(lsp,[carray]);
- descraddr(lsp^.arpos); lsp:=lsp^.inxtype; asp:=desub(lsp);
- if lip^.next=nil then ak:=ploaded {low bound} else
- begin gencst(op_loi,2*sz_int); genasp(op_adi) end;
- load; checkbnds(lsp);
- end;
- end {case}
- end;
- intcst:
- begin asp:=intptr; ak:=cst; pos.ad:=val; insym end;
- realcst:
- begin asp:=realptr; ak:=ploaded; laedlb(val); insym end;
- longcst:
- begin asp:=longptr; ak:=ploaded; laedlb(val); insym end;
- charcst:
- begin asp:=charptr; ak:=cst; pos.ad:=val; insym end;
- stringcst:
- begin asp:=stringstruct; laedlb(val); insym;
- if asp<>zeroptr then ak:=ploaded;
- end;
- nilcst:
- begin insym; asp:=nilptr; genasp(op_zer); end;
- lparent:
- begin insym; expression(fsys+[rparent]); nextif(rparent,+0194) end;
- notsy:
- begin insym; factor(fsys); load; genop(op_teq); asp:=desub(asp);
- if asp<>boolptr then errasp(+0195)
- end;
- lbrack:
- begin insym; buildset(fsys+[rbrack]); nextif(rbrack,+0196) end;
- end
-end end;
-
-procedure term(fsys:sos);
-var lsy:symbol; lsp:sp; l1:integer; first:boolean;
-begin with a,b do begin first:=true; l1:=lino;
- factor(fsys+[starsy..andsy]);
- while find2([starsy..andsy],fsys,+0197) do
- begin if first then begin load; first:=false end;
- lsy:=sy; insym; l1:=lino; lsp:=asp;
- factor(fsys+[starsy..andsy]); load; convert(lsp,l1);
- if asp<>nil then
- case lsy of
- starsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_mli) else
- if asp=realptr then genasp(op_mlf) else
- if asp^.form=power then genasp(op_and) else errasp(+0198);
- slashsy:
- begin
- if (asp=intptr) or (asp=longptr) then
- begin lsp:=asp;
- convert(realptr,l1); {make real of right operand}
- convert(lsp,l1); {make real of left operand}
- end;
- if asp=realptr then genasp(op_dvf) else errasp(+0199);
- end;
- divsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_dvi) else
- errasp(+0200);
- modsy:
- begin
- if asp=intptr then gensp(MDI,2*sz_int) else
- if asp=longptr then gensp(MDL,2*sz_long) else errasp(+0201);
- genasp(op_lfr);
- end;
- andsy:
- if asp=boolptr then genasp(op_and) else errasp(+0202);
- end {case}
- end {while}
-end end;
-
-procedure simpleexpression(fsys:sos);
-var lsy:symbol; lsp:sp; l1:integer; signed,min,first:boolean;
-begin with a do begin l1:=lino; first:=true;
- signed:=(sy=plussy) or (sy=minsy);
- if signed then begin min:=sy=minsy; insym end else min:=false;
- term(fsys + [minsy,plussy,orsy]); lsp:=desub(asp);
- if signed then
- if (lsp<>intptr) and (lsp<>realptr) and (lsp<>longptr) then
- errasp(+0203)
- else if min then
- begin load; first:=false; asp:=lsp; negate end;
- while find2([plussy,minsy,orsy],fsys,+0204) do
- begin if first then begin load; first:=false end;
- lsy:=sy; insym; l1:=lino; lsp:=asp;
- term(fsys+[minsy,plussy,orsy]); load; convert(lsp,l1);
- if asp<>nil then
- case lsy of
- plussy:
- if (asp=intptr) or (asp=longptr) then genasp(op_adi) else
- if asp=realptr then genasp(op_adf) else
- if asp^.form=power then genasp(op_ior) else errasp(+0205);
- minsy:
- if (asp=intptr) or (asp=longptr) then genasp(op_sbi) else
- if asp=realptr then genasp(op_sbf) else
- if asp^.form=power then begin genasp(op_com); genasp(op_and) end
- else errasp(+0206);
- orsy:
- if asp=boolptr then genasp(op_ior) else errasp(+0207);
- end {case}
- end {while}
-end end;
-
-procedure expression; { fsys:sos }
-var lsy:symbol; lsp:sp; l1,l2:integer;
-begin with a do begin l1:=lino;
- simpleexpression(fsys+[eqsy..insy]);
- if find2([eqsy..insy],fsys,+0208) then
- begin lsy:=sy; insym; lsp:=asp; loadcheap; l2:=lino;
- simpleexpression(fsys); loadcheap;
- if lsy=insy then
- begin
- if not formof(asp,[power]) then errasp(+0209) else
- if asp=nullset then genasp(op_and) else
- {this effectively replaces the word on top of the
- stack by the result of the 'in' operator: false }
- if not (compat(lsp,asp^.elset) <= subeq) then errasp(+0210) else
- begin exchange(l1,l2); genasp(op_inn) end
- end
- else
- begin convert(lsp,l2);
- if asp<>nil then
- case asp^.form of
- scalar:
- if asp=realptr then genasp(op_cmf) else genasp(op_cmi);
- pointer:
- if (lsy=eqsy) or (lsy=nesy) then genop(op_cmp) else
- errasp(+0211);
- power:
- case lsy of
- eqsy,nesy: genasp(op_cms);
- ltsy,gtsy: errasp(+0212);
- lesy: {'a<=b' equivalent to 'a-b=[]'}
- begin genasp(op_com); genasp(op_and); genasp(op_zer);
- genasp(op_cms); lsy:=eqsy
- end;
- gesy: {'a>=b' equivalent to 'a=a+b'}
- begin gencst(op_dup,2*sizeof(asp,wordmult));
- genasp(op_asp); genasp(op_ior);
- genasp(op_cms); lsy:=eqsy
- end
- end; {case}
- arrays:
- if string(asp) then
- begin gencst(op_loc,asp^.size);
- gensp(BCP,2*sz_addr+sz_word);
- gencst(op_lfr,sz_word)
- end
- else errasp(+0213);
- records: errasp(+0214);
- files: errasp(+0215)
- end; { case }
- case lsy of
- ltsy: genop(op_tlt);
- lesy: genop(op_tle);
- gtsy: genop(op_tgt);
- gesy: genop(op_tge);
- nesy: genop(op_tne);
- eqsy: genop(op_teq)
- end
- end;
- asp:=boolptr; ak:=loaded
- end;
-end end;
-
-{===================================================================}
-
-procedure statement(fsys:sos); forward;
- {this forward declaration can be avoided}
-
-procedure assignment(fsys:sos; fip:ip);
-var la:attr; l1,l2:integer;
-begin
- l1:=lino; selector(fsys+[becomes],fip,[assigned]); l2:=lino;
- la:=a; nextif(becomes,+0216);
- expression(fsys); loadcheap; checkasp(la.asp,+0217);
- exchange(l1,l2); a:=la;
- if not formof(la.asp,[arrays..records]) then store else
- begin loadaddr;
- if la.asp^.form<>carray then genasp(op_blm) else
- begin descraddr(la.asp^.arpos); gensp(ASZ,2*sz_addr);
- gencst(op_lfr,sz_word); gencst(op_bls,sz_word)
- end;
- end;
-end;
-
-procedure gotostatement;
-{jumps into structured statements can give strange results. }
-label 1;
-var llp:lp; lbp:bp; diff:integer;
-begin
- if sy<>intcst then error(+0218) else
- begin llp:=searchlab(b.lchain,val);
- if llp<>nil then gencst(op_bra,llp^.labname) else
- begin lbp:=b.nextbp; diff:=1;
- while lbp<>nil do
- begin llp:=searchlab(lbp^.lchain,val);
- if llp<>nil then goto 1;
- lbp:=lbp^.nextbp; diff:=diff+1;
- end;
-1: if llp=nil then errint(+0219,val) else
- begin
- if llp^.labdlb=0 then
- begin dlbno:=dlbno+1; llp^.labdlb:=dlbno;
- genop(ps_ina); argdlb(dlbno); {forward data reference}
- end;
- laedlb(llp^.labdlb);
- if diff=level-1 then gencst(op_zer,sz_addr) else
- gencst(op_lxl,diff);
- gensp(GTO,2*sz_addr);
- end;
- end;
- insym;
- end
-end;
-
-procedure compoundstatement(fsys:sos; err:integer);
-begin
- repeat statement(fsys+[semicolon])
- until endofloop(fsys,[beginsy..casesy],semicolon,err)
-end;
-
-procedure ifstatement(fsys:sos);
-var lb1,lb2:integer;
-begin with b do begin
- expression(fsys+[thensy,elsesy]);
- force(boolptr,+0220); ilbno:=ilbno+1; lb1:=ilbno; gencst(op_zeq,lb1);
- nextif(thensy,+0221); statement(fsys+[elsesy]);
- if find3(elsesy,fsys,+0222) then
- begin ilbno:=ilbno+1; lb2:=ilbno; gencst(op_bra,lb2);
- newilb(lb1); statement(fsys); newilb(lb2)
- end
- else newilb(lb1);
-end end;
-
-procedure casestatement(fsys:sos);
-label 1;
-type cip=^caseinfo;
- caseinfo=record
- next: cip;
- csstart: integer;
- cslab: integer
- end;
-var lsp:sp; head,p,q,r:cip; l0,l1:integer;
- ilb1,ilb2,dlb,i,n,m,min,max:integer;
-begin with b do begin
- expression(fsys+[ofsy,semicolon,ident..plussy]); lsp:=a.asp; load;
- if not nicescalar(desub(lsp)) then begin error(+0223); lsp:=nil end;
- l0:=lino; ilbno:=ilbno+1; ilb1:=ilbno;
- nextif(ofsy,+0224); head:=nil; max:=-MI2; min:=MI2; n:=0;
- repeat ilbno:=ilbno+1; ilb2:=ilbno; {label of current case}
- repeat i:=cstinteger(fsys+[comma,colon1,semicolon],lsp,+0225);
- if i>max then max:=i; if i<min then min:=i; n:=n+1;
- q:=head; r:=nil; new(p);
- while q<>nil do
- begin {chain all cases in ascending order}
- if q^.cslab>=i then
- begin if q^.cslab=i then error(+0226); goto 1 end;
- r:=q; q:=q^.next
- end;
-1: p^.next:=q; p^.cslab:=i; p^.csstart:=ilb2;
- if r=nil then head:=p else r^.next:=p;
- until endofloop(fsys+[colon1,semicolon],[ident..plussy],comma,+0227);
- {+0228}
- nextif(colon1,+0229); newilb(ilb2); statement(fsys+[semicolon]);
- gencst(op_bra,ilb1);
- until lastsemicolon(fsys,[ident..plussy],+0230); {+0231 +0232}
- assert n<>0; newilb(ilb1); l1:=lino;
- dlb:=newdlb; genop(ps_rom); argnil;
- if (max div 3) - (min div 3) < n then
- begin argcst(min); argcst(max-min);
- m:=op_csa;
- while head<>nil do
- begin
- while head^.cslab>min do
- begin argnil; min:=min+1 end;
- argilb(head^.csstart); min:=min+1; head:=head^.next
- end;
- end
- else
- begin argcst(n); m:=op_csb;
- while head<>nil do
- begin argcst(head^.cslab);argilb(head^.csstart);head:=head^.next end;
- end;
- argend; laedlb(dlb); gencst(m,sz_word); exchange(l0,l1)
-end end;
-
-procedure repeatstatement(fsys:sos);
-var lb1: integer;
-begin with b do begin
- ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
- compoundstatement(fsys+[untilsy],+0233); {+0234}
- nextif(untilsy,+0235); genlin;
- expression(fsys); force(boolptr,+0236); gencst(op_zeq,lb1);
-end end;
-
-procedure whilestatement(fsys:sos);
-var lb1,lb2: integer;
-begin with b do begin
- ilbno:=ilbno+1; lb1:=ilbno; newilb(lb1);
- ilbno:=ilbno+1; lb2:=ilbno;
- genlin; expression(fsys+[dosy]);
- force(boolptr,+0237); gencst(op_zeq,lb2);
- nextif(dosy,+0238); statement(fsys);
- gencst(op_bra,lb1); newilb(lb2)
-end end;
-
-procedure forstatement(fsys:sos);
-var lip:ip; tosym:boolean; endlab,looplab,savlb:integer;
- av,at1,at2:attr; lsp:sp;
-
-procedure forbound(fsys:sos; var fa:attr; fsp:sp);
-begin
- expression(fsys); fa:=a; force(fsp,+0239);
- if fa.ak<>cst then
- begin temporary(fsp,reg_any);
- genasp(op_dup); fa:=a; store
- end
-end;
-
-begin with b do begin savlb:=reglb; tosym:=false;
- ilbno:=ilbno+1; looplab:=ilbno; ilbno:=ilbno+1; endlab:=ilbno;
- inita(nil,0);
- if sy<>ident then error(+0240) else
- begin lip:=searchid([vars]); insym;
- a.asp:=lip^.idtype; a.pos:=lip^.vpos;
- lip^.iflag:=lip^.iflag+[used,assigned,loopvar];
- if level>1 then
- if (a.pos.ad>=0) or (a.pos.lv<>level) then
- error(+0241);
- end;
- lsp:=desub(a.asp);
- if not nicescalar(lsp) then begin errasp(+0242); lsp:=nil end;
- av:=a; nextif(becomes,+0243);
- forbound(fsys+[tosy,downtosy,notsy..lparent,dosy],at1,lsp);
- if find1([tosy,downtosy],fsys+[notsy..lparent,dosy],+0244) then
- begin tosym:=sy=tosy; insym end;
- forbound(fsys+[dosy],at2,lsp);
- if tosym then gencst(op_bgt,endlab) else gencst(op_blt,endlab);
- a:=at1; force(av.asp,+0245); a:=av; store; newilb(looplab);
- nextif(dosy,+0246); statement(fsys);
- a:=av; load; a:=at2; load; gencst(op_beq,endlab);
- a:=av; load; if tosym then genop(op_inc) else genop(op_dec);
- a.asp:=lsp; checkbnds(av.asp); a:=av; store;
- gencst(op_bra,looplab); newilb(endlab);
- reglb:=savlb
-end end;
-
-procedure withstatement(fsys:sos);
-var lnp,savtop:np; savlb:integer; pbit:boolean;
-begin with b do begin
- savlb:=reglb; savtop:=top;
- repeat variable(fsys+[comma,dosy]);
- if not formof(a.asp,[records]) then errasp(+0247) else
- begin pbit:=spack in a.asp^.sflag;
- new(lnp,wrec); lnp^.occur:=wrec; lnp^.fname:=a.asp^.fstfld;
- if a.ak<>fixed then
- begin loadaddr; temporary(nilptr,reg_pointer); store;
- a.ak:=pfixed;
- end;
- a.packbit:=pbit; lnp^.wa:=a; lnp^.nlink:=top; top:=lnp;
- end;
- until endofloop(fsys+[dosy],[ident],comma,+0248); {+0249}
- nextif(dosy,+0250); statement(fsys);
- top:=savtop; reglb:=savlb;
-end end;
-
-procedure assertion(fsys:sos);
-begin teststandard;
- if opt['a']=off then
- while not (sy in fsys) do insym
- else
- begin expression(fsys); force(boolptr,+0251);
- gencst(op_loc,srcorig); gensp(ASS,2*sz_word);
- end
-end;
-
-procedure statement; {fsys: sos}
-var lip:ip; llp:lp; lsy:symbol;
-begin
- assert [labelsy..casesy,endsy] <= fsys;
- assert [ident,intcst] * fsys = [];
- if find2([intcst],fsys+[ident],+0252) then
- begin llp:=searchlab(b.lchain,val);
- if llp=nil then errint(+0253,val) else
- begin if llp^.seen then errint(+0254,val) else llp^.seen:=true;
- newilb(llp^.labname)
- end;
- insym; nextif(colon1,+0255);
- end;
- if find2([ident,beginsy..casesy],fsys,+0256) then
- begin if giveline then if sy<>whilesy then genlin;
- if sy=ident then
- if id='assert ' then
- begin insym; assertion(fsys) end
- else
- begin lip:=searchid([vars,field,func,proc]); insym;
- if lip^.klass=proc then call(fsys,lip) else assignment(fsys,lip)
- end
- else
- begin lsy:=sy; insym;
- case lsy of
- beginsy:
- begin compoundstatement(fsys,+0257); {+0258}
- nextif(endsy,+0259)
- end;
- gotosy:
- gotostatement;
- ifsy:
- ifstatement(fsys);
- casesy:
- begin casestatement(fsys); nextif(endsy,+0260) end;
- whilesy:
- whilestatement(fsys);
- repeatsy:
- repeatstatement(fsys);
- forsy:
- forstatement(fsys);
- withsy:
- withstatement(fsys);
- end
- end;
- end
-end;
-
-{===================================================================}
-
-procedure body(fsys:sos; fip:ip);
-var i,dlb,l0,l1,ssp:integer; llp:lp; spset:boolean;
-begin with b do begin
-{produce PRO}
- genpnam(ps_pro,fip); argend;
- gencst(ps_mes,ms_par);argcst(fip^.maxlb); argend;
- l0:=lino; dlb:=0; trace('procentr',fip,dlb);
-{global labels}
- llp:=lchain; spset:=false;
- while llp<>nil do
- begin
- if llp^.labdlb<>0 then
- begin
- if not spset then
- begin spset:=true;
- gencst(ps_mes,ms_gto); argend;
- temporary(nilptr,-1); ssp:=a.pos.ad;
- gencst(op_lor,1); store
- end;
- argdlb(llp^.labdlb); lino:=lino+1; genop(ps_rom);
- argilb(llp^.labname); argcst(ssp); argend;
- end;
- llp:=llp^.nextlp
- end;
-{the body itself}
- currproc:=fip;
- compoundstatement(fsys,+0261); {+0262}
- trace('procexit',fip,dlb);
-{undefined labels}
- llp:=lchain;
- while llp<>nil do
- begin if not llp^.seen then errint(+0263,llp^.labval);
- llp:=llp^.nextlp
- end;
-{finish and close files}
- treewalk(top^.fname);
- if level=1 then
- begin l1:=lino;
- genop(op_fil); argdlb(fildlb); {temporarily}
- dlb:=newdlb; gencst(ps_con,argc+1);
- for i:=0 to argc do with argv[i] do
- begin argcst(ad);
- if (ad=-1) and (i>1) then errid(+0264,name)
- end;
- argend; gencst(op_lxl,0); laedlb(dlb); gencst(op_lae,0);
- gencst(op_lxa,0); gensp(INI,4*sz_addr);
- exchange(l0,l1); gencst(op_loc,0); gensp(HLT,0)
- end
- else
- begin inita(fip^.idtype,fip^.pfpos.ad);
- if fip^.klass=func then
- begin load;
- if not (assigned in fip^.iflag) then
- errid(-(+0265),fip^.name);
- end;
- genasp(op_ret);
- end;
- gencst(ps_end,-minlb);
-end end;
-
-{===================================================================}
-
-procedure block; {forward declared}
-begin with b do begin
- assert [labelsy..withsy] <= fsys;
- assert [ident,intcst,casesy,endsy,period] * fsys = [];
- if find3(labelsy,fsys,+0266) then labeldeclaration(fsys);
- if find3(constsy,fsys,+0267) then constdefinition(fsys);
- if find3(typesy,fsys,+0268) then typedefinition(fsys);
- if find3(varsy,fsys,+0269) then vardeclaration(fsys);
- if fip=progp then
- begin
- if iop[true]<>nil then
- begin argv[1].ad:=posaddr(holeb,textptr,false);
- iop[true]^.vpos.ad:=argv[1].ad
- end;
- if iop[false]<>nil then
- begin argv[0].ad:=posaddr(holeb,textptr,false);
- iop[false]^.vpos.ad:=argv[0].ad
- end;
- genhol; genpnam(ps_exp,fip);
- end; {externals are also extern for the main body}
- fip^.pfpos.ad:=negaddr(fip^.idtype); {function result area}
- while find2([procsy,funcsy],fsys,+0270) do pfdeclaration(fsys);
- if forwcount<>0 then error(+0271); {forw proc not specified}
- nextif(beginsy,+0272);
- body(fsys+[casesy,endsy],fip);
- nextif(endsy,+0273);
-end end;
-
-{===================================================================}
-
-procedure programme(fsys:sos);
-var stdin,stdout:boolean; p:ip;
-begin
- nextif(progsy,+0274); nextif(ident,+0275);
- if find3(lparent,fsys+[semicolon],+0276) then
- begin
- repeat
- if sy<>ident then error(+0277) else
- begin stdin:=id='input '; stdout:=id='output ';
- if stdin or stdout then
- begin p:=newip(vars,id,textptr,nil);
- enterid(p); iop[stdout]:=p;
- end
- else
- if argc<maxargc then
- begin
- argc:=argc+1; argv[argc].name:=id; argv[argc].ad:=-1
- end;
- insym
- end
- until endofloop(fsys+[rparent,semicolon],[ident],comma,+0278); {+0279}
- if argc>maxargc then
- begin error(+0280); argc:=maxargc end;
- nextif(rparent,+0281);
- end;
- nextif(semicolon,+0282);
- block(fsys,progp);
- if opt['l']<>off then
- begin gencst(ps_mes,ms_src); argcst(srcorig); argend end;
- eofexpected:=true; nextif(period,+0283);
-end;
-
-procedure compile;
-var lsys:sos;
-begin lsys:=[progsy,labelsy..withsy];
- repeat eofexpected:=false;
- main:=find2([progsy,labelsy,beginsy..withsy],lsys,+0284);
- if main then programme(lsys) else
- begin
- if find3(constsy,lsys,+0285) then constdefinition(lsys);
- if find3(typesy,lsys,+0286) then typedefinition(lsys);
- if find3(varsy,lsys,+0287) then vardeclaration(lsys);
- genhol;
- while find2([procsy,funcsy],lsys,+0288) do pfdeclaration(lsys);
- end;
- error(+0289);
- until false; { the only way out is the halt in nextln on eof }
-end;
-
-{===================================================================}
-
-procedure init1;
-var c:char;
-begin
-{reserved words}
- rw[ 0]:='if '; rw[ 1]:='do '; rw[ 2]:='of ';
- rw[ 3]:='to '; rw[ 4]:='in '; rw[ 5]:='or ';
- rw[ 6]:='end '; rw[ 7]:='for '; rw[ 8]:='nil ';
- rw[ 9]:='var '; rw[10]:='div '; rw[11]:='mod ';
- rw[12]:='set '; rw[13]:='and '; rw[14]:='not ';
- rw[15]:='then '; rw[16]:='else '; rw[17]:='with ';
- rw[18]:='case '; rw[19]:='type '; rw[20]:='goto ';
- rw[21]:='file '; rw[22]:='begin '; rw[23]:='until ';
- rw[24]:='while '; rw[25]:='array '; rw[26]:='const ';
- rw[27]:='label '; rw[28]:='repeat '; rw[29]:='record ';
- rw[30]:='downto '; rw[31]:='packed '; rw[32]:='program ';
- rw[33]:='function'; rw[34]:='procedur';
-{corresponding symbols}
- rsy[ 0]:=ifsy; rsy[ 1]:=dosy; rsy[ 2]:=ofsy;
- rsy[ 3]:=tosy; rsy[ 4]:=insy; rsy[ 5]:=orsy;
- rsy[ 6]:=endsy; rsy[ 7]:=forsy; rsy[ 8]:=nilcst;
- rsy[ 9]:=varsy; rsy[10]:=divsy; rsy[11]:=modsy;
- rsy[12]:=setsy; rsy[13]:=andsy; rsy[14]:=notsy;
- rsy[15]:=thensy; rsy[16]:=elsesy; rsy[17]:=withsy;
- rsy[18]:=casesy; rsy[19]:=typesy; rsy[20]:=gotosy;
- rsy[21]:=filesy; rsy[22]:=beginsy; rsy[23]:=untilsy;
- rsy[24]:=whilesy; rsy[25]:=arraysy; rsy[26]:=constsy;
- rsy[27]:=labelsy; rsy[28]:=repeatsy; rsy[29]:=recordsy;
- rsy[30]:=downtosy; rsy[31]:=packedsy; rsy[32]:=progsy;
- rsy[33]:=funcsy; rsy[34]:=procsy;
-{indices into rw to find reserved words fast}
- frw[0]:= 0; frw[1]:= 0; frw[2]:= 6; frw[3]:=15; frw[4]:=22;
- frw[5]:=28; frw[6]:=32; frw[7]:=33; frw[8]:=35;
-{char types}
- for c:=chr(0) to chr(maxcharord) do cs[c]:=others;
- for c:='0' to '9' do cs[c]:=digit;
- for c:='A' to 'Z' do cs[c]:=upper;
- for c:='a' to 'z' do cs[c]:=lower;
- cs[chr(ascnl)]:=layout;
- cs[chr(ascvt)]:=layout;
- cs[chr(ascff)]:=layout;
- cs[chr(asccr)]:=layout;
-{characters with corresponding chartype in ASCII order}
- cs[chr(ascht)]:=tabch;
- cs[' ']:=layout; cs['"']:=dquotech; cs['''']:=quotech;
- cs['(']:=lparentch; cs[')']:=rparentch; cs['*']:=star;
- cs['+']:=plusch; cs[',']:=commach; cs['-']:=minch;
- cs['.']:=periodch; cs['/']:=slash; cs[':']:=colonch;
- cs[';']:=semich; cs['<']:=lessch; cs['=']:=equal;
- cs['>']:=greaterch; cs['[']:=lbrackch; cs[']']:=rbrackch;
- cs['^']:=arrowch; cs['{']:=lbracech;
-{single character symbols in chartype order}
- csy[rparentch]:=rparent; csy[lbrackch]:=lbrack;
- csy[rbrackch]:=rbrack; csy[commach]:=comma;
- csy[semich]:=semicolon; csy[arrowch]:=arrow;
- csy[plusch]:=plussy; csy[minch]:=minsy;
- csy[slash]:=slashsy; csy[star]:=starsy;
- csy[equal]:=eqsy;
-{pascal library mnemonics}
- lmn[ELN ]:='_eln'; lmn[EFL ]:='_efl'; lmn[CLS ]:='_cls';
- lmn[WDW ]:='_wdw';
- lmn[OPN ]:='_opn'; lmn[GETX]:='_get'; lmn[RDI ]:='_rdi';
- lmn[RDC ]:='_rdc'; lmn[RDR ]:='_rdr'; lmn[RDL ]:='_rdl';
- lmn[RLN ]:='_rln';
- lmn[CRE ]:='_cre'; lmn[PUTX]:='_put'; lmn[WRI ]:='_wri';
- lmn[WSI ]:='_wsi'; lmn[WRC ]:='_wrc'; lmn[WSC ]:='_wsc';
- lmn[WRS ]:='_wrs'; lmn[WSS ]:='_wss'; lmn[WRB ]:='_wrb';
- lmn[WSB ]:='_wsb'; lmn[WRR ]:='_wrr'; lmn[WSR ]:='_wsr';
- lmn[WRL ]:='_wrl'; lmn[WSL ]:='_wsl';
- lmn[WRF ]:='_wrf'; lmn[WRZ ]:='_wrz'; lmn[WSZ ]:='_wsz';
- lmn[WLN ]:='_wln'; lmn[PAG ]:='_pag';
- lmn[ABR ]:='_abr'; lmn[RND ]:='_rnd'; lmn[SINX]:='_sin';
- lmn[COSX]:='_cos'; lmn[EXPX]:='_exp'; lmn[SQT ]:='_sqt';
- lmn[LOG ]:='_log'; lmn[ATN ]:='_atn'; lmn[ABI ]:='_abi';
- lmn[ABL ]:='_abl';
- lmn[BCP ]:='_bcp'; lmn[BTS ]:='_bts'; lmn[NEWX]:='_new';
- lmn[SAV ]:='_sav'; lmn[RST ]:='_rst'; lmn[INI ]:='_ini';
- lmn[HLT ]:='_hlt'; lmn[ASS ]:='_ass'; lmn[GTO ]:='_gto';
- lmn[PAC ]:='_pac'; lmn[UNP ]:='_unp'; lmn[DIS ]:='_dis';
- lmn[ASZ ]:='_asz'; lmn[MDI ]:='_mdi'; lmn[MDL ]:='_mdl';
-{scalar variables}
- b.nextbp:=nil;
- b.reglb:=0;
- b.minlb:=0;
- b.ilbno:=0;
- b.forwcount:=0;
- b.lchain:=nil;
- srcchno:=0;
- srclino:=1;
- srcorig:=1;
- lino:=0;
- dlbno:=0;
- holeb:=0;
- argc:=1;
- lastpfno:=0;
- giveline:=true;
- including:=false;
- eofexpected:=false;
- intypedec:=false;
- fltused:=false;
- seconddot:=false;
- iop[false]:=nil;
- iop[true]:=nil;
- argv[0].ad:=-1;
- argv[1].ad:=-1;
-end;
-
-procedure init2;
-var p:ip; k:idclass; j:standpf;
- pfn:array[standpf] of idarr;
-begin
-{initialize the first name space}
- new(top,blck); top^.occur:=blck; top^.nlink:=nil; top^.fname:=nil;
- level:=0;
-{undefined identifier pointers used by searchid}
- for k:=types to func do
- undefip[k]:=newip(k,spaces,nil,nil);
-{names of standard procedures/functions}
- pfn[pread ]:='read '; pfn[preadln ]:='readln ';
- pfn[pwrite ]:='write '; pfn[pwriteln ]:='writeln ';
- pfn[pput ]:='put '; pfn[pget ]:='get ';
- pfn[ppage ]:='page '; pfn[preset ]:='reset ';
- pfn[prewrite ]:='rewrite '; pfn[pnew ]:='new ';
- pfn[pdispose ]:='dispose '; pfn[ppack ]:='pack ';
- pfn[punpack ]:='unpack '; pfn[pmark ]:='mark ';
- pfn[prelease ]:='release '; pfn[phalt ]:='halt ';
- pfn[feof ]:='eof '; pfn[feoln ]:='eoln ';
- pfn[fabs ]:='abs '; pfn[fsqr ]:='sqr ';
- pfn[ford ]:='ord '; pfn[fchr ]:='chr ';
- pfn[fpred ]:='pred '; pfn[fsucc ]:='succ ';
- pfn[fodd ]:='odd '; pfn[ftrunc ]:='trunc ';
- pfn[fround ]:='round '; pfn[fsin ]:='sin ';
- pfn[fcos ]:='cos '; pfn[fexp ]:='exp ';
- pfn[fsqt ]:='sqrt '; pfn[flog ]:='ln ';
- pfn[fatn ]:='arctan ';
-{standard procedure/function identifiers}
- for j:=pread to phalt do
- begin new(p,proc,standard); p^.klass:=proc;
- p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
- end;
- for j:=feof to fatn do
- begin new(p,func,standard); p^.klass:=func; p^.idtype:=nil;
- p^.name:=pfn[j]; p^.pfkind:=standard; p^.key:=j; enterid(p);
- end;
-{program identifier}
- progp:=newip(proc,'m_a_i_n ',nil,nil);
-end;
-
-procedure init3;
-var n:np; p,q:ip; i:integer; c:char;
-begin
- for i:=0 to sz_last do readln(errors,sizes[i]);
- gencst(ps_mes,ms_emx); argcst(sz_word); argcst(sz_addr); argend;
- ix:=1;
- while not eoln(errors) do
- begin read(errors,c);
- if ix<smax then begin strbuf[ix]:=c; ix:=ix+1 end
- end;
- readln(errors); strbuf[ix]:=chr(0);
- for i:=1 to fnmax do
- if i<ix then source[i]:=strbuf[i] else source[i]:=' ';
- fildlb:=romstr(sp_scon,0);
-{standard type pointers}
- intptr :=newsp(scalar,sz_int);
- realptr:=newsp(scalar,sz_real);
- longptr:=newsp(scalar,sz_long);
- charptr:=newsp(scalar,sz_char);
- boolptr:=newsp(scalar,sz_bool);
- nilptr :=newsp(pointer,sz_addr);
- zeroptr:=newsp(pointer,sz_addr);
- procptr:=newsp(records,sz_proc);
- nullset:=newsp(power,sz_word); nullset^.elset:=nil;
- textptr:=newsp(files,sz_head+sz_buff); textptr^.filtype:=charptr;
-{standard type names}
- enterid(newip(types,'integer ',intptr,nil));
- enterid(newip(types,'real ',realptr,nil));
- enterid(newip(types,'char ',charptr,nil));
- enterid(newip(types,'boolean ',boolptr,nil));
- enterid(newip(types,'text ',textptr,nil));
-{standard constant names}
- q:=nil; p:=newip(konst,'false ',boolptr,q); enterid(p);
- q:=p; p:=newip(konst,'true ',boolptr,q); p^.value:=1; enterid(p);
- boolptr^.fconst:=p;
- p:=newip(konst,'maxint ',intptr,nil); p^.value:=MI2; enterid(p);
- p:=newip(konst,spaces,charptr,nil); p^.value:=maxcharord;
- charptr^.fconst:=p;
-{new name space for user externals}
- new(n,blck); n^.occur:=blck; n^.nlink:=top; n^.fname:=nil; top:=n;
-{options}
- for c:='a' to 'z' do begin opt[c]:=0; forceopt[c]:=false end;
- opt['a']:=on;
- opt['i']:=NB1*sz_iset;
- opt['l']:=on;
- opt['o']:=on;
- opt['r']:=on;
- sopt:=off;
-end;
-
-procedure init4;
-begin
- copt:=opt['c'];
- dopt:=opt['d'];
- iopt:=opt['i'];
- sopt:=opt['s'];
- if sopt<>off then begin copt:=off; dopt:=off end
- else if opt['u']<>off then cs['_']:=lower;
- if copt<>off then enterid(newip(types,'string ',zeroptr,nil));
- if dopt<>off then enterid(newip(types,'long ',longptr,nil));
- if opt['o']=off then begin gencst(ps_mes,ms_opt); argend end;
- if dopt<>off then fltused:=true; {temporary kludge}
-end;
-
-begin {main body of pcompiler}
- init1; {initialize tables and scalars}
- init2; {initialize heap objects}
- rewrite(em); put2(sp_magic); reset(errors);
- init3; {size dependent initialization}
- while not eof(errors) do
- begin options(false); readln(errors) end;
- rewrite(errors);
- if not eof(input) then
- begin nextch; insym;
- init4; {option dependent initialization}
- compile
- end;
-#ifdef STANDARD
-9999: ;
-#endif
-end. {pcompiler}
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m6500
-var M=6500
-var LIB=mach/6500/lib/tail_
-var RT=mach/6500/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) -o > (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var i=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m6809
-var M=6809
-var LIB=mach/6809/lib/tail_
-var RT=mach/6809/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=4
-var M=cpm
-var NAME=CPM
-var LIB=mach/z80/int/lib/tail_
-var RT=mach/z80/int/lib/head_
-var SIZE_F=-sm
-var INCLUDES=-I{EM}/include -I/usr/include
-name asld
- from .k.m.a
- to e.out
- program {EM}/lib/em_ass
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -+* ASS_F={ASS_F?} -+*
- mapflag --* ASS_F={ASS_F?} --*
- mapflag -s* SIZE_F=-s*
- args {ASS_F?} ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{LIB}mon)
- prop C
-end
+++ /dev/null
-# (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
-name cpp
- # no from, it's governed by the P property
- to .i
- program {EM}/lib/cpp
- mapflag -I* CPP_F={CPP_F?} -I*
- mapflag -U* CPP_F={CPP_F?} -U*
- mapflag -D* CPP_F={CPP_F?} -D*
- args {CPP_F?} {INCLUDES?} -D{NAME} -DEM_WSIZE={w} -DEM_PSIZE={p} \
--DEM_SSIZE={s} -DEM_LSIZE={l} -DEM_FSIZE={f} -DEM_DSIZE={d} <
- prop >P
-end
-name cem
- from .c
- to .k
- program {EM}/lib/em_cem
- mapflag -p CEM_F={CEM_F?} -Xp
- mapflag -L CEM_F={CEM_F?} -l
- args -Vw{w}i{w}p{p}f{f}s{s}l{l}d{d} {CEM_F?}
- prop <>p
- rts .c
- need .c
-end
-name pc
- from .p
- to .k
- program {EM}/lib/em_pc
- mapflag -p PC_F={PC_F?} -p
- mapflag -w PC_F={PC_F?} -w
- mapflag -E PC_F={PC_F?} -E
- mapflag -e PC_F={PC_F?} -e
- mapflag -{*} PC_F={PC_F?} -\{*}
- mapflag -L PC_F={PC_F?} -\{l-}
- args -Vw{w}p{p}f{d}l{l} {PC_F?} < > {SOURCE}
- prop m
- rts .p
- need .p
- end
- name encode
- from .e
- to .k
- program {EM}/lib/em_encode
- args <
- prop >m
-end
-name opt
- from .k
- to .m
- program {EM}/lib/em_opt
- mapflag -LIB OPT_F={OPT_F?} -L
- args {OPT_F?} <
- prop >O
-end
-name decode
- from .k.m
- to .e
- program {EM}/lib/em_decode
- args <
- prop >
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8086
-var M=i86
-var LIB=mach/i86/lib/tail_
-var LIBIBM=mach/ibm/lib/tail_
-var RT=mach/i86/lib/head_
-var RTIBM=mach/ibm/lib/head_
-var INCLUDES=-I{EM}/include -I{EM}/mach/ibm/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RTIBM}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.e:{TAIL}={EM}/{LIBIBM}em) \
-(.c.p:{TAIL}={EM}/{LIBIBM}mon) \
-(.e:{TAIL}={EM}/{LIBIBM}em.vend)
- prop C
-end
+++ /dev/null
-var w=2
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k2
-var M=m68k2
-var LIBDIR=mach/m68k2/lib
-var LIB=mach/m68k2/lib/tail_
-var RT=mach/m68k2/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \
-(.c:{TAIL}={EM}/{LIBDIR}/write.s) \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=1
-var p=2
-var s=1
-var l=2
-var f=4
-var d=8
-var NAME=nascom
-var M=z80a
-var LIB=mach/z80a/lib/tail_
-var RT=mach/z80a/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) ({RTS}:.c={EM}/{RT}cc) -o > \
-(.e:{TAIL}={EM}/{LIB}em.1 {EM}/{LIB}em.2)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8086
-var M=i86
-var LIB=mach/i86/lib/tail_
-var RT=mach/i86/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p.e:{TAIL}={EM}/{LIB}netio) (.c.p.e:{TAIL}={EM}/{LIB}alo) \
-(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8086
-var M=i86
-var LIB=mach/i86/lib/tail_
-var ALIB=mach/i86/lib/sat_tail_
-var RT=mach/i86/lib/head_
-var ART=mach/i86/lib/sat_head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{ART}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{ALIB}mon) (.c.p.e:{TAIL}={EM}/{LIB}alo) \
-(.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var M=int
-var NAME=int22
-var LIB=mach/int/lib/tail_
-var RT=mach/int/lib/head_
-var SIZE_FLAG=-sm
-var INCLUDES=-I{EM}/include -I/usr/include
-name asld
- from .k.m.a
- to e.out
- program {EM}/lib/em_ass
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -+* ASS_F={ASS_F?} -+*
- mapflag --* ASS_F={ASS_F?} --*
- mapflag -s* SIZE_FLAG=-s*
- args {SIZE_FLAG} \
- ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
- (.p:{TAIL}={EM}/{LIB}pc) \
- (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
- (.c.p:{TAIL}={EM}/{LIB}mon)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8080
-var M=8080
-var LIB=mach/8080/lib/tail_
-var RT=mach/8080/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_be
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args ({RTS}:.c={EM}/{RT}cc) -o > <
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=i8086
-var M=i86
-var LIB=mach/i86/lib/tail_
-var RT=mach/i86/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p.e:{TAIL}={EM}/{LIB}alo) (.c.p:{TAIL}={EM}/{LIB}mon) \
-(.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k2
-var M=m68k2
-var LIB=mach/m68k2/lib/tail_
-var RT=mach/m68k2/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=4
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k4
-var M=m68k4
-var LIBDIR=mach/m68k4/lib
-var LIB=mach/m68k4/lib/tail_
-var RT=mach/m68k4/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p.c:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \
-(.c:{TAIL}={EM}/{LIBDIR}/write.s) \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var M=pdp
-var NAME=pdp
-var LIB=mach/pdp/lib/tail_
-var RT=mach/pdp/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name as
- from .s
- to .o
- program /bin/as
- args - -o > <
- prop m
-end
-name ld
- from .o.a
- to a.out
- program /bin/ld
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
- ({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
- (.p:{TAIL}={EM}/{LIB}pc) \
- (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
- (.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}=/lib/libc.a)
- prop C
-end
+++ /dev/null
-var w=2
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=m68k2
-var M=m68k2
-var LIB=mach/m68k2/lib/tail_
-var RT=mach/m68k2/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .o
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .o.s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i
- mapflag -n
- args (.e:{HEAD}={EM}/{RT}em.pmds) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon.pmds {EM}/{LIB}em.vend)
- prop Cm
-end
+++ /dev/null
-var w=4
-var p=4
-var s=2
-var l=4
-var f=4
-var d=8
-var M=vax4
-var NAME=vax4
-var LIB=mach/vax4/lib/tail_
-var RT=mach/vax4/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asopt
- from .s
- to .so
- program /bin/sed
- args -f {EM}/mach/vax4/cg/sedf
- prop O<>
-end
-name as
- from .s.so
- to .o
- program /bin/as
- args - -o > <
- prop m
-end
-name ld
- from .o.a
- to a.out
- program /bin/ld
- mapflag -l* LNAME={EM}/{LIB}*
- args (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.c.p:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=z80
-var M=z80
-var LIB=mach/z80/lib/tail_
-var RT=mach/z80/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-var w=2
-var p=2
-var s=2
-var l=4
-var f=4
-var d=8
-var NAME=z8000
-var M=z8000
-var LIB=mach/z8000/lib/tail_
-var RT=mach/z8000/lib/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m
- to .s
- program {EM}/lib/{M}_cg
- args <
- prop >
- need .e
-end
-name asld
- from .s.a
- to a.out
- program {EM}/lib/{M}_as
- mapflag -l* LNAME={EM}/{LIB}*
- mapflag -i IFILE={EM}/{RT}i
- args {IFILE?} (.e:{HEAD}={EM}/{RT}em) \
-({RTS}:.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \
-(.p:{TAIL}={EM}/{LIB}pc) (.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \
-(.p.c:{TAIL}={EM}/{LIB}mon) (.e:{TAIL}={EM}/{LIB}em)
- prop C
-end
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * machine dependent back end routines for the PDP-11
- */
-
-#define REGPATCH
-
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == EM_WSIZE)
- part_flush();
- if (sz == 1) {
- w &= 0xFF;
- if (part_size)
- w <<= 8;
- part_word |= w;
- } else {
- assert(sz == 2);
- part_word = w;
- }
- part_size += sz;
-}
-
-con_mult(sz) word sz; {
- long l;
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- l = atol(str);
- fprintf(codefile,"\t%o;%o\n",(int)(l>>16),(int)l);
-}
-
-con_float() {
- double f;
- register short *p,i;
-
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- f = atof(str);
- p = (short *) &f;
- i = *p++;
- if (argval == 8) {
- fprintf(codefile,"\t%o;%o;",i,*p++);
- i = *p++;
- }
- fprintf(codefile,"\t%o;%o\n",i,*p++);
-}
-
-#ifdef REGVARS
-
-char Rstring[10] = "RT";
-
-regscore(off,size,typ,score,totyp) long off; {
-
- if (size != 2)
- return(-1);
- score -= 1; /* allow for save/restore */
- if (off>=0)
- score -= 2;
- if (typ==reg_pointer)
- score *= 17;
- else if (typ==reg_loop)
- score = 10*score+50; /* Guestimate */
- else
- score *= 10;
- return(score); /* estimated # of words of profit */
-}
-
-i_regsave() {
-
- Rstring[2] = 0;
-}
-
-f_regsave() {}
-
-regsave(regstr,off,size) char *regstr; long off; {
-
- fprintf(codefile,"/ Local %ld into %s\n",off,regstr);
-#ifndef REGPATCH
- fprintf(codefile,"mov %s,-(sp)\n",regstr);
-#endif
- strcat(Rstring,regstr);
- if (off>=0)
- fprintf(codefile,"mov 0%lo(r5),%s\n",off,regstr);
-}
-
-regreturn() {
-
-#ifdef REGPATCH
- fprintf(codefile,"jmp eret\n");
-#else
- fprintf(codefile,"jmp %s\n",Rstring);
-#endif
-}
-
-#endif
-
-prolog(nlocals) full nlocals; {
-
-#ifdef REGPATCH
- fprintf(codefile,"mov r2,-(sp)\nmov r4,-(sp)\n");
-#endif
- fprintf(codefile,"mov r5,-(sp)\nmov sp,r5\n");
- if (nlocals == 0)
- return;
- if (nlocals == 2)
- fprintf(codefile,"tst -(sp)\n");
- else
- fprintf(codefile,"sub $0%o,sp\n",nlocals);
-}
-
-dlbdlb(as,ls) string as,ls; {
-
- if (strlen(as)+strlen(ls)+2<sizeof(labstr)) {
- strcat(ls,":");
- strcat(ls,as);
- } else
- fatal("too many consecutive labels");
-}
-
-mes(type) word type; {
- int argt ;
-
- switch ( (int)type ) {
- case ms_ext :
- for (;;) {
- switch ( argt=getarg(
- ptyp(sp_cend)|ptyp(sp_pnam)|sym_ptyp) ) {
- case sp_cend :
- return ;
- default:
- strarg(argt) ;
- fprintf(codefile,".globl %s\n",argstr) ;
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
+++ /dev/null
-/* $Header$ */
-
-#define ex_ap(y) fprintf(codefile,"\t.globl %s\n",y)
-#define in_ap(y) /* nothing */
-
-#define newilb(x) fprintf(codefile,"%s:\n",x)
-#define newdlb(x) fprintf(codefile,"%s:\n",x)
-#define newlbss(l,x) fprintf(codefile,"%s:.=.+0%o\n",l,x);
-
-#define cst_fmt "$0%o"
-#define off_fmt "0%o"
-#define ilb_fmt "I%02x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "0%o+hol%d"
-
-#define con_cst(x) fprintf(codefile,"0%o\n",x)
-#define con_ilb(x) fprintf(codefile,"%s\n",x)
-#define con_dlb(x) fprintf(codefile,"%s\n",x)
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-#include <stdio.h>
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-char buf[512];
-
-main() {
- register n,sa;
- register char *p;
-
- sa=0;
- for (;;) {
- getline(buf);
- if (n=stackadjust()) {
- sa += n;
- continue;
- }
- if (nullinstruction())
- continue;
- if (sa) {
- if (buf[0]=='t' && buf[1]=='s' && buf[2]=='t' && buf[3]==' ') {
- sa -= 2;
- buf[0]='m';
- buf[1]='o';
- buf[2]='v';
- strcat(buf,",(sp)+");
- } else if (buf[0]=='m' && buf[1]=='o' && buf[2]=='v' &&
- buf[3]==' ' && (p=index(&buf[5],','))!=0 &&
- p[1]=='-' && p[2]=='(' && p[3]=='s') {
- sa -= 2;
- p[1]=' ';
- }
- }
- switch(sa) {
- case 0:break;
- case 2:puts("tst (sp)+");sa=0;break;
- case 4:puts("cmp (sp)+,(sp)+");sa=0;break;
- case 6:puts("add $6.,sp");sa=0;break;
- }
- puts(buf);
- }
-}
-
-getline(buf) register char *buf; {
- register c;
-
- while ((c=getchar())==' ' || c=='\t')
- ;
- if (c==EOF)
- exit(0);
- do *buf++=c;
- while ((c=getchar())!='\n');
- *buf=0;
-}
-
-stackadjust() {
-
- if (buf[0]=='t' &&
- buf[1]=='s' &&
- buf[2]=='t' &&
- buf[3]==' ' &&
- buf[4]=='(' &&
- buf[5]=='s' &&
- buf[6]=='p' &&
- buf[7]==')' &&
- buf[8]=='+') return(2);
- if (buf[0]=='c' &&
- buf[1]=='m' &&
- buf[2]=='p' &&
- buf[3]==' ' &&
- buf[4]=='(' &&
- buf[5]=='s' &&
- buf[6]=='p' &&
- buf[7]==')' &&
- buf[8]=='+' &&
- buf[9]==',' &&
- buf[10]=='(' &&
- buf[11]=='s' &&
- buf[12]=='p' &&
- buf[13]==')' &&
- buf[14]=='+') return(4);
- if (buf[0]=='a' &&
- buf[1]=='d' &&
- buf[2]=='d' &&
- buf[3]==' ' &&
- buf[4]=='$' &&
- buf[5]=='6' &&
- buf[6]=='.' &&
- buf[7]==',' &&
- buf[8]=='s' &&
- buf[9]=='p' &&
- buf[10]==0) return(6);
- return(0);
-}
-
-nullinstruction() {
- register char *p;
-
- if (buf[4]=='$' && buf[5]=='0' && buf[6]=='.' && buf[7]==',') {
- p=index(buf,'-');
- if (p!=0 && p[1]=='(')
- return(0);
- p=index(buf,'+');
- if (p!=0 && p[-1]==')')
- return(0);
- if (buf[0]=='b' && buf[1]=='i' && (buf[2]=='s' || buf[2]=='c'))
- return(1);
- if (buf[0]=='a' && buf[1]=='d' && buf[2]=='d')
- return(1);
- if (buf[0]=='s' && buf[1]=='u' && buf[2]=='b')
- return(1);
- }
- return(0);
-}
+++ /dev/null
-"$Header$"
-/********************************************************
- * Back end tables for pdp 11 *
- * Authors : Ceriel J.H. Jacobs,Hans van Staveren *
- * *
- * wordsize = 2 bytes, pointersize = 2 bytes. *
- * *
- * Register r5 is used for the LB, the stack pointer *
- * is used for SP. Also some global variables are used: *
- * - reghp~ : the heap pointer *
- * - trpim~ : trap ignore mask *
- * - trppc~ : address of user defined trap handler *
- * - retar : function return area for size>4 *
- * *
- * Timing is based on the timing information available *
- * for the 11/45. Hardware floating point processor is *
- * assumed. *
- ********************************************************/
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#define REGPATCH /* save all registers in link block */
-
-#ifdef REGPATCH
-#define SL 8
-#define SSL "010"
-#else REGPATCH
-#define SL 4
-#define SSL "4"
-#endif REGPATCH
-
-#define NC nocoercions:
-
-/* options */
-/* #define DORCK /* rck is expanded instead of thrown away */
-#define REGVARS /* use register variables */
-
-EM_WSIZE=2
-EM_PSIZE=2
-EM_BSIZE=SL
-
-TIMEFACTOR= 1/300
-FORMAT="0%o"
-
-REGISTERS:
-r0 = ("r0", 2), REG.
-r1 = ("r1", 2), REG, ODD_REG.
-#ifdef REGVARS
-r2 = ("r2", 2) regvar, REG.
-#else
-/* r2 = ("r2", 2), REG. */
-#endif
-r3 = ("r3", 2), REG, ODD_REG.
-#ifdef REGVARS
-r4 = ("r4", 2) regvar, REG.
-#else
-/* r4 = ("r4", 2), REG. */
-#endif
-lb = ("r5", 2), localbase.
-r01 = ("r0", 4, r0, r1), REG_PAIR.
-#ifndef REGVARS
-/* r23 = ("r2", 4, r2, r3), REG_PAIR. */
-#endif
-fr0 = ("fr0", 4), FLT_REG.
-fr1 = ("fr1", 4), FLT_REG.
-fr2 = ("fr2", 4), FLT_REG.
-fr3 = ("fr3", 4), FLT_REG.
-fr01 = ("fr0", 8, fr0, fr1), FLT_REG_PAIR.
-fr23 = ("fr2", 8, fr2, fr3), FLT_REG_PAIR.
-dr0 = ("fr0", 8, fr0), DBL_REG.
-dr1 = ("fr1", 8, fr1), DBL_REG.
-dr2 = ("fr2", 8, fr2), DBL_REG.
-dr3 = ("fr3", 8, fr3), DBL_REG.
-dr01 = ("fr0", 16, dr0, dr1), DBL_REG_PAIR.
-dr23 = ("fr2", 16, dr2, dr3), DBL_REG_PAIR.
-
-TOKENS:
-
-/********************************
- * Types on the EM-machine *
- ********************************/
-
-CONST2 = {INT num;} 2 cost=(2,300) "$%[num]"
-LOCAL2 = {INT ind,size;} 2 cost=(2,600) "%[ind](r5)"
-LOCAL4 = {INT ind,size;} 4 cost=(2,1200) "%[ind](r5)"
-ADDR_LOCAL = {INT ind;} 2
-ADDR_EXTERNAL = {STRING ind;} 2 cost=(2,300) "$%[ind]"
-
-/********************************************************
- * Now mostly addressing modes of target machine *
- ********************************************************/
-
-regdef2 = {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
-regind2 = {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
-reginddef2 = {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
-regconst2 = {REGISTER reg; STRING ind;} 2
-/********************************************************
- * This means : add "reg" and "ind" to get address. *
- * Not really addressable on the PDP 11 *
- ********************************************************/
-relative2 = {STRING ind;} 2 cost=(2,600) "%[ind]"
-reldef2 = {STRING ind;} 2 cost=(2,1050) "*%[ind]"
-regdef1 = {REGISTER reg;} 2 cost=(0,300) "*%[reg]"
-regind1 = {REGISTER reg; STRING ind;} 2 cost=(2,600) "%[ind](%[reg])"
-reginddef1 = {REGISTER reg; STRING ind;} 2 cost=(2,1050) "*%[ind](%[reg])"
-relative1 = {STRING ind;} 2 cost=(2,600) "%[ind]"
-reldef1 = {STRING ind;} 2 cost=(2,1050) "*%[ind]"
-
-/************************************************************************
- * fto* are floats converted to *, conversion is delayed to be combined *
- * with store. *
- ************************************************************************/
-
-ftoint = {REGISTER reg;} 2
-ftolong = {REGISTER reg;} 4
-
-/************************************************************************
- * ...4 and ...8 are only addressable by the floating point processor. *
- ************************************************************************/
-
-regind4 = {REGISTER reg; STRING ind; } 4 cost=(2,3630) "%[ind](%[reg])"
-relative4 = {STRING ind; } 4 cost=(2,3630) "%[ind]"
-regdef4 = {REGISTER reg;} 4 cost=(2,3240) "*%[reg]"
-regdef8 = {REGISTER reg;} 8 cost=(2,5220) "*%[reg]"
-relative8 = {STRING ind; } 8 cost=(2,5610) "%[ind]"
-regind8 = {REGISTER reg; STRING ind;} 8 cost=(2,5610) "%[ind](%[reg])"
-
-TOKENEXPRESSIONS:
-SCR_REG = REG * SCRATCH
-SCR_FLT_REG = FLT_REG * SCRATCH
-SCR_DBL_REG = DBL_REG * SCRATCH
-SCR_ODD_REG = ODD_REG * SCRATCH
-SCR_REG_PAIR = REG_PAIR * SCRATCH
-all= ALL
-source2 = REG + regdef2 + regind2 + reginddef2 + localbase +
- relative2 + reldef2 + ADDR_EXTERNAL + CONST2 + LOCAL2
-xsource2 = source2 + ftoint
-source1 = regdef1 + regind1 + reginddef1 + relative1 +
- reldef1
-source1or2 = source1 + source2
-long4 = relative4 + regdef4 + LOCAL4 + regind4 + REG_PAIR
-longf4 = long4 + FLT_REG - REG_PAIR
-double8 = relative8 + regdef8 + regind8 + DBL_REG
-indexed2 = regind2 + reginddef2
-indexed4 = regind4
-indexed8 = regind8
-indexed = indexed2 + indexed4 + indexed8
-regdeferred = regdef2 + regdef4 + regdef8
-indordef = indexed + regdeferred
-locals = LOCAL2 + LOCAL4
-variable2 = relative2 + reldef2
-variable4 = relative4
-variable8 = relative8
-variable = variable2 + variable4 + variable8
-dadres2 = relative2 + REG + regind2
-regs = REG + REG_PAIR + FLT_REG + FLT_REG_PAIR +
- DBL_REG + DBL_REG_PAIR
-noconst2 = source2 - CONST2 - ADDR_EXTERNAL
-allexeptcon = all - regs - CONST2 - ADDR_LOCAL - ADDR_EXTERNAL
-externals = relative1 + relative2 + relative4 + relative8
-posextern = variable + regdeferred + indexed + externals
-diradr2 = regconst2 + ADDR_EXTERNAL
-
-#ifdef REGVARS
-#define INDSTORE remove(allexeptcon-locals) remove(locals, inreg(%[ind])==0)
-#else
-#define INDSTORE remove(allexeptcon)
-#endif
-
-CODE:
-
-/********************************************************
- * Group 1 : load instructions. *
- * *
- * For most load instructions no code is generated. *
- * Action : put something on the fake-stack. *
- ********************************************************/
-
-loc | | | {CONST2, $1} | |
-ldc | | | {CONST2, loww(1)} {CONST2, highw(1)} | |
-#ifdef REGVARS
-lol inreg($1)==2| | | regvar($1) | |
-#endif
-lol | | | {LOCAL2, $1,2} | |
-loe | | | {relative2, $1} | |
-#ifdef REGVARS
-lil inreg($1)==2| | | {regdef2, regvar($1)} | |
-#endif
-lil | | | {reginddef2, lb, tostring($1)} | |
-lof | REG | | {regind2,%[1],tostring($1)} | |
-... | NC regconst2 |
- | {regind2,%[1.reg],tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {relative2,tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL2, %[1.ind] + $1,2} | |
-#ifdef REGVARS
-lol lof inreg($1)!=2 | |
- allocate(REG={LOCAL2, $1,2})
- | {regind2,%[a],tostring($2)} | |
-#endif
-lal | | | {ADDR_LOCAL, $1} | |
-lae | | | {ADDR_EXTERNAL, $1} | |
-lpb | | | | adp SL |
-lxl $1==0 | | | lb | |
-lxl $1==1 | | | {LOCAL2 ,SL,2} | |
-lxl $1==2 | | allocate(REG={LOCAL2, SL, 2})
- | {regind2,%[a], SSL} | |
-lxl $1==3 | | allocate(REG={LOCAL2, SL, 2})
- move({regind2,%[a], SSL},%[a])
- | {regind2,%[a], SSL} | |
-lxl $1>3 | | allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
- "1:"
- move({regind2,%[a], SSL},%[a])
- "sob %[b],1b"
- setcc(%[a]) erase(%[a]) erase(%[b])
- | %[a] | |
-lxa $1==0 | | | {ADDR_LOCAL, SL} | |
-lxa $1==1 | | allocate(REG={LOCAL2, SL, 2 })
- | {regconst2, %[a], SSL } | |
-lxa $1==2 | | allocate(REG={LOCAL2, SL, 2 })
- move({regind2, %[a], SSL }, %[a])
- | {regconst2, %[a], SSL } | |
-lxa $1==3 | | allocate(REG={LOCAL2, SL, 2 })
- move({regind2, %[a], SSL }, %[a])
- move({regind2, %[a], SSL }, %[a])
- | {regconst2, %[a], SSL } | |
-lxa $1 > 3 | | allocate(REG={LOCAL2, SL, 2}, REG={CONST2,$1-1})
- "1:"
- move({regind2,%[a], SSL},%[a])
- "sob %[b],1b"
- setcc(%[a]) erase(%[a]) erase(%[b])
- | {regconst2, %[a], SSL } | |
-dch | | | | loi 2 |
-loi $1==2 | REG | | {regdef2, %[1]} | |
-... | NC regconst2 | | {regind2, %[1.reg], %[1.ind]} | |
-... | NC relative2 | | {reldef2, %[1.ind]} | |
-... | NC regind2 | | {reginddef2, %[1.reg], %[1.ind]} | |
-... | NC regdef2 | | {reginddef2, %[1.reg], "0"}| |
-... | NC ADDR_LOCAL | | {LOCAL2, %[1.ind],2} | |
-... | NC ADDR_EXTERNAL | | {relative2, %[1.ind]} | |
-... | NC LOCAL2 |
- |{reginddef2, lb, tostring(%[1.ind])}| |
-loi $1==1 | REG | | {regdef1, %[1]} | |
-... | NC regconst2 | | {regind1, %[1.reg], %[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {relative1, %[1.ind]} | |
-... | NC ADDR_LOCAL| |{regind1, lb, tostring(%[1.ind])} | |
-... | NC relative2 | | {reldef1, %[1.ind]} | |
-... | NC regind2 | | {reginddef1, %[1.reg], %[1.ind]} | |
-... | NC regdef2 | | {reginddef1, %[1.reg], "0"}| |
-... | NC LOCAL2 | |{reginddef1, lb, tostring(%[1.ind])} | |
-loi $1==4 | REG | | {regdef4, %[1]} | |
-... | NC regconst2 | | {regind4, %[1.reg], %[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL4,%[1.ind],4} | |
-... | NC ADDR_EXTERNAL | | {relative4, %[1.ind]} | |
-loi $1==8 | REG | | {regdef8, %[1]} | |
-... | NC regconst2 | | {regind8, %[1.reg], %[1.ind]} | |
-... | NC ADDR_LOCAL |
- | {regind8, lb , tostring(%[1.ind])} | |
-... | NC ADDR_EXTERNAL | | {relative8, %[1.ind]} | |
-loi | NC ADDR_LOCAL |
- remove(all)
- allocate(REG={CONST2,$1/2},REG)
- move(lb,%[b])
- "add $$%(%[1.ind]+$1%),%[b]"
- "1:\tmov -(%[b]),-(sp)"
- "sob %[a],1b"
- erase(%[a]) erase(%[b]) | | |
-... | NC ADDR_EXTERNAL |
- remove(all)
- allocate(REG={CONST2,$1/2},REG)
- "mov $$%[1.ind]+$1,%[b]"
- "1:\tmov -(%[b]),-(sp)"
- "sob %[a],1b"
- erase(%[a]) erase(%[b]) | | |
-... | SCR_REG |
- remove(all)
- allocate(REG={CONST2,$1})
- "add %[a],%[1]"
- "asr %[a]"
- "1:\tmov -(%[1]),-(sp)"
- "sob %[a],1b"
- erase(%[1]) erase(%[a]) | | |
-los $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,los2~" | | |
-los !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,los2~" | | |
-ldl | | | {LOCAL4, $1,4} | |
-lde | | | {relative4, $1} | |
-ldf | regconst2 |
- | {regind4,%[1.reg], tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {relative4, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {LOCAL4, %[1.ind]+$1,4} | |
-lpi | | | {ADDR_EXTERNAL, $1} | |
-
-/****************************************************************
- * Group 2 : Store instructions. *
- * *
- * These instructions are likely to ruin the fake-stack. *
- * We don't expect many items on the fake-stack anyway *
- * because we seem to have evaluated an expression just now. *
- ****************************************************************/
-
-#ifdef REGVARS
-stl inreg($1)==2| xsource2 |
- remove(regvar($1))
- move(%[1],regvar($1)) | | |
-#endif
-stl | xsource2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL2,$1,2}) | | |
-ste | xsource2 |
- remove(posextern)
- move(%[1], {relative2, $1 }) | | |
-#ifdef REGVARS
-sil inreg($1)==2| xsource2 |
- INDSTORE
- move(%[1], {regdef2,regvar($1)}) | | |
-#endif
-sil | xsource2 |
- INDSTORE
- move(%[1], {reginddef2,lb,tostring($1)}) | | |
-stf | regconst2 xsource2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]}) | | |
-... | ADDR_EXTERNAL xsource2 |
- INDSTORE
- move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})| | |
-#ifdef REGVARS
-lol stf inreg($1)!=2 | xsource2 |
- INDSTORE
- allocate(REG={LOCAL2, $1,2})
- move(%[1],{regind2,%[a],tostring($2)}) | | |
-sti $1==2 | REG xsource2 |
- INDSTORE
- move(%[2],{regdef2,%[1]}) | | |
-... | regconst2 xsource2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],%[1.ind]}) | | |
-... | ADDR_EXTERNAL xsource2 |
- INDSTORE
- move(%[2],{relative2,%[1.ind]}) | | |
-... | ADDR_LOCAL xsource2 |
- INDSTORE
- move(%[2],{LOCAL2, %[1.ind], 2}) | | |
-... | relative2 xsource2 |
- INDSTORE
- move(%[2],{reldef2,%[1.ind]}) | | |
-... | regind2 xsource2 |
- INDSTORE
- move(%[2],{reginddef2,%[1.reg],%[1.ind]}) | | |
-sti $1==1 | REG source1or2 |
- INDSTORE
- move(%[2],{regdef1,%[1]}) | | |
-... | NC regconst2 source1or2 |
- INDSTORE
- move(%[2],{regind1,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_EXTERNAL source1or2 |
- INDSTORE
- move(%[2],{relative1,%[1.ind]}) | | |
-... | NC ADDR_LOCAL source1or2 |
- INDSTORE
- move(%[2],{regind1, lb, tostring(%[1.ind])}) | | |
-... | NC relative2 source1or2 |
- INDSTORE
- move(%[2],{reldef1,%[1.ind]}) | | |
-... | NC regind2 source1or2 |
- INDSTORE
- move(%[2],{reginddef1,%[1.reg],%[1.ind]}) | | |
-sti $1==4 | NC dadres2 FLT_REG |
- INDSTORE
- "movfo %[2],*%[1]"
- samecc | | |
-... | NC dadres2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],*%[1]\nseti"
- samecc | | |
-... | NC regconst2 FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | NC regconst2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](%[1.reg])\nseti"
- samecc | | |
-... | NC ADDR_LOCAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](r5)"
- samecc | | |
-... | NC ADDR_LOCAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](r5)\nseti"
- samecc | | |
-... | NC ADDR_EXTERNAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind]"
- samecc | | |
-... | NC ADDR_EXTERNAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind]\nseti"
- samecc | | |
-... | REG source2 source2 |
- INDSTORE
- move(%[2],{regdef2,%[1]})
- move(%[3],{regind2,%[1],"2"}) | | |
-... | SCR_REG STACK |
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])"
- erase(%[1]) | | | (4,2040)
-sti $1==8 | NC dadres2 DBL_REG |
- INDSTORE
- "movf %[2],*%[1]"
- samecc | | |
-... | NC regconst2 DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | NC ADDR_LOCAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](r5)"
- samecc | | |
-... | NC ADDR_EXTERNAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind]"
- samecc | | |
-... | SCR_REG regind8 |
- INDSTORE
- "mov %[2.ind](%[2.reg]),(%[1])+"
- "mov 2+%[2.ind](%[2.reg]),(%[1])+"
- "mov 4+%[2.ind](%[2.reg]),(%[1])+"
- "mov 6+%[2.ind](%[2.reg]),(%[1])"
- erase(%[1]) | | |
-... | SCR_REG relative8 |
- INDSTORE
- allocate(REG={ADDR_EXTERNAL,%[2.ind]})
- "mov (%[a])+,(%[1])+"
- "mov (%[a])+,(%[1])+"
- "mov (%[a])+,(%[1])+"
- "mov (%[a]),(%[1])"
- erase(%[1]) erase(%[a]) | | |
-... | SCR_REG |
- remove(all)
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])+"
- "mov (sp)+,(%[1])"
- erase(%[1]) | | | (8,4080)
-sti | SCR_REG |
- remove(all)
- allocate(REG={CONST2,$1/2})
- "1:\tmov (sp)+,(%[1])+"
- "sob %[a],1b"
- erase(%[1]) erase(%[a]) | | | (8,1500+$1*825)
-lal sti $2>2 && $2<=8 | NC xsource2 | | %[1] | stl $1 lal $1+2 sti $2-2 |
-... | | | {ADDR_LOCAL,$1} | sti $2 |
-sts $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,sto2~"
- erase(r01) | | |
-sdl | NC FLT_REG |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL4,$1,4}) | | |
-... | NC ftolong |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- "setl\nmovfi %[1.reg],$1(r5)\nseti"
- samecc | | |
-... | source2 source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1+2 && %[ind]+%[size] > $1)
- move(%[1],{LOCAL2,$1,2})
- move(%[2],{LOCAL2,$1+2,2}) | | |
-sde | NC FLT_REG |
- remove(posextern)
- move(%[1],{relative4,$1}) | | |
-... | NC ftolong |
- remove(posextern)
- "setl\nmovfi %[1.reg],$1\nseti"
- samecc | | |
-... | source2 source2 |
- remove(posextern)
- move(%[1], {relative2, $1 })
- move(%[2], {relative2, $1+"+2" }) | | |
-sdf | NC regconst2 FLT_REG |
- INDSTORE
- move(%[2],{regind4,%[1.reg],tostring($1)+"+"+%[1.ind]}) | | |
-... | NC regconst2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],$1+%[1.ind](%[1.reg])\nseti"
- samecc | | |
-... | NC ADDR_EXTERNAL FLT_REG |
- INDSTORE
- move(%[2],{relative4,tostring($1)+"+"+%[1.ind]})| | |
-... | NC ADDR_EXTERNAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],$1+%[1.ind]\nseti"
- samecc | | |
-... | regconst2 source2 source2 |
- INDSTORE
- move(%[2],{regind2,%[1.reg],tostring($1)+"+"+%[1.ind]})
- move(%[3],{regind2,%[1.reg],tostring($1+2)+"+"+%[1.ind]}) | | |
-... | ADDR_EXTERNAL source2 source2 |
- INDSTORE
- move(%[2],{relative2,tostring($1)+"+"+%[1.ind]})
- move(%[3],{relative2,tostring($1+2)+"+"+%[1.ind]}) | | |
-
-/****************************************************************
- * Group 3 : Integer arithmetic. *
- * *
- * Implemented (sometimes with the use of subroutines) : *
- * all 2 and 4 byte arithmetic. *
- ****************************************************************/
-
-adi $1==2 | NC SCR_REG CONST2 | | {regconst2,%[1],tostring(%[2.num])} | |
-... | NC SCR_REG ADDR_EXTERNAL | | {regconst2,%[1],%[2.ind]} | |
-... | NC SCR_REG ADDR_LOCAL |
- "add r5,%[1]" erase(%[1]) |
- {regconst2,%[1],tostring(%[2.ind])} | | (2,450)
-... | NC REG ADDR_LOCAL |
- allocate(REG)
- "mov r5,%[a]"
- "add %[1],%[a]"
- erase(%[a]) | {regconst2,%[a],tostring(%[2.ind])} | | (4,900)
-... | NC SCR_REG regconst2 |
- "add %[2.reg],%[1]" erase(%[1]) |
- {regconst2,%[1],%[2.ind]} | | (2,450)
-... | NC source2-REG CONST2+ADDR_EXTERNAL+ADDR_LOCAL |
- allocate(%[1],REG=%[1]) | %[2] %[a] | adi 2 |
-... | NC regconst2 CONST2 | |
- {regconst2,%[1.reg],
- tostring(%[2.num])+"+"+%[1.ind]} | |
-... | NC regconst2 ADDR_EXTERNAL | |
- {regconst2,%[1.reg],
- %[2.ind]+"+"+%[1.ind]} | |
-... | NC regconst2 ADDR_LOCAL |
- "add r5,%[1.reg]" erase(%[1.reg]) |
- {regconst2,%[1.reg],
- tostring(%[2.ind])+"+"+%[1.ind]} | | (2,450)
-... | NC regconst2 regconst2 |
- "add %[2.reg],%[1.reg]" erase(%[1.reg]) |
- {regconst2,%[1.reg],%[2.ind]+"+"+%[1.ind]} | | (2,450)
-... | NC regconst2 noconst2 |
- "add %[2],%[1.reg]" erase(%[1.reg]) | %[1] | | (2,450)+%[2]
-... | NC SCR_REG noconst2 |
- "add %[2],%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (2,450)+%[2]
-... | NC source2 regconst2 |
- "add %[1],%[2.reg]"
- erase(%[2.reg]) | %[2] | | (2,450)+%[1]
-... | NC regconst2 source2 |
- "add %[2],%[1.reg]"
- erase(%[1.reg]) | %[1] | | (2,450)+%[2]
-... | source2 SCR_REG |
- "add %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | | (2,450)+%[1]
-adi $1==4 | SCR_REG SCR_REG source2 source2 |
- "add %[4],%[2]"
- "adc %[1]"
- "add %[3],%[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1200)+%[4]+%[3]
-... | SCR_REG SCR_REG source2 STACK |
- "add (sp)+,%[2]"
- "adc %[1]"
- "add %[3],%[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1900)+%[3]
-... | SCR_REG SCR_REG STACK |
- "add (sp)+,%[1]"
- "add (sp)+,%[2]"
- "adc %[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,2800)
-... | source2 source2 SCR_REG SCR_REG |
- "add %[2],%[4]"
- "adc %[3]"
- "add %[1],%[3]"
- setcc(%[3]) erase(%[3]) erase(%[4])
- | %[4] %[3] | | (6,1200)+%[1]+%[2]
-adi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,adi~" | | |
-sbi $1==2 | source2 SCR_REG |
- "sub %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | | (2,450)+%[1]
-... | NC SCR_REG source2-REG |
- "sub %[2],%[1]"
- "neg %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (4,750)+%[2]
-sbi $1==4 | source2-REG source2-REG SCR_REG SCR_REG |
- "sub %[2],%[4]"
- "sbc %[3]"
- "sub %[1],%[3]"
- setcc(%[3]) erase(%[3]) erase(%[4])
- | %[4] %[3] | | (6,1200)+%[1]+%[2]
-... | source2 source2 STACK |
- "sub %[2],2(sp)"
- "sbc (sp)"
- "sub %[1],(sp)" | | | (10,2800)+%[1]+%[2]
-sbi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sbi~" | | |
-mli $1==2 | SCR_ODD_REG source2 |
- "mul %[2],%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |(2,3300)+%[2]
-... | source2 SCR_ODD_REG |
- "mul %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |(2,3300)+%[1]
-mli $1==4 | | remove(all)
- "jsr pc,mli4~"
- | r1 r0 | |
-mli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mli~" | | |
-dvi $1==2 | source2 source2 |
- allocate(%[2],REG_PAIR)
- "mov %[2],%[a.2]"
- "sxt %[a.1]"
- "div %[1],%[a.1]" | %[a.1] | |
-... | source2 source2 |
- INDSTORE
- "mov %[1],-(sp)"
- "mov %[2],r1"
- "sxt r0"
- "div (sp)+,r0" | r0 | |(100,10000)
-dvi $1==4 | | remove(all)
- "jsr pc,dvi4~" | r1 r0 | |
-dvi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvi~" | | |
-rmi $1==2 | source2 source2 |
- allocate(%[2],REG_PAIR)
- "mov %[2],%[a.2]"
- "sxt %[a.1]"
- "div %[1],%[a.1]" | %[a.2] | |
-... | source2 source2 |
- INDSTORE
- "mov %[1],-(sp)"
- "mov %[2],r1"
- "sxt r0"
- "div (sp)+,r0" | r1 | |(100,10000)
-rmi $1==4 | | remove(all)
- "jsr pc,rmi4~" | r1 r0 | |
-rmi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmi~" | | |
-ngi $1==2 | SCR_REG |
- "neg %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | | (2,750)
-ngi $1==4 | SCR_REG SCR_REG |
- "neg %[1]"
- "neg %[2]"
- "sbc %[1]"
- setcc(%[1]) erase(%[1]) erase(%[2])
- | %[2] %[1] | | (6,1800)
-ngi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ngi~" | | |
-loc sli $1==1 && $2==2 | SCR_REG |
- "asl %[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-sli $1==2 | source2 SCR_REG |
- "ash %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |
-sli $1==4 | source2 SCR_REG_PAIR |
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[2]) | %[2] | |
-sli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sli~" | | |
-loc sri $1==1 && $2==2 | SCR_REG |
- "asr %[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-loc sri $2==2 | SCR_REG |
- "ash $$%(0-$1%),%[1]"
- setcc(%[1]) erase(%[1]) | %[1]| |
-sri $1==2 | SCR_REG SCR_REG |
- "neg %[1]"
- "ash %[1], %[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-loc sri $2==4 | SCR_REG_PAIR |
- "ashc $$%(0-$1%),%[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-sri $1==4 | SCR_REG SCR_REG_PAIR |
- "neg %[1]"
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-sri !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sri~" | | |
-
-/************************************************
- * Group 4 : unsigned arithmetic *
- * *
- * adu = adi *
- * sbu = sbi *
- * slu = sli *
- * *
- * Supported : 2- and 4 byte arithmetic. *
- ************************************************/
-
-adu | | | | adi $1 |
-sbu | | | | sbi $1 |
-mlu $1==2 | | | | mli $1 |
-mlu $1==4 | | remove(all)
- "jsr pc,mlu4~" | r1 r0 | |
-mlu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mlu~" | | |
-dvu $1==2 | | remove(all)
- "jsr pc,dvu2~" | r0 | |
-dvu $1==4 | | remove(all)
- "jsr pc,dvu4~" | r1 r0 | |
-dvu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvu~" | | |
-rmu $1==2 | | remove(all)
- "jsr pc,rmu2~" | r1 | |
-rmu $1==4 | | remove(all)
- "jsr pc,rmu4~" | r1 r0 | |
-rmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmu~" | | |
-slu | | | | sli $1 |
-sru $1==2 | SCR_REG xsource2 |
- allocate(%[2],REG_PAIR)
- move(%[2],%[a.2])
- move({CONST2,0},%[a.1])
- "neg %[1]"
- "ashc %[1],%[a]"
- erase(%[a]) | %[a.2] | |
-loc sru $2==2 | xsource2 |
- allocate(%[1],REG_PAIR)
- move(%[1],%[a.2])
- move({CONST2,0},%[a.1])
- "ashc $$%(0-$1%),%[a]"
- erase(%[a]) | %[a.2] | |
-sru $1==4 | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,sru~"
- erase(r0) | | |
-sru !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sru~" | | |
-
-/************************************************
- * Group 5 : Floating point arithmetic *
- * *
- * Supported : 4- and 8 byte arithmetic. *
- ************************************************/
-
-adf $1==4 | FLT_REG SCR_FLT_REG |
- "addf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,5000)+%[1]
-... | SCR_FLT_REG FLT_REG |
- "addf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,5000)+%[2]
-adf $1==8 | double8 SCR_DBL_REG |
- "addf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,6000)+%[1]
-... | SCR_DBL_REG double8 |
- "addf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,6000)+%[2]
-adf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,adf~" | | |
-sbf $1==4 | FLT_REG SCR_FLT_REG |
- "subf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,5000)+%[1]
-sbf $1==8 | double8 SCR_DBL_REG |
- "subf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,6000)+%[1]
-sbf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,sbf~" | | |
-mlf $1==4 | FLT_REG SCR_FLT_REG |
- "mulf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,7000)+%[1]
-... | SCR_FLT_REG FLT_REG |
- "mulf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,7000)+%[2]
-mlf $1==8 | double8 SCR_DBL_REG |
- "mulf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,10000)+%[1]
-... | SCR_DBL_REG double8 |
- "mulf %[2],%[1]"
- samecc erase(%[1]) | %[1] | | (2,10000)+%[2]
-mlf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,mlf~" | | |
-dvf $1==4 | FLT_REG SCR_FLT_REG |
- "divf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,8000)+%[1]
-dvf $1==8 | double8 SCR_DBL_REG |
- "divf %[1],%[2]"
- samecc erase(%[2]) | %[2] | | (2,12000)+%[1]
-dvf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,dvf~" | | |
-ngf $1==4 | SCR_FLT_REG |
- "negf %[1]"
- samecc erase(%[1]) | %[1] | |(2,2700)
-ngf $1==8 | SCR_DBL_REG |
- "negf %[1]"
- samecc erase(%[1]) | %[1] | |(2,2700)
-ngf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,ngf~" | | |
-fif $1==4 | longf4 FLT_REG |
- allocate(FLT_REG_PAIR)
- move(%[1],%[a.1])
- "modf %[2],%[a]"
- samecc erase(%[a.1]) | %[a.1] %[a.2] | | (2,7500)+%[2]
-fif $1==8 | double8 double8 |
- allocate(DBL_REG_PAIR)
- move(%[1],%[a.1])
- "modf %[2],%[a]"
- samecc erase(%[a.1]) | %[a.1] %[a.2] | | (2,15000)+%[2]
-fif !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fif~" | | |
-fef $1==4 | FLT_REG |
- allocate(REG)
- "movei %[1],%[a]"
- "movie $$0,%[1]"
- samecc
- erase(%[1]) |%[1] %[a] | | (4,5000)
-fef $1==8 | DBL_REG |
- allocate(REG)
- "movei %[1],%[a]"
- "movie $$0,%[1]"
- samecc
- erase(%[1]) |%[1] %[a] | | (4,5000)
-fef !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fef~" | | |
-
-/****************************************
- * Group 6 : pointer arithmetic. *
- * *
- * Pointers have size 2 bytes. *
- ****************************************/
-
-adp | SCR_REG | | {regconst2, %[1], tostring($1)} | |
-... | NC regconst2 | | {regconst2, %[1.reg], tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {ADDR_EXTERNAL, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {ADDR_LOCAL,%[1.ind]+$1} | |
-ads $1==2 | | | | adi $1 |
-sbs $1==2 | | | | sbi $1 |
-
-/****************************************
- * Group 7 : increment/decrement/zero *
- ****************************************/
-
-inc | SCR_REG |
- "inc %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-#ifdef REGVARS
-inl inreg($1)==2| | remove(regvar($1))
- "inc %(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-inl | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "inc $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-ine | | remove(posextern)
- "inc $1"
- setcc({relative2,$1}) | | |
-dec | SCR_REG |
- "dec %[1]"
- setcc(%[1]) erase(%[1]) | %[1] | |
-#ifdef REGVARS
-del inreg($1)==2| | remove(regvar($1))
- "dec %(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-del | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "dec $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-dee | | remove(posextern)
- "dec $1"
- setcc({relative2,$1}) | | | (4,900)
-
-#ifdef REGVARS
-lol loc sbi stl $1==$4 && $3==2 && inreg($1)==2 | |
- remove(regvar($1))
- "sub $$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol ngi stl $1==$3 && $2==2 && inreg($1)==2 | |
- remove(regvar($1))
- "neg %(regvar($1)%)"
- erase(regvar($1)) | | |
-lil ngi sil $1==$3 && $2==2 && inreg($1)==2 | |
- INDSTORE
- "neg *%(regvar($1)%)" | | |
-lil inc sil $1==$3 && inreg($1)==2 | | INDSTORE
- "inc *%(regvar($1)%)" | | |
-lol adi stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
- remove(regvar($1))
- "add %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && $2==1 && inreg($1)==2 | |
- remove(regvar($1))
- "inc %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && inreg($1)==2 | |
- remove(regvar($1))
- "add $$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-lol loc sbi stl $1==$4 && $3==2 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "sub $$$2,$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol ngi stl $1==$3 && $2==2 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "neg $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lil ngi sil $1==$3 && $2==2 | | INDSTORE
- "neg *$1(r5)" | | |
-lil inc sil $1==$3 | | INDSTORE
- "inc *$1(r5)" | | |
-lol adi stl $2==2 && $1==$3 | source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add %[1],$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol adp stl $1==$3 && $2==1 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "inc $1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lol adp stl $1==$3 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add $$$2,$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-loe adi ste $2==2 && $1==$3 | source2 |
- remove(posextern)
- "add %[1],$1"
- setcc({relative2,$1}) | | |
-loe adp ste $1==$3 | |
- remove(posextern)
- "add $$$2,$1"
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-lol ior stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
- remove(regvar($1))
- "bis %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-lol ior stl $2==2 && $1==$3 | source2 |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "bis %[1],$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-loe ior ste $2==2 && $1==$3 | source2 |
- remove(posextern)
- "bis %[1],$1"
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-lol and stl $2==2 && $1==$3 && inreg($1)==2 | SCR_REG |
- remove(regvar($1))
- "com %[1]"
- "bic %[1],%(regvar($1)%)"
- erase(%[1])
- erase(regvar($1)) | | |
-#endif
-lol and stl $2==2 && $1==$3 | SCR_REG |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "com %[1]"
- "bic %[1],$1(r5)"
- erase(%[1])
- setcc({LOCAL2,$1,2}) | | |
-loe and ste $2==2 && $1==$3 | SCR_REG |
- remove(posextern)
- "com %[1]"
- "bic %[1],$1"
- erase(%[1])
- setcc({relative2,$1}) | | |
-#ifdef REGVARS
-loc lol and stl $3==2 && $2==$4 && inreg($2)==2 | |
- remove(regvar($2))
- "bic $$%(~$1%),%(regvar($2)%)"
- erase(regvar($2)) | | |
-#endif
-loc lol and stl $3==2 && $2==$4 | |
- remove(indordef)
- remove(locals, %[ind] <= $2 && %[ind]+%[size] > $2)
- "bic $$%(~$1%),$2(r5)"
- setcc({LOCAL2,$2,2}) | | |
-loc loe and ste $3==2 && $2==$4 | |
- remove(posextern)
- "bic $$%(~$1%),$2"
- setcc({relative2,$2}) | | |
-#ifdef REGVARS
-zrl inreg($1)==2| | remove(regvar($1))
- "clr %(regvar($1)%)"
- erase(regvar($1)) | | | (4,900)
-#endif
-zrl | | remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "clr $1(r5)"
- setcc({LOCAL2,$1,2}) | | | (4,900)
-zre | | remove(posextern)
- "clr $1"
- setcc({relative2,$1}) | | | (4,900)
-zrf $1==4 | | allocate(FLT_REG)
- "clrf %[a]" | %[a] | | (2,2200)
-zrf $1==8 | | allocate(DBL_REG)
- "clrf %[a]" | %[a] | | (2,2400)
-zrf !defined($1)| | | | zer |
-zrf defined($1) | | | | zer $1 |
-zer $1==2 | | | {CONST2, 0} | |
-zer $1==4 | | | {CONST2,0} {CONST2,0} | |
-zer $1==6 | | | {CONST2,0} {CONST2,0}
- {CONST2,0} | |
-zer $1==8 | | | {CONST2,0} {CONST2,0}
- {CONST2, 0} {CONST2,0} | |
-zer defined($1) | | remove(all)
- move({CONST2,$1/2},r0)
- "1:\tclr -(sp)"
- "sob r0,1b"
- erase(r0) | | |(8,1500+$1*375)
-zer !defined($1)| SCR_REG |
- remove(all)
- "asr %[1]"
- "1:\tclr -(sp)"
- "sob %[1],1b"
- erase(%[1]) | | |
-
-/****************************************
- * Group 8 : Convert instructions *
- ****************************************/
-
-cii | | remove(all)
- " jsr pc,cii~" | | |
-cfi | | | | cfu |
-cfu | | remove(ALL)
- "jsr pc,cfi~" | | |
-cif | | remove(ALL)
- "jsr pc,cif~" | | |
-cuf | | remove(ALL)
- "jsr pc,cuf~" | | |
-cff | | remove(ALL)
- "jsr pc,cff~" | | |
-ciu | | | | cuu |
-cui | | | | cuu |
-cuu | | remove(all)
- "jsr pc,cuu~" | | |
-loc loc cii $1==1 && $2==2 | source1or2 |
- allocate(%[1],REG)
- "movb %[1],%[a]"
- /* movb does sign extend if dest is register */
- | %[a] | |
-loc loc cii $1==1 && $2==4 | source1or2 |
- allocate(%[1],REG,REG)
- "movb %[1],%[a]"
- "sxt %[b]"
- | %[a] %[b] | |
-loc loc cii $1==2 && $2==4 | source2 |
- allocate(%[1],REG,REG)
- move(%[1],%[a])
- test(%[a])
- "sxt %[b]"
- | %[a] %[b] | |
-loc loc loc cii $1>=0 && $2==2 && $3==4 | | | | loc $1 loc 0 |
-loc loc loc cii $1< 0 && $2==2 && $3==4 | | | | loc $1 loc 0-1 |
-loc loc cii $1==4 && $2==2 | source2 source2 | | %[2] | |
-loc loc cuu $1==2 && $2==4 | | | {CONST2,0} | |
-loc loc cuu $1==4 && $2==2 | source2 | | | |
-loc loc cfi | | | | loc $1 loc $2 cfu |
-loc loc cfu $1==4 && $2==2 | FLT_REG | | {ftoint,%[1]} | |
-loc loc cfu $1==4 && $2==4 | FLT_REG | | {ftolong,%[1]} | |
-loc loc cfu $1==8 && $2==2 | DBL_REG | | {ftoint,%[1]} | |
-loc loc cfu $1==8 && $2==4 | DBL_REG | | {ftolong,%[1]} | |
-loc loc cif $1==2 && $2==4 | source2 |
- allocate(FLT_REG)
- "movif %[1],%[a]"
- samecc
- | %[a] | |
-loc loc cif $1==2 && $2==8 | source2 |
- allocate(DBL_REG)
- "movif %[1],%[a]"
- samecc
- | %[a] | |
-loc loc cif $1==4 && $2==4 | NC long4-REG_PAIR |
- allocate(FLT_REG)
- "setl"
- "movif %[1],%[a]"
- "seti"
- samecc
- | %[a] | |
-... | | remove(all)
- allocate(FLT_REG)
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- samecc
- | %[a] | |
-loc loc cif $1==4 && $2==8 | NC long4-REG_PAIR |
- allocate(DBL_REG)
- "setl"
- "movif %[1],%[a]"
- "seti"
- samecc
- | %[a] | |
-... | | remove(all)
- allocate(DBL_REG)
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- samecc
- | %[a] | |
-loc loc cuf $1==2 && $2==4 | |
- remove(all)
- allocate(FLT_REG)
- "clr -(sp)"
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- | %[a] | |
-loc loc cuf $1==2 && $2==8 | |
- remove(all)
- allocate(DBL_REG)
- "clr -(sp)"
- "setl"
- "movif (sp)+,%[a]"
- "seti"
- | %[a] | |
-loc loc cuf $1==4 && ($2==8 || $2==4) | | | | loc $1 loc $2 cif |
-loc loc cff $1==4 && $2==8 | longf4 - FLT_REG |
- allocate(DBL_REG)
- "movof %[1],%[a]"
- samecc
- | %[a] | |
-... | FLT_REG |
- allocate(DBL_REG)
- move(%[1],%[a.1])
- samecc | %[a] | |
-loc loc cff $1==8 && $2==4 | DBL_REG | | %[1.1] | |
-
-/****************************************
- * Group 9 : Logical instructions *
- ****************************************/
-
-and $1==2 | CONST2 SCR_REG |
- "bic $$%(~%[1.num]%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (4,750)
-... | SCR_REG CONST2 |
- "bic $$%(~%[2.num]%),%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (4,750)
-... | SCR_REG SCR_REG |
- "com %[1]"
- "bic %[1],%[2]"
- setcc(%[2])
- erase(%[1]) erase(%[2]) | %[2] | | (4,600)
-and defined($1) | | remove(all)
- move({CONST2,$1}, r0)
- "jsr pc,and~"
- erase(r0) | | |
-and !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,and~"
- erase(r0) | | |
-ior $1==2 | SCR_REG source2 |
- "bis %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,450)+%[2]
-... | source2 SCR_REG |
- "bis %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,450)+%[1]
-ior $1==8 | NC source2 source2 source2 source2 |
- remove(all)
- "bis %[1],(sp)"
- "bis %[2],2(sp)"
- "bis %[3],4(sp)"
- "bis %[4],6(sp)" | | |
-... | | remove(all)
- allocate(REG={CONST2,$1})
- "add sp,%[a]"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- "bis (sp)+,(%[a])+"
- erase(%[a]) | | |
-ior defined($1) | | remove(all)
- allocate(REG={CONST2,$1},REG={CONST2,$1/2})
- "add sp,%[a]"
- "1:\tbis (sp)+,(%[a])+"
- "sob %[b],1b"
- erase(%[a]) erase(%[b]) | | | (12,2100+$1*975)
-ior !defined($1)| SCR_REG |
- remove(all)
- allocate(REG=%[1])
- "asr %[1]"
- "add sp,%[a]"
- "1:\tbis (sp)+,(%[a])+"
- "sob %[1],1b"
- erase(%[1]) erase(%[a]) | | |
-xor $1==2 | REG SCR_REG |
- "xor %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,300)
-... | SCR_REG REG |
- "xor %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,300)
-xor defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,xor~"
- erase(r0) | | |
-xor !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,xor~"
- erase(r0) | | |
-com $1==2 | SCR_REG |
- "com %[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,300)
-com defined($1) | | remove(all)
- allocate(REG={CONST2,$1/2},REG)
- "mov sp,%[b]"
- "1:\tcom (%[b])+"
- "sob %[a],1b"
- erase(%[a]) | | | (10,1800+$1*825)
-com !defined($1)| SCR_REG |
- remove(all)
- allocate(REG)
- "asr %[1]"
- "mov sp,%[a]"
- "1:\tcom (%[a])+"
- "sob %[1],1b"
- erase(%[1]) | | |
-rol $1==2 | CONST2 SCR_ODD_REG |
- "ashc $$%(%[1.num]-16%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG SCR_ODD_REG |
- "sub $$16,%[1]"
- "ashc %[1],%[2]"
- setcc(%[2])
- erase(%[1]) erase(%[2]) | %[2] | |
-rol defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,rol~"
- erase(r0) | | |
-rol !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rol~"
- erase(r0) | | |
-ror $1==2 | CONST2 SCR_ODD_REG |
- "ashc $$%(0-%[1.num]%),%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG SCR_ODD_REG |
- "neg %[1]"
- "ashc %[1],%[2]"
- setcc(%[2]) erase(%[1]) erase(%[2]) | %[2] | |
-ror defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,ror~"
- erase(r0) | | |
-ror !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ror~"
- erase(r0) | | |
-com and $1==2 && $2==2 | source2 SCR_REG |
- "bic %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,450)+%[1]
-com and $1==$2 | | remove(all)
- allocate(REG={CONST2,$1},REG)
- "mov sp,%[b]"
- "add %[a],%[b]"
- "asr %[a]"
- "1:\tbic (sp)+,(%[b])+"
- "sob %[a],1b"
- erase(%[a]) | | | (12,2100+$1*975)
-
-/********************************
- * Group 10 : Set instructions *
- ********************************/
-
-inn $1==2 | SCR_REG SCR_REG |
- "neg %[1]"
- "ash %[1],%[2]"
- "bic $$177776,%[2]"
- erase(%[1]) erase(%[2]) | %[2] | |
-loc inn $2==2 && $1==0 | SCR_REG |
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-loc inn $2==2 && $1==1 | SCR_REG |
- "asr %[1]"
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-loc inn $2==2 | SCR_REG |
- "ash $$%(0-$1%),%[1]"
- "bic $$177776,%[1]"
- erase(%[1]) | %[1] | |
-
-loc inn zeq $2==2 | | | {CONST2, 1<<$1} | and 2 zeq $3 |
-inn zeq $1==2 | source2 |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]" | %[a] | and 2 zeq $2 |
-loc inn zne $2==2 | | | {CONST2, 1<<$1} | and 2 zne $3 |
-inn zne $1==2 | source2 |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]" | %[a] | and 2 zne $2 |
-inn defined($1) | source2 |
- remove(all)
- move(%[1],r1)
- move({CONST2,$1},r0)
- "jsr pc,inn~"
- erase(r01) | r0 | |
-inn !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "mov (sp)+,r1"
- "jsr pc,inn~"
- erase(r01) | r0 | |
-set $1==2 | REG |
- allocate(REG={CONST2,1})
- "ash %[1],%[a]"
- erase(%[a]) | %[a] | |
-set defined($1) | source2 |
- remove(all)
- move(%[1],r1)
- move({CONST2,$1},r0)
- "jsr pc,set~"
- erase(r01) | | |
-set !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "mov (sp)+,r1"
- "jsr pc,set~"
- erase(r01) | | |
-
-/****************************************
- * Group 11 : Array instructions *
- ****************************************/
-
-lae aar $2==2 && rom(1,3)==1 && rom(1,1)==0 | | | | adi 2 |
-lae aar $2==2 && rom(1,3)==1 && rom(1,1)!=0 | | | | adi 2 adp 0-rom(1,1) |
-
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)==0 | SCR_REG |
- "asl %[1]"
- erase(%[1]) | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | SCR_REG |
- "asl %[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-2)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)==0 | SCR_REG |
- "ash $$2,%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)!=0 | SCR_REG |
- "ash $$2,%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-4)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)==0 | SCR_REG |
- "ash $$3,%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)!=0 | SCR_REG |
- "ash $$3,%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-8)*rom(1,1))} |
- adi 2 |
-lae aar $2==2 && rom(1,1)==0 | SCR_ODD_REG |
- "mul $$%(rom(1,3)%),%[1]"
- erase(%[1]) |
- %[1] |
- adi 2 |
-lae aar $2==2 && defined(rom(1,1)) | SCR_ODD_REG |
- "mul $$%(rom(1,3)%),%[1]"
- erase(%[1]) |
- {regconst2,%[1],tostring((0-rom(1,3))*rom(1,1))} |
- adi 2 |
-aar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,aar~"
- erase(r01) | | |
-aar !defined($1) | | remove(all)
- "jsr pc,iaar~" | | |
-lae sar defined(rom(1,3)) | | | | lae $1 aar $2 sti rom(1,3) |
-lae lar defined(rom(1,3)) | | | | lae $1 aar $2 loi rom(1,3) |
-sar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,sar~"
- erase(r01) | | |
-sar !defined($1) | | remove(all)
- "jsr pc,isar~" | | |
-lar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,lar~"
- erase(r01) | | |
-lar !defined($1) | | remove(all)
- "jsr pc,ilar~" | | |
-
-/****************************************
- * group 12 : Compare instructions *
- ****************************************/
-
-cmi $1==2 | source2 SCR_REG |
- "sub %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | SCR_REG source2 |
- "sub %[2],%[1]"
- "neg %[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | |
-cmi $1==4 | | remove(all)
- "jsr pc,cmi4~" | r0 | |
-cmi !defined($1) | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmi~"
- erase(r0) | r0 | |
-cmf defined($1) | | remove(ALL)
- move({CONST2,$1},r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-cmf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-cmu $1==2 | | | | cmp |
-cmu $1==4 | | remove(all)
- "jsr pc,cmu4~" | r0 | |
-cmu defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,cmu~" | r0 | |
-cmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmu~"
- erase(r0) | r0 | |
-cms $1==2 | | | | cmi $1 |
-cms defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-cms !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-cmp | source2 source2 |
- allocate(REG = {CONST2,0})
- "cmp %[1],%[2]"
- "beq 2f"
- "bhi 1f"
- "inc %[a]"
- "br 2f"
- "1:\tdec %[a]\n2:"
- setcc(%[a])
- erase(%[a]) | %[a] | |
-tlt and $2==2 | source2 SCR_REG |
- test(%[1])
- "blt 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tlt ior $2==2 | source2 SCR_REG |
- test(%[1])
- "bge 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tlt | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tle and $2==2 | source2 SCR_REG |
- test(%[1])
- "ble 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tle ior $2==2 | source2 SCR_REG |
- test(%[1])
- "bgt 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tle | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-teq and $2==2 | source1or2 SCR_REG |
- test(%[1])
- "beq 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-teq ior $2==2 | source1or2 SCR_REG |
- test(%[1])
- "bne 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-teq | source1or2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tne and $2==2 | source1or2 SCR_REG |
- test(%[1])
- "bne 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tne ior $2==2 | source1or2 SCR_REG |
- test(%[1])
- "beq 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tne | source1or2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tgt and $2==2 | source2 SCR_REG |
- test(%[1])
- "bgt 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tgt ior $2==2 | source2 SCR_REG |
- test(%[1])
- "ble 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tgt | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-tge and $2==2 | source2 SCR_REG |
- test(%[1])
- "bge 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-tge ior $2==2 | source2 SCR_REG |
- test(%[1])
- "blt 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-tge | source2 |
- allocate(REG={CONST2,0})
- test(%[1])
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-and tne $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "bit %[1],%[2]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-and teq $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "bit %[1],%[2]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-
-cmi tlt and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "blt 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bge 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tlt $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi tle and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "ble 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tle ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bgt 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tle $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi teq and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "beq 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi teq ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bne 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi teq $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-loc cmi teq and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "beq 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 teq and 2 |
-loc cmi teq ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "bne 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 teq ior 2 |
-loc cmi teq $1>=0 && $1<=127 && $2==2 | NC source1 |
- allocate(REG={CONST2,0})
- "cmpb %[1],$$$1"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | | | {CONST2, $1} | cmi 2 teq |
-cmi tne and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bne 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tne ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "beq 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tne $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-loc cmi tne and $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "bne 1f"
- "clr %[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 tne and 2 |
-loc cmi tne ior $1>=0 && $1<=127 && $2==2 && $4==2 | NC source1 SCR_REG |
- "cmpb %[1],$$$1"
- "beq 1f"
- "bis $$1,%[2]\n1:"
- erase(%[2]) | %[2] | |
-... | | | {CONST2, $1} | cmi 2 tne ior 2 |
-loc cmi tne $1>=0 && $1<=127 && $2==2 | NC source1 |
- allocate(REG={CONST2,0})
- "cmpb %[1],$$$1"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | | | {CONST2, $1} | cmi 2 tne |
-cmi tge and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bge 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tge ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "blt 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tge $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmi tgt and $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "bgt 1f"
- "clr %[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==2 && $3==2 | source2 source2 SCR_REG |
- "cmp %[2],%[1]"
- "ble 1f"
- "bis $$1,%[3]\n1:"
- erase(%[3]) | %[3] | |
-cmi tgt $1==2 | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tlt | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bhis 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tle | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bhi 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp teq | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tne | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tge | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blo 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmp tgt | source2 source2 |
- allocate(REG={CONST2,0})
- "cmp %[2],%[1]"
- "blos 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tlt $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tle $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf teq $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tne $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tgt $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tge $1==4 | FLT_REG FLT_REG |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tlt $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tle $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf teq $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bne 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tne $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "beq 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tgt $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "ble 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bge 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-cmf tge $1==8 | DBL_REG double8 |
- allocate(REG={CONST2,0})
- "cmpf %[2],%[1]\ncfcc"
- "blt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-... | double8 DBL_REG |
- allocate(REG={CONST2,0})
- "cmpf %[1],%[2]\ncfcc"
- "bgt 1f"
- "inc %[a]\n1:"
- erase(%[a]) | %[a] | |
-
-/****************************************
- * Group 13 : Branch instructions *
- ****************************************/
-
-bra | | remove(all)
- "jbr $1"
- samecc | | |
-blt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlt $1" | | |
-ble | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jle $1" | | |
-beq | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jeq $1" | | |
-bne | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jne $1" | | |
-bge | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jge $1" | | |
-bgt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jgt $1" | | |
-loc beq $1>=0 && $1<=127 | NC source1 |
- remove(all)
- "cmpb %[1],$$$1"
- "jeq $2" | | |
-... | | | {CONST2, $1} | beq $2 |
-loc bne $1>=0 && $1<=127 | NC source1 |
- remove(all)
- "cmpb %[1],$$$1"
- "jne $2" | | |
-... | | | {CONST2, $1} | bne $2 |
-zlt | source2 |
- remove(all)
- test(%[1])
- "jlt $1"
- samecc | | |
-zle | source2 |
- remove(all)
- test(%[1])
- "jle $1"
- samecc | | |
-zeq | source1or2 |
- remove(all)
- test(%[1])
- "jeq $1"
- samecc | | |
-zne | source1or2 |
- remove(all)
- test(%[1])
- "jne $1"
- samecc | | |
-zge | source2 |
- remove(all)
- test(%[1])
- "jge $1"
- samecc | | |
-zgt | source2 |
- remove(all)
- test(%[1])
- "jgt $1"
- samecc | | |
-cmp zlt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlo $2" | | |
-cmp zle | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jlos $2" | | |
-cmp zeq | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jeq $2" | | |
-cmp zne | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jne $2" | | |
-cmp zgt | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jhi $2" | | |
-cmp zge | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jhis $2" | | |
-cmf zlt $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jlt $2" | | |
-cmf zle $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jle $2" | | |
-cmf zeq $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jeq $2" | | |
-cmf zne $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jne $2" | | |
-cmf zgt $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jgt $2" | | |
-cmf zge $1==4 | FLT_REG FLT_REG |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jge $2" | | |
-cmf zlt $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jlt $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jgt $2" | | |
-cmf zle $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jle $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jge $2" | | |
-cmf zeq $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jeq $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jeq $2" | | |
-cmf zne $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jne $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jne $2" | | |
-cmf zgt $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jgt $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jlt $2" | | |
-cmf zge $1==8 | DBL_REG double8 |
- remove(all)
- "cmpf %[2],%[1]\ncfcc"
- "jge $2" | | |
-... | double8 DBL_REG |
- remove(all)
- "cmpf %[1],%[2]\ncfcc"
- "jle $2" | | |
-
-and zeq $1==2 | source2 source2 |
- remove(all)
- "bit %[1],%[2]"
- "jeq $2" | | |
-and zne $1==2 | source2 source2 |
- remove(all)
- "bit %[1],%[2]"
- "jne $2" | | |
-
-/************************************************
- * group 14 : Procedure call instructions *
- ************************************************/
-
-cal | | remove(ALL)
- "jsr pc,$1" | | |
-cai | REG | remove(ALL)
- "jsr pc,(%[1])" | | |
-lfr $1==2 | | | r0 | |
-lfr $1==4 | | | r1 r0 | |
-lfr $1==8 | | | {relative8,"retar"} | |
-lfr | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,lfr~"
- erase(r0) | | |
-
-lfr ret $1==$2 | | | | ret 0 |
-
-#ifndef REGVARS
-asp lfr ret $2==$3 | | | | ret 0 |
-asp ret $2==0 | | | | ret 0 |
-#endif
-
-ret $1==0 | | remove(all)
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==2 | source2 |
- remove(all)
- move(%[1],r0)
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==4 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
-#ifdef REGVARS
- return | | |
-#else
- "mov r5,sp\nmov (sp)+,r5\nrts pc" | | |
-#endif
-ret $1==8 | | | {ADDR_EXTERNAL, "retar"} | sti 8 ret 0 |
-ret | | remove(all)
- move({CONST2,$1},r0)
- "jmp ret~" | | |
-
-/************************************************
- * Group 15 : Miscellaneous instructions *
- ************************************************/
-
-asp $1==2 | | remove(all)
- "tst (sp)+" | | |
-asp $1==4 | | remove(all)
- "cmp (sp)+,(sp)+" | | |
-asp $1==0-2 | | remove(all)
- "tst -(sp)" | | |
-asp | | remove(all)
- "add $$$1,sp" | | |
-ass $1==2 | | remove(all)
- "add (sp)+,sp" | | |
-ass !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "add (sp)+,sp" | | |
-
-blm $1==4 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm $1==6 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm $1==8 | SCR_REG SCR_REG |
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2])+,(%[1])+"
- "mov (%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm | SCR_REG SCR_REG |
- allocate(REG={CONST2,$1/2})
- "1:mov (%[2])+,(%[1])+\nsob %[a],1b"
- erase(%[1]) erase (%[2]) erase(%[a]) | | |
-bls $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,blm~"
- erase(r01) | | |
-bls !defined($1)| source2 source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- move(%[2],r0)
- "jsr pc,blm~"
- erase(r01) | | |
-lae csa $2==2 | source2 |
- remove(all)
- move(%[1],r1)
- move({ADDR_EXTERNAL,$1},r0)
- "jmp csa~" | | |
-csa $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csa~" | | |
-csa !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csa~" | | |
-lae csb $2==2 | source2 |
- remove(all)
- move(%[1],r1)
- move({ADDR_EXTERNAL,$1},r0)
- "jmp csb~" | | |
-
-csb $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-csb !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-dup $1==2 | REG | | %[1] %[1] | |
-dup $1==4 | NC longf4 | | %[1] %[1] | |
-... | source2 source2 | | %[2] %[1] %[2] %[1] | |
-dup $1==8 | NC double8| | %[1] %[1] | |
-... | | remove(all)
- move({CONST2, $1}, r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dup | | remove(all)
- move({CONST2, $1}, r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dus $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dup~"
- erase(r01) | | |
-dus !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "jsr pc,dup~"
- erase(r01) | | |
-gto | | remove(all)
- "mov $$$1,-(sp)"
- "jmp gto~" | | |
-fil | | "mov $$$1,hol0+4" | | |
-lim | | | { relative2, "trpim~"} | |
-lin | | "mov $$$1,hol0" | | |
-lni | | "inc hol0" | | |
-lor $1==0 | | | lb | |
-lor $1==1 | | remove(all)
- allocate(REG)
- "mov sp,%[a]" | %[a] | |
-lor $1==2 | | | {relative2,"reghp~"} | |
-mon | | remove(all)
- "jsr pc,mon~" | | |
-nop | | remove(all)
- "jsr pc,nop~" | | |
-#ifdef DORCK
-rck $1==2 | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rck~" | | |
-rck !defined($1)| source2 source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- move(%[2],r0)
- "jsr pc,rck~" | | |
-#else
-rck $1==2 | source2 | | | |
-rck !defined($1)| source2 source2 | | | |
-#endif
-rtt | | | | ret 0 |
-sig | source2 |
- allocate(REG)
- move({relative2,"trppc~"},%[a])
- "mov %[1],trppc~" | %[a] | |
-sim | | remove(all)
- "jsr pc,sim~" | | |
-str $1==0 | source2 |
- "mov %[1],r5" | | |
-str $1==1 | source2 |
- remove(all)
- "mov %[1],sp" | | |
-str $1==2 | | remove(all)
- "jsr pc,strhp~" | | |
-trp | | remove(all)
- "jsr pc,trp~" | | |
-exg $1==2 | source2 source2 | | %[1] %[2] | |
-exg defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,exg~" | | |
-exg | source2 | remove(all)
- move(%[1],r0)
- "jsr pc,exg" | | |
-
-lol lal sti $1==$2 && $3==1| | | | | /* throw away funny C-proc-prolog */
-
-/********************************
- * Coercions *
- * *
- * From EM-tokens to PDP-tokens *
- ********************************/
-
-| LOCAL2 | | {regind2,lb,tostring(%[1.ind])} | |
-| LOCAL4 | | {regind4,lb,tostring(%[1.ind])} | |
-
-/********************************
- * From source to register *
- ********************************/
-
-| regconst2 | allocate(%[1],REG=%[1.reg])
- "add $$%[1.ind],%[a]"
- setcc(%[a]) | %[a] | |(6,1050)
-| ADDR_LOCAL | allocate(REG)
- "mov r5,%[a]"
- "add $$%[1.ind],%[a]"
- setcc(%[a]) | %[a] | |(6,1050)
-| REG | | {regconst2, %[1], "0"} | | (2,600)
-| xsource2 | allocate(%[1], REG=%[1]) | %[a] | |
-| xsource2 | allocate(%[1], REG=%[1]) | {regconst2, %[a], "0"} | |
-| longf4 | allocate(FLT_REG)
- move( %[1],%[a]) | %[a] | | (20,20000) + %[1]
-| double8 | allocate(DBL_REG)
- move(%[1],%[a]) | %[a] | | (20,30000) + %[1]
-
-/********************************
- * From source1 to source2 *
- ********************************/
-
-| source1 | allocate(REG={CONST2,0})
- "bisb %[1],%[a]"
- erase(%[a]) setcc(%[a]) | %[a] | | (6,1050)+%[1]
-
-/********************************
- * From long4 to source2 *
- ********************************/
-
-| REG_PAIR | | %[1.2] %[1.1] | |
-| regind4 | | {regind2,%[1.reg],"2+"+%[1.ind]} {regind2,%[1.reg],%[1.ind]} | |
-| relative4 | | {relative2,"2+"+%[1.ind]} {relative2,%[1.ind]} | |
-| regdef4 | | {regind2,%[1.reg],"2"} {regdef2,%[1.reg]} | |
-| LOCAL4 | | {LOCAL2, %[1.ind]+2, 2} {LOCAL2, %[1.ind], 2} | |
-
-/********************************
- * from double8 to long4 *
- ********************************/
-
-| regind8 | | {regind4,%[1.reg],"4+"+%[1.ind]} {regind4,%[1.reg],%[1.ind]} | |
-| relative8 | | {relative4,"4+"+%[1.ind]} {relative4,%[1.ind]} | |
-| regdef8 | | {regdef4,%[1.reg]} {regind4,%[1.reg],"4"} | |
-
-
-
-/************************
- * From STACK coercions *
- ************************/
-
-| STACK | allocate(REG)
- "mov (sp)+,%[a]"
- setcc(%[a]) | %[a] | | (2,750)
-| STACK | allocate(REG)
- "mov (sp)+,%[a]"
- setcc(%[a]) | {regconst2, %[a], "0"} | | (2,750)
-| STACK | allocate(FLT_REG)
- "movof (sp)+,%[a]"
- samecc | %[a] | | (20,47400) /* /10 */
-| STACK | allocate(DBL_REG)
- "movf (sp)+,%[a]"
- samecc | %[a] | | (20,69200) /* /10 */
-| STACK | allocate(REG_PAIR)
- "mov (sp)+,%[a.1]"
- "mov (sp)+,%[a.2]"
- setcc(%[a.2]) | %[a] | | (4,1500)
-
-MOVES:
-(CONST2 %[num] == 0, source2, "clr %[2]" setcc(%[2]),(2,300))
-(source2, source2, "mov %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
-(FLT_REG, longf4-FLT_REG,"movfo %[1],%[2]" samecc, (2,880) + %[2])
-(longf4-FLT_REG,FLT_REG, "movof %[1],%[2]" samecc, (2,1500) + %[2])
-(FLT_REG, FLT_REG, "movf %[1],%[2]" samecc,(2,880))
-(DBL_REG,double8, "movf %[1],%[2]" samecc,(2,880) + %[2])
-(double8,DBL_REG, "movf %[1],%[2]" samecc,(2,1700) + %[1])
-(CONST2 %[num] == 0,source1, "clrb %[2]" setcc(%[2]),(2,450)+%[2])
-(source1or2,source1, "movb %[1],%[2]" setcc(%[2]),(2,300)+%[1]+%[2])
-(ftoint,source2, "movfi %[1.reg],%[2]" samecc)
-
-TESTS:
-(source2, "tst %[1]" ,(2,300) + %[1])
-(source1, "tstb %[1]",(2,400) + %[1])
-(FLT_REG+DBL_REG, "tstf %[1]\ncfcc" ,(4,2600))
-/* (DBL_REG, "tstf %[1]\ncfcc" ,(4,2600)) */
-
-STACKS:
-( CONST2 %[num]==0 ,, "clr -(sp)" )
-( source2 ,, "mov %[1],-(sp)" setcc(%[1]), (2,900)+%[1])
-( regconst2 ,, "mov %[1.reg],-(sp)\nadd $$%[1.ind],(sp)" , (6,2250))
-( ADDR_LOCAL,, "mov r5,-(sp)" "add $$%[1.ind],(sp)", (6,2250))
-( DBL_REG ,, "movf %[1],-(sp)" samecc , (2,6100))
-( FLT_REG ,, "movfo %[1],-(sp)" samecc , (2,4120))
-( REG_PAIR ,, "mov %[1.2],-(sp)" "mov %[1.1],-(sp)" , (4,1800))
-( regind4 ,, "mov 2+%[1.ind](%[1.reg]),-(sp)"
- "mov %[1.ind](%[1.reg]),-(sp)" , (8,3000))
-( relative4 ,, "mov 2+%[1.ind],-(sp)"
- "mov %[1.ind],-(sp)" , (8,3000))
-( regdef4 ,, "mov 2(%[1.reg]),-(sp)"
- "mov (%[1.reg]),-(sp)" , (6,2700))
-( regind8 ,REG, move(%[1.reg],%[a])
- "add $$%(8%)+%[1.ind],%[a]"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- erase(%[a]) , (14,6000))
-( regind8 ,, "mov 6+%[1.ind](%[1.reg]),-(sp)"
- "mov 4+%[1.ind](%[1.reg]),-(sp)"
- "mov 2+%[1.ind](%[1.reg]),-(sp)"
- "mov %[1.ind](%[1.reg]),-(sp)" , (16,6000))
-( relative8 ,REG,"mov $$%(8%)+%[1.ind],%[a]"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)"
- "mov -(%[a]),-(sp)" , (12,5000))
-( relative8 ,, "mov 6+%[1.ind],-(sp)"
- "mov 4+%[1.ind],-(sp)"
- "mov 2+%[1.ind],-(sp)"
- "mov %[1.ind],-(sp)" , (16,6000))
-( regdef8 ,, "mov 6(%[1.reg]),-(sp)"
- "mov 4(%[1.reg]),-(sp)"
- "mov 2(%[1.reg]),-(sp)"
- "mov (%[1.reg]),-(sp)" , (14,5700))
-( LOCAL4 ,, "mov 2+%[1.ind](r5),-(sp)"
- "mov %[1.ind](r5),-(sp)" , (8,3000))
-( source1 ,, "clr -(sp)"
- "movb %[1],(sp)" , (4,1800)+%[1])
-( ftoint ,, "movfi %[1.reg],-(sp)" )
-( ftolong ,, "setl\nmovfi %[1.reg],-(sp)\nseti" )
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-/* $Header$ */
-
-#ifndef NDEBUG
-#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__)
-#else
-#define assert(x) /* nothing */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "state.h"
-#include "equiv.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define SHORTCUT /* Stop searching at distance 0 */
-
-#if NREGS >= MAXRULE
-#define MAXPOS NREGS
-#else
-#define MAXPOS MAXRULE
-#endif
-
-#define MAXPATTERN 5
-#define MAXREPLLEN 5 /* Max length of EM-replacement, should come from boot */
-
-byte startupcode[] = { DO_NEXTEM };
-
-byte *nextem();
-unsigned costcalc();
-unsigned docoerc();
-unsigned stackupto();
-string tostring();
-
-#ifdef NDEBUG
-#define DEBUG()
-#else
-#include <stdio.h>
-#define DEBUG(string) {if(Debug) fprintf(stderr,"%-*d%s\n",4*level,level,string);}
-#endif
-
-#define BROKE() {assert(origcp!=startupcode);DEBUG("BROKE");goto doreturn;}
-#define CHKCOST() {if (totalcost>=costlimit) BROKE();}
-
-unsigned codegen(codep,ply,toplevel,costlimit,forced) byte *codep; unsigned costlimit; {
-#ifndef NDEBUG
- byte *origcp=codep;
- static int level=0;
-#endif
- unsigned totalcost = 0;
- byte *bp;
- int n;
- unsigned mindistance,dist;
- register i;
- int cindex;
- int npos,npos2,pos[MAXPOS],pos2[MAXPOS];
-#ifdef STONSTACK
- state_t state;
-#define SAVEST savestatus(&state)
-#define RESTST restorestatus(&state)
-#define FREEST /* nothing */
-#else
- state_p state;
-#define SAVEST state=savestatus()
-#define RESTST restorestatus(state)
-#define FREEST freestatus(state)
-#endif
- unsigned mincost,t;
- int texpno,nodeno;
- token_p tp;
- tkdef_p tdp;
- int tinstno;
- struct reginfo *rp,**rpp;
- token_t token,mtoken,token2;
- int propno;
- int exactmatch;
- int j;
- int decision;
- int stringno;
- result_t result;
- cost_t cost;
- int size,lsize,repllen;
- int tokexp[MAXPATTERN];
- int nregneeded;
- token_p regtp[MAXCREG];
- c3_p regcp[MAXCREG];
- rl_p regls[MAXCREG];
- c3_p cp,findcoerc();
- int sret;
- token_t reptoken[MAXREPLLEN];
- int emrepllen,eminstr;
- int inscoerc=0;
- int stackpad;
- struct perm *tup,*ntup,*besttup,*tuples();
-
-#ifndef NDEBUG
- level++;
- DEBUG("Entering codegen");
-#endif
- for (;;) {
- switch( (*codep++)&037 ) {
- default:
- assert(FALSE);
- /* NOTREACHED */
- case DO_NEXTEM:
- DEBUG("NEXTEM");
- tokpatlen = 0;
- nallreg=0;
- if (toplevel) {
- garbage_collect();
- totalcost=0;
- } else {
- if (--ply <= 0)
- goto doreturn;
- }
- if (stackheight>MAXFSTACK-7)
- totalcost += stackupto(&fakestack[6],ply,toplevel);
- bp = nextem(toplevel);
- if (bp == 0) {
- /*
- * No pattern found, can be pseudo or error
- * in table.
- */
- if (toplevel) {
- codep--;
- DEBUG("pseudo");
- dopseudo();
- } else
- goto doreturn;
- } else {
-#ifndef NDEBUG
- chkregs();
-#endif
- n = *bp++;
- assert(n>0 && n<=MAXRULE);
- if (n>1) {
- mindistance = MAXINT; npos=0;
- for(i=0;i<n;i++) {
- getint(cindex,bp);
- dist=distance(cindex);
-#ifndef NDEBUG
-if (Debug)
- fprintf(stderr,"distance of pos %d is %u\n",i,dist);
-#endif
- if (dist<=mindistance) {
- if (dist<mindistance) {
-#ifdef SHORTCUT
- if(dist==0)
- goto gotit;
-#endif
- npos=0;
- mindistance = dist;
- }
- pos[npos++] = cindex;
- }
- }
- assert(mindistance<MAXINT);
- if (npos>1) {
- /*
- * More than 1 tokenpattern is a candidate.
- * Decision has to be made by lookahead.
- */
- SAVEST;
- mincost = costlimit-totalcost+1;
- for(i=0;i<npos;i++) {
- t=codegen(&coderules[pos[i]],ply,FALSE,mincost,0);
-#ifndef NDEBUG
-if (Debug)
- fprintf(stderr,"mincost %u,cost %u,pos %d\n",mincost,t,i);
-#endif
- if (t<mincost) {
- mincost = t;
- cindex = pos[i];
- }
- RESTST;
- }
- FREEST;
- if (totalcost+mincost>costlimit) {
- totalcost += mincost;
- BROKE();
- }
- } else {
- cindex = pos[0];
- }
- } else {
- getint(cindex,bp);
- }
-
- gotit:
- /*
- * Now cindex contains the code-index of the best candidate
- * so proceed to use it.
- */
- codep = &coderules[cindex];
- }
- break;
- case DO_COERC:
- DEBUG("COERC");
- tokpatlen=1;
- inscoerc=1;
- break;
- case DO_XXMATCH:
- DEBUG("XXMATCH");
- case DO_XMATCH:
- DEBUG("XMATCH");
- tokpatlen=(codep[-1]>>5)&07;
- for (i=0;i<tokpatlen;i++)
- getint(tokexp[i],codep);
- tokexp[i]=0;
- break; /* match already checked by distance() */
- case DO_MATCH:
- DEBUG("MATCH");
- tokpatlen=(codep[-1]>>5)&07;
- for(i=0;i<tokpatlen;i++)
- getint(tokexp[i],codep);
- tokexp[i] = 0;
- tp = &fakestack[stackheight-1];
- i=0;
- while (i<tokpatlen && tp>=fakestack) {
- size=tsize(tp);
- while (i<tokpatlen && (lsize=ssize(tokexp[i]))<=size) {
- size -= lsize;
- i++;
- }
- if (i<tokpatlen && size!=0) {
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- }
- tp--;
- }
- tp = &fakestack[stackheight-1];
- i=0;
- while (i<tokpatlen && tp >= fakestack) {
- size = tsize(tp);
- lsize= ssize(tokexp[i]);
- if (size != lsize) { /* find coercion */
-#ifdef MAXSPLIT
- sret = split(tp,&tokexp[i],ply,toplevel);
- if (sret==0) {
-#endif MAXSPLIT
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
-#ifdef MAXSPLIT
- }
- i += sret;
-#endif MAXSPLIT
- } else
- i += 1;
- tp--;
- }
- nextmatch:
- tp = &fakestack[stackheight-1];
- i=0; nregneeded = 0;
- while (i<tokpatlen && tp>=fakestack) {
- if (!match(tp,&machsets[tokexp[i]],0)) {
- cp = findcoerc(tp, &machsets[tokexp[i]]);
- if (cp==0) {
- for (j=0;j<nregneeded;j++)
- regtp[j] -= (tp-fakestack+1);
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- } else {
- if (cp->c3_prop==0) {
- totalcost+=docoerc(tp,cp,ply,toplevel,0);
- CHKCOST();
- } else {
- assert(nregneeded<MAXCREG);
- regtp[nregneeded] = tp;
- regcp[nregneeded] = cp;
- regls[nregneeded] = curreglist;
- nregneeded++;
- }
- }
- }
- i++; tp--;
- }
- if (tokpatlen>stackheight) {
- stackpad = tokpatlen-stackheight;
- for (j=stackheight-1;j>=0;j--)
- fakestack[j+stackpad] = fakestack[j];
- for (j=0;j<stackpad;j++)
- fakestack[j].t_token=0;
- stackheight += stackpad;
- for (j=0;j<nregneeded;j++)
- regtp[j] += stackpad;
- tp = &fakestack[stackpad-1];
- while (i<tokpatlen && tp>=fakestack) {
- cp = findcoerc((token_p) 0, &machsets[tokexp[i]]);
- if (cp==0) {
- assert(!toplevel);
- for (j=0;j<nregneeded;j++)
- myfree(regls[j]);
- totalcost=INFINITY;
- BROKE();
- }
- if (cp->c3_prop==0) {
- totalcost+=docoerc(tp,cp,ply,toplevel,0);
- CHKCOST();
- } else {
- assert(nregneeded<MAXCREG);
- regtp[nregneeded] = tp;
- regcp[nregneeded] = cp;
- regls[nregneeded] = curreglist;
- nregneeded++;
- }
- i++; tp--;
- }
- } else
- stackpad=0;
- assert(i==tokpatlen);
- if (nregneeded==0)
- break;
- SAVEST;
- mincost=costlimit-totalcost+1;
- tup = tuples(regls,nregneeded);
- besttup=0;
- for (; tup != 0; tup = ntup) {
- ntup = tup->p_next;
- for (i=0,t=0;i<nregneeded && t<mincost; i++)
- t += docoerc(regtp[i],regcp[i],ply,FALSE,tup->p_rar[i]);
- if (t<mincost)
- t += codegen(codep,ply,FALSE,mincost-t,0);
- if (t<mincost) {
- mincost = t;
- besttup = tup;
- } else
- myfree(tup);
- RESTST;
- }
- FREEST;
- for (i=0;i<nregneeded;i++)
- myfree(regls[i]);
- if (totalcost+mincost>costlimit) {
- if (besttup)
- myfree(besttup);
- if (stackpad!=tokpatlen) {
- if (stackpad) {
- if (costlimit<MAXINT) {
- totalcost = costlimit+1;
- BROKE();
- }
- for (i=0;i<stackheight-stackpad;i++)
- fakestack[i] = fakestack[i+stackpad];
- stackheight -= stackpad;
- totalcost += stackupto(&fakestack[stackheight-1],ply,toplevel);
- } else
- totalcost += stackupto(fakestack,ply,toplevel);
- CHKCOST();
- goto nextmatch;
- }
- totalcost += mincost;
- BROKE();
- }
- for (i=0;i<nregneeded;i++)
- totalcost += docoerc(regtp[i],regcp[i],ply,toplevel,besttup->p_rar[i]);
- myfree(besttup);
- break;
- case DO_REMOVE:
- DEBUG("REMOVE");
- if (codep[-1]&32) {
- getint(texpno,codep);
- getint(nodeno,codep);
- } else {
- getint(texpno,codep);
- nodeno=0;
- }
- for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
- if (match(tp,&machsets[texpno],nodeno)) {
- /* investigate possible coercion to register */
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- }
- for (rp=machregs+2;rp<machregs+NREGS;rp++)
- if (match(&rp->r_contents,&machsets[texpno],nodeno))
- rp->r_contents.t_token=0;
- break;
- case DO_RREMOVE: /* register remove */
- getint(nodeno,codep);
- result=compute(&enodes[nodeno]);
- assert(result.e_typ==EV_REG);
- for (tp= &fakestack[stackheight-tokpatlen-1];tp>=&fakestack[0];tp--)
- if (tp->t_token==-1) {
- if(tp->t_att[0].ar==result.e_v.e_con)
- goto gotone;
- } else {
- tdp = &tokens[tp->t_token];
- for(i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG &&
- tp->t_att[i].ar==result.e_v.e_con)
- goto gotone;
- }
- break;
- gotone:
- /* investigate possible coercion to register */
- totalcost += stackupto(tp,ply,toplevel);
- CHKCOST();
- break;
- case DO_DEALLOCATE:
- DEBUG("DEALLOCATE");
- getint(tinstno,codep);
- instance(tinstno,&token);
- if (token.t_token==-1)
- chrefcount(token.t_att[0].ar,-1,TRUE);
- else {
- tdp= &tokens[token.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- chrefcount(token.t_att[i].ar,-1,TRUE);
- }
- break;
- case DO_REALLOCATE:
- DEBUG("REALLOCATE");
- for(rp=machregs;rp<machregs+NREGS;rp++)
- if(rp->r_tcount) {
- rp->r_refcount -= rp->r_tcount;
- rp->r_tcount = 0;
- }
- break;
- case DO_ALLOCATE:
- DEBUG("ALLOCATE");
- if (codep[-1]&32) {
- getint(propno,codep);
- getint(tinstno,codep);
- } else {
- getint(propno,codep);
- tinstno=0;
- }
- instance(tinstno,&token);
- if (!forced) {
- do {
- npos=exactmatch=0;
- for(rpp=reglist[propno];rp= *rpp; rpp++)
- if (getrefcount(rp-machregs)==0) {
- pos[npos++] = rp-machregs;
- if (eqtoken(&rp->r_contents,&token))
- exactmatch++;
- }
- /*
- * Now pos[] contains all free registers with desired
- * property. If none then some stacking has to take place.
- */
- if (npos==0) {
- if (stackheight<=tokpatlen) {
- if (!toplevel) {
- totalcost = INFINITY;
- BROKE();
- } else {
- fatal("No regs available");
- }
- }
- totalcost += stackupto( &fakestack[0],ply,toplevel);
- CHKCOST();
- }
- } while (npos==0);
- if (!exactmatch) {
- npos2=npos;
- for(i=0;i<npos;i++)
- pos2[i]=pos[i];
- } else {
- /*
- * Now we are reducing the number of possible registers.
- * We take only one equally likely register out of every
- * equivalence class as given by set of properties.
- */
- mtoken = token;
- npos2=0;
- for(i=0;i<npos;i++)
- if (eqtoken(&machregs[pos[i]].r_contents,&mtoken)) {
- pos2[npos2++] = pos[i];
- for(j=0;j<npos2-1;j++)
- if (eqregclass(pos2[j],pos[i])) {
- npos2--;
- break;
- }
- }
- }
- /*
- * Now pos2[] contains all possibilities to try, if more than
- * one, lookahead is necessary.
- */
- token2.t_token= -1;
- for (i=1;i<TOKENSIZE;i++)
- token2.t_att[i].aw=0;
- if (npos2==1)
- decision=pos2[0];
- else {
- SAVEST;
- mincost=costlimit-totalcost+1;
- for(j=0;j<npos2;j++) {
- chrefcount(pos2[j],1,FALSE);
- token2.t_att[0].ar=pos2[j];
- allreg[nallreg++] = pos2[j];
- if (token.t_token != 0)
- t=move(&token,&token2,ply,FALSE,mincost);
- else {
- t = 0;
- erasereg(pos2[j]);
- }
- if (t<mincost)
- t += codegen(codep,ply,FALSE,mincost-t,0);
- if (t<mincost) {
- mincost=t;
- decision=pos2[j];
- }
- RESTST;
- }
- FREEST;
- if (totalcost+mincost>costlimit) {
- totalcost = INFINITY;
- BROKE();
- }
- }
- } else {
- decision = forced;
- if (getrefcount(decision)!=0) {
- totalcost = INFINITY;
- BROKE();
- }
- token2.t_token = -1;
- }
- chrefcount(decision,1,FALSE);
- token2.t_att[0].ar=decision;
- if (token.t_token != 0) {
- totalcost+=move(&token,&token2,ply,toplevel,MAXINT);
- CHKCOST();
- } else
- erasereg(decision);
- allreg[nallreg++]=decision;
- break;
- case DO_LOUTPUT:
- DEBUG("LOUTPUT");
- getint(stringno,codep);
- getint(nodeno,codep);
- if (toplevel) {
- gencode(codestrings[stringno]);
- genexpr(nodeno);
- }
- break;
- case DO_ROUTPUT:
- DEBUG("ROUTPUT");
- i=((codep[-1]>>5)&07);
- do {
- getint(stringno,codep);
- if (toplevel) {
- gencode(codestrings[stringno]);
- gennl();
- }
- } while (i--);
- break;
- case DO_MOVE:
- DEBUG("MOVE");
- getint(tinstno,codep);
- instance(tinstno,&token);
- getint(tinstno,codep);
- instance(tinstno,&token2);
- totalcost += move(&token,&token2,ply,toplevel,costlimit-totalcost+1);
- CHKCOST();
- break;
- case DO_ERASE:
- DEBUG("ERASE");
- getint(nodeno,codep);
- result=compute(&enodes[nodeno]);
- assert(result.e_typ==EV_REG);
- erasereg(result.e_v.e_reg);
- break;
- case DO_TOKREPLACE:
- DEBUG("TOKREPLACE");
- assert(stackheight>=tokpatlen);
- repllen=(codep[-1]>>5)&07;
- for(i=0;i<repllen;i++) {
- getint(tinstno,codep);
- instance(tinstno,&reptoken[i]);
- tref(&reptoken[i],1);
- }
- for(i=0;i<tokpatlen;i++) {
- if (!inscoerc)
- tref(&fakestack[stackheight-1],-1);
- stackheight--;
- }
- for (i=0;i<repllen;i++) {
- assert(stackheight<MAXFSTACK);
- fakestack[stackheight++] = reptoken[i];
- }
- for(i=0;i<nallreg;i++)
- chrefcount(allreg[i],-1,FALSE);
- break;
- case DO_EMREPLACE:
- DEBUG("EMREPLACE");
- emrepllen=(codep[-1]>>5)&07;
- j=emp-emlines;
- if (emrepllen>j) {
- assert(nemlines+emrepllen-j<MAXEMLINES);
- for (i=nemlines;i>=0;i--)
- emlines[i+emrepllen-j] = emlines[i];
- nemlines += emrepllen-j;
- emp += emrepllen-j;
- }
- emp -= emrepllen;
- for (i=0;i<emrepllen;i++) {
- getint(eminstr,codep);
- getint(nodeno,codep);
- emp[i].em_instr = eminstr;
- result = compute(&enodes[nodeno]);
- switch(result.e_typ) {
- default:
- assert(FALSE);
- case 0:
- emp[i].em_optyp = OPNO;
- emp[i].em_soper = 0;
- break;
- case EV_INT:
- emp[i].em_optyp = OPINT;
- emp[i].em_soper = tostring(result.e_v.e_con);
- emp[i].em_u.em_ioper = result.e_v.e_con;
- break;
- case EV_STR:
- emp[i].em_optyp = OPSYMBOL;
- emp[i].em_soper = result.e_v.e_str;
- break;
- }
- }
- if (!toplevel)
- ply += emrepllen;
- break;
- case DO_COST:
- DEBUG("COST");
- getint(cost.c_size,codep);
- getint(cost.c_time,codep);
- totalcost += costcalc(cost);
- CHKCOST();
- break;
-#ifdef REGVARS
- case DO_PRETURN:
- if (toplevel) {
- swtxt();
- regreturn(); /* in mach.c */
- }
- break;
-#endif
- case DO_RETURN:
- DEBUG("RETURN");
- assert(origcp!=startupcode);
- doreturn:
-#ifndef NDEBUG
- level--;
-#endif
- return(totalcost);
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "glosym.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define LLEAF 01
-#define LDEF 02
-#define RLEAF 04
-#define RDEF 010
-#define LLDEF LLEAF|LDEF
-#define RLDEF RLEAF|RDEF
-
-char opdesc[] = {
- 0, /* EX_TOKFIELD */
- 0, /* EX_ARG */
- 0, /* EX_CON */
- 0, /* EX_ALLREG */
- LLDEF|RLDEF, /* EX_SAMESIGN */
- LLDEF|RLDEF, /* EX_SFIT */
- LLDEF|RLDEF, /* EX_UFIT */
- 0, /* EX_ROM */
- LLDEF|RLDEF, /* EX_NCPEQ */
- LLDEF|RLDEF, /* EX_SCPEQ */
- LLDEF|RLDEF, /* EX_RCPEQ */
- LLDEF|RLDEF, /* EX_NCPNE */
- LLDEF|RLDEF, /* EX_SCPNE */
- LLDEF|RLDEF, /* EX_RCPNE */
- LLDEF|RLDEF, /* EX_NCPGT */
- LLDEF|RLDEF, /* EX_NCPGE */
- LLDEF|RLDEF, /* EX_NCPLT */
- LLDEF|RLDEF, /* EX_NCPLE */
- LLDEF, /* EX_OR2 */
- LLDEF, /* EX_AND2 */
- LLDEF|RLDEF, /* EX_PLUS */
- LLDEF|RLDEF, /* EX_CAT */
- LLDEF|RLDEF, /* EX_MINUS */
- LLDEF|RLDEF, /* EX_TIMES */
- LLDEF|RLDEF, /* EX_DIVIDE */
- LLDEF|RLDEF, /* EX_MOD */
- LLDEF|RLDEF, /* EX_LSHIFT */
- LLDEF|RLDEF, /* EX_RSHIFT */
- LLDEF, /* EX_NOT */
- LLDEF, /* EX_COMP */
- 0, /* EX_COST */
- 0, /* EX_STRING */
- LLEAF, /* EX_DEFINED */
- 0, /* EX_SUBREG */
- LLDEF, /* EX_TOSTRING */
- LLDEF, /* EX_UMINUS */
- 0, /* EX_REG */
- 0, /* EX_LOWW */
- 0, /* EX_HIGHW */
- LLDEF, /* EX_INREG */
- LLDEF, /* EX_REGVAR */
-};
-
-string salloc(),strcpy(),strcat();
-
-string mycat(s1,s2) string s1,s2; {
- register string s;
-
- s=salloc(strlen(s1)+strlen(s2));
- strcpy(s,s1);
- strcat(s,s2);
- return(s);
-}
-
-string mystrcpy(s) string s; {
- register string r;
-
- r=salloc(strlen(s));
- strcpy(r,s);
- return(r);
-}
-
-char digstr[21][15];
-
-string tostring(n) word n; {
- char buf[25];
-
- if (n>=-20 && n<=20 && (n&1)==0) {
- if (digstr[(n>>1)+10][0]==0)
- sprintf(digstr[(n>>1)+10],WRD_FMT,n);
- return(digstr[(n>>1)+10]);
- }
- sprintf(buf,WRD_FMT,n);
- return(mystrcpy(buf));
-}
-
-result_t undefres= {EV_UNDEF};
-
-result_t compute(node) node_p node; {
- result_t leaf1,leaf2,result;
- token_p tp;
- int desc;
- long mask,tmp;
- int i,tmpreg;
- glosym_p gp;
-
- desc=opdesc[node->ex_operator];
- if (desc&LLEAF) {
- leaf1 = compute(&enodes[node->ex_lnode]);
- if (desc&LDEF && leaf1.e_typ==EV_UNDEF)
- return(undefres);
- }
- if (desc&RLEAF) {
- leaf2 = compute(&enodes[node->ex_rnode]);
- if (desc&RDEF && leaf2.e_typ==EV_UNDEF)
- return(undefres);
- }
- result.e_typ=EV_INT;
- switch(node->ex_operator) {
- default: assert(FALSE);
- case EX_TOKFIELD:
- if (node->ex_lnode!=0)
- tp = &fakestack[stackheight-node->ex_lnode];
- else
- tp = curtoken;
- switch(result.e_typ = tokens[tp->t_token].t_type[node->ex_rnode-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- result.e_v.e_con = tp->t_att[node->ex_rnode-1].aw;
- break;
- case EV_STR:
- result.e_v.e_str = tp->t_att[node->ex_rnode-1].as;
- break;
- case EV_REG:
- result.e_v.e_reg = tp->t_att[node->ex_rnode-1].ar;
- break;
- }
- return(result);
- case EX_ARG:
- return(dollar[node->ex_lnode-1]);
- case EX_CON:
- result.e_typ = EV_INT;
- result.e_v.e_con = ((long) node->ex_rnode << 16) | ((long)node->ex_lnode&0xffff);
- return(result);
- case EX_REG:
- result.e_typ = EV_REG;
- result.e_v.e_reg = node->ex_lnode;
- return(result);
- case EX_ALLREG:
- result.e_typ = EV_REG;
- result.e_v.e_reg = allreg[node->ex_lnode-1];
-#if MAXMEMBERS!=0
- if (node->ex_rnode!=0)
- result.e_v.e_reg = machregs[result.e_v.e_reg].
- r_members[node->ex_rnode-1];
-#endif
- return(result);
- case EX_SAMESIGN:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_typ = EV_INT;
- if (leaf1.e_v.e_con>=0)
- result.e_v.e_con= leaf2.e_v.e_con>=0;
- else
- result.e_v.e_con= leaf2.e_v.e_con<0;
- return(result);
- case EX_SFIT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- mask = 0xFFFFFFFFL;
- for (i=0;i<leaf2.e_v.e_con-1;i++)
- mask &= ~(1<<i);
- tmp = leaf1.e_v.e_con&mask;
- result.e_v.e_con = tmp==0||tmp==mask;
- return(result);
- case EX_UFIT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- mask = 0xFFFFFFFFL;
- for (i=0;i<leaf2.e_v.e_con;i++)
- mask &= ~(1<<i);
- result.e_v.e_con = (leaf1.e_v.e_con&mask)==0;
- return(result);
- case EX_ROM:
- assert(node->ex_rnode>=0 &&node->ex_rnode<MAXROM);
- leaf2=dollar[node->ex_lnode];
- if (leaf2.e_typ != EV_STR)
- return(undefres);
- gp = lookglo(leaf2.e_v.e_str);
- if (gp == (glosym_p) 0)
- return(undefres);
- if ((gp->gl_rom[MAXROM]&(1<<node->ex_rnode))==0)
- return(undefres);
- result.e_v.e_con = gp->gl_rom[node->ex_rnode];
- return(result);
- case EX_LOWW:
- result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper&0xFFFF;
- return(result);
- case EX_HIGHW:
- result.e_v.e_con = saveemp[node->ex_lnode].em_u.em_loper>>16;
- return(result);
- case EX_NCPEQ:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con==leaf2.e_v.e_con;
- return(result);
- case EX_SCPEQ:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_v.e_con = !strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_RCPEQ:
- assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
- result.e_v.e_con = leaf1.e_v.e_reg==leaf2.e_v.e_reg;
- return(result);
- case EX_NCPNE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con!=leaf2.e_v.e_con;
- return(result);
- case EX_SCPNE:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_v.e_con = strcmp(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_RCPNE:
- assert(leaf1.e_typ == EV_REG && leaf2.e_typ == EV_REG);
- result.e_v.e_con = leaf1.e_v.e_reg!=leaf2.e_v.e_reg;
- return(result);
- case EX_NCPGT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con>leaf2.e_v.e_con;
- return(result);
- case EX_NCPGE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con>=leaf2.e_v.e_con;
- return(result);
- case EX_NCPLT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con<leaf2.e_v.e_con;
- return(result);
- case EX_NCPLE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con<=leaf2.e_v.e_con;
- return(result);
- case EX_OR2:
- assert(leaf1.e_typ == EV_INT);
- if (leaf1.e_v.e_con==0)
- return(compute(&enodes[node->ex_rnode]));
- return(leaf1);
- case EX_AND2:
- assert(leaf1.e_typ == EV_INT);
- if (leaf1.e_v.e_con!=0)
- return(compute(&enodes[node->ex_rnode]));
- return(leaf1);
- case EX_PLUS:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con=leaf1.e_v.e_con+leaf2.e_v.e_con;
- return(result);
- case EX_CAT:
- assert(leaf1.e_typ == EV_STR && leaf2.e_typ == EV_STR);
- result.e_typ = EV_STR;
- result.e_v.e_str = mycat(leaf1.e_v.e_str,leaf2.e_v.e_str);
- return(result);
- case EX_MINUS:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con - leaf2.e_v.e_con;
- return(result);
- case EX_TIMES:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con * leaf2.e_v.e_con;
- return(result);
- case EX_DIVIDE:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con / leaf2.e_v.e_con;
- return(result);
- case EX_MOD:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con % leaf2.e_v.e_con;
- return(result);
- case EX_LSHIFT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con << leaf2.e_v.e_con;
- return(result);
- case EX_RSHIFT:
- assert(leaf1.e_typ == EV_INT && leaf2.e_typ == EV_INT);
- result.e_v.e_con = leaf1.e_v.e_con >> leaf2.e_v.e_con;
- return(result);
- case EX_NOT:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = !leaf1.e_v.e_con;
- return(result);
- case EX_COMP:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = ~leaf1.e_v.e_con;
- return(result);
- case EX_COST:
- if (node->ex_rnode==0)
- return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_size]));
- else
- return(compute(&enodes[tokens[node->ex_lnode].t_cost.c_time]));
- case EX_STRING:
- result.e_typ = EV_STR;
- result.e_v.e_str = codestrings[node->ex_lnode];
- return(result);
- case EX_DEFINED:
- result.e_v.e_con=leaf1.e_typ!=EV_UNDEF;
- return(result);
- case EX_SUBREG:
- result.e_typ = EV_REG;
- tp= &fakestack[stackheight-node->ex_lnode];
- assert(tp->t_token == -1);
- tmpreg= tp->t_att[0].ar;
-#if MAXMEMBERS!=0
- if (node->ex_rnode)
- tmpreg=machregs[tmpreg].r_members[node->ex_rnode-1];
-#endif
- result.e_v.e_reg=tmpreg;
- return(result);
- case EX_TOSTRING:
- assert(leaf1.e_typ == EV_INT);
- result.e_typ = EV_STR;
- result.e_v.e_str = tostring(leaf1.e_v.e_con);
- return(result);
-#ifdef REGVARS
- case EX_INREG:
- assert(leaf1.e_typ == EV_INT);
- i = isregvar((long) leaf1.e_v.e_con);
- if (i<0)
- result.e_v.e_con = 0;
- else if (i==0)
- result.e_v.e_con = 1;
- else
- result.e_v.e_con = 2;
- return(result);
- case EX_REGVAR:
- assert(leaf1.e_typ == EV_INT);
- i = isregvar((long) leaf1.e_v.e_con);
- if (i<=0)
- return(undefres);
- result.e_typ = EV_REG;
- result.e_v.e_reg=i;
- return(result);
-#endif
- case EX_UMINUS:
- assert(leaf1.e_typ == EV_INT);
- result.e_v.e_con = -leaf1.e_v.e_con;
- return(result);
- }
-}
+++ /dev/null
-/* $Header$ */
-
-typedef struct {
- int t_token; /* kind of token, -1 for register */
- union {
- word aw; /* integer type */
- string as; /* string type */
- int ar; /* register type */
- } t_att[TOKENSIZE];
-} token_t,*token_p;
-
-struct reginfo {
- int r_repr; /* index in string table */
- int r_size; /* size in bytes */
-#if MAXMEMBERS!=0
- int r_members[MAXMEMBERS]; /* register contained within this reg */
- short r_clash[REGSETSIZE]; /* set of clashing registers */
-#endif
- int r_refcount; /* Times in use */
- token_t r_contents; /* Current contents */
- int r_tcount; /* Temporary count difference */
-};
-
-#if MAXMEMBERS!=0
-#define clash(a,b) ((machregs[a].r_clash[(b)>>4]&(1<<((b)&017)))!=0)
-#else
-#define clash(a,b) ((a)==(b))
-#endif
-
-typedef struct {
- int t_size; /* size in bytes */
- cost_t t_cost; /* cost in bytes and time */
- byte t_type[TOKENSIZE]; /* types of attributes, TT_??? */
- int t_format; /* index of formatstring */
-} tkdef_t,*tkdef_p;
-
-struct emline {
- int em_instr;
- int em_optyp;
- string em_soper;
- union {
- word em_ioper;
- long em_loper;
- } em_u;
-};
-
-#define OPNO 0
-#define OPINT 1
-#define OPSYMBOL 2
-
-typedef struct {
- int rl_n; /* number in list */
- int rl_list[NREGS];
-} rl_t,*rl_p;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "equiv.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern string myalloc();
-
-int rar[MAXCREG];
-rl_p *lar;
-int maxindex;
-int regclass[NREGS];
-struct perm *perms;
-
-struct perm *
-tuples(regls,nregneeded) rl_p *regls; {
- int class=0;
- register i,j;
-
- /*
- * First compute equivalence classes of registers.
- */
-
- for (i=0;i<NREGS;i++) {
- regclass[i] = class++;
- if (getrefcount(i) == 0) {
- for (j=0;j<i;j++) {
- if (eqregclass(i,j) &&
- eqtoken(&machregs[i].r_contents,
- &machregs[j].r_contents)) {
- regclass[i] = regclass[j];
- break;
- }
- }
- }
- }
-
- /*
- * Now create tuples through a recursive function
- */
-
- maxindex = nregneeded;
- lar = regls;
- perms = 0;
- permute(0);
- return(perms);
-}
-
-permute(index) {
- register struct perm *pp;
- register rl_p rlp;
- register i,j;
-
- if (index == maxindex) {
- for (pp=perms; pp != 0; pp=pp->p_next) {
- for (i=0; i<maxindex; i++)
- if (regclass[rar[i]] != regclass[pp->p_rar[i]])
- goto diff;
- for (i=0; i<maxindex; i++)
- for (j=0; j<i; j++)
- if (clash(rar[i],rar[j]) !=
- clash(pp->p_rar[i],pp->p_rar[j]))
- goto diff;
- return;
- diff: ;
- }
- pp = (struct perm *) myalloc(sizeof ( *pp ));
- pp->p_next = perms;
- for (i=0; i<maxindex; i++)
- pp->p_rar[i] = rar[i];
- perms = pp;
- } else {
- rlp=lar[index];
- for (i=rlp->rl_n-1; i>=0; i--) {
- rar[index] = rlp->rl_list[i];
- permute(index+1);
- }
- }
-}
+++ /dev/null
-/* $Header$ */
-
-#define MAXCREG 4
-
-struct perm {
- struct perm *p_next;
- int p_rar[MAXCREG];
-};
+++ /dev/null
-/* $Header$ */
-
-extern int maxply; /* amount of lookahead allowed */
-extern int stackheight; /* # of tokens on fakestack */
-extern token_t fakestack[]; /* fakestack itself */
-extern int nallreg; /* number of allocated registers */
-extern int allreg[]; /* array of allocated registers */
-extern token_p curtoken; /* pointer to current token */
-extern result_t dollar[]; /* Values of $1,$2 etc.. */
-extern int nemlines; /* # of EM instructions in core */
-extern struct emline emlines[]; /* EM instructions itself */
-extern struct emline *emp; /* pointer to current instr */
-extern struct emline *saveemp; /* pointer to start of pattern */
-extern int tokpatlen; /* length of current stackpattern */
-extern rl_p curreglist; /* side effect of findcoerc() */
-#ifndef NDEBUG
-extern int Debug; /* on/off debug printout */
-#endif
-
-/*
- * Next descriptions are external declarations for tables created
- * by bootgram.
- * All definitions are to be found in tables.c (Not for humans)
- */
-
-extern byte coderules[]; /* pseudo code for cg itself */
-extern char stregclass[]; /* static register class */
-extern struct reginfo machregs[]; /* register info */
-extern tkdef_t tokens[]; /* token info */
-extern node_t enodes[]; /* expression nodes */
-extern string codestrings[]; /* table of strings */
-extern set_t machsets[]; /* token expression table */
-extern inst_t tokeninstances[]; /* token instance description table */
-extern move_t moves[]; /* move descriptors */
-extern byte pattern[]; /* EM patterns */
-extern int pathash[256]; /* Indices into previous */
-extern c1_t c1coercs[]; /* coercions type 1 */
-#ifdef MAXSPLIT
-extern c2_t c2coercs[]; /* coercions type 2 */
-#endif MAXSPLIT
-extern c3_t c3coercs[]; /* coercions type 3 */
-extern struct reginfo **reglist[]; /* lists of registers per property */
-
-#define eqregclass(r1,r2) (stregclass[r1]==stregclass[r2])
-
-#ifdef REGVARS
-extern int nregvar[]; /* # of register variables per type */
-extern int *rvnumbers[]; /* lists of numbers */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid2[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "assert.h"
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_flag.h>
-#include <em_ptyp.h>
-#include <em_mes.h>
-#include "mach.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#ifdef REGVARS
-#include "regvar.h"
-#include <em_reg.h>
-#endif
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/* segment types for switchseg() */
-#define SEGTXT 0
-#define SEGCON 1
-#define SEGROM 2
-#define SEGBSS 3
-
-long con();
-
-#define get8() getc(emfile)
-
-#define MAXSTR 256
-
-FILE *emfile;
-extern FILE *codefile;
-
-int nextispseu,savetab1;
-int opcode;
-int offtyp;
-long argval;
-int dlbval;
-char str[MAXSTR],argstr[32],labstr[32];
-int strsiz;
-int holno=0;
-int procno=0;
-int curseg= -1;
-int part_size=0;
-word part_word=0;
-int endofprog=0;
-#ifdef REGVARS
-int regallowed=0;
-#endif
-
-extern char em_flag[];
-extern short em_ptyp[];
-extern long atol();
-extern double atof();
-
-#define sp_cstx sp_cst2
-
-string tostring();
-string holstr();
-string strarg();
-string mystrcpy();
-long get32();
-
-in_init(filename) char *filename; {
-
- if ((emfile=freopen(filename,"r",stdin))==NULL)
- error("Can't open %s",filename);
- if (get16()!=sp_magic)
- error("Bad format %s",filename);
-}
-
-in_finish() {
-}
-
-fillemlines() {
- int t,i;
- register struct emline *lp;
-
- while ((emlines+nemlines)-emp<MAXEMLINES-5) {
- assert(nemlines<MAXEMLINES);
- if (nextispseu) {
- emlines[nemlines].em_instr=0;
- return;
- }
- lp = &emlines[nemlines++];
-
- switch(t=table1()) {
- default:
- error("unknown instruction byte");
- case sp_ilb1:
- case sp_ilb2:
- case sp_fpseu:
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- nextispseu=1; savetab1=t;
- nemlines--;
- lp->em_instr = 0;
- return;
- case EOF:
- nextispseu=1; savetab1=t;
- endofprog=1;
- nemlines--;
- lp->em_instr = 0;
- return;
- case sp_fmnem:
- lp->em_instr = opcode;
- break;
- }
- i=em_flag[lp->em_instr-sp_fmnem] & EM_PAR;
- if ( i == PAR_NO ) {
- lp->em_optyp = OPNO;
- lp->em_soper = 0;
- continue;
- }
- t= em_ptyp[i];
- t= getarg(t);
- switch(i) {
- case PAR_L:
- assert(t == sp_cstx);
- if (argval >= 0)
- argval += EM_BSIZE;
- lp->em_optyp = OPINT;
- lp->em_u.em_ioper = argval;
- lp->em_soper = tostring((word) argval);
- continue;
- case PAR_G:
- if (t != sp_cstx)
- break;
- lp->em_optyp = OPSYMBOL;
- lp->em_soper = holstr((word) argval);
- continue;
- case PAR_B:
- t = sp_ilb2;
- break;
- case PAR_D:
- assert(t == sp_cstx);
- lp->em_optyp = OPSYMBOL;
- lp->em_soper = strarg(t);
- lp->em_u.em_loper = argval;
- continue;
- }
- lp->em_soper = strarg(t);
- if (t==sp_cend)
- lp->em_optyp = OPNO;
- else if (t==sp_cstx) {
- lp->em_optyp = OPINT;
- lp->em_u.em_ioper = argval;
- } else
- lp->em_optyp = OPSYMBOL;
- }
-}
-
-dopseudo() {
- register b,t;
- register full n;
- register long save;
- word romcont[MAXROM+1];
- int nromwords;
- int rombit,rommask;
- unsigned dummy,stackupto();
-
- if (nextispseu==0 || nemlines>0)
- error("No table entry for %d",emlines[0].em_instr);
- nextispseu=0;
- switch(savetab1) {
- case sp_ilb1:
- case sp_ilb2:
- swtxt();
- dummy = stackupto(&fakestack[stackheight-1],maxply,TRUE);
- cleanregs();
- strarg(savetab1);
- newilb(argstr);
- return;
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- strarg(savetab1);
- savelab();
- return;
- case sp_fpseu:
- break;
- case EOF:
- swtxt();
- popstr(0);
- tstoutput();
- exit(0);
- default:
- error("Unknown opcode %d",savetab1);
- }
- switch (opcode) {
- case ps_hol:
- sprintf(labstr,hol_fmt,++holno);
- case ps_bss:
- getarg(cst_ptyp);
- n = (full) argval;
- t = getarg(val_ptyp);
- save = argval;
- getarg(cst_ptyp);
- b = (int) argval;
- argval = save;
- bss(n,t,b);
- break;
- case ps_con:
- switchseg(SEGCON);
- dumplab();
- con(getarg(val_ptyp));
- while ((t = getarg(any_ptyp)) != sp_cend)
- con(t);
- break;
- case ps_rom:
- switchseg(SEGROM);
- xdumplab();
- nromwords=0;
- rommask=0;
- rombit=1;
- t=getarg(val_ptyp);
- while (t!=sp_cend) {
- if (t==sp_cstx && nromwords<MAXROM) {
- romcont[nromwords] = (word) argval;
- rommask |= rombit;
- }
- nromwords++;
- rombit <<= 1;
- con(t);
- t=getarg(any_ptyp);
- }
- if (rommask != 0) {
- romcont[MAXROM]=rommask;
- enterglo(labstr,romcont);
- }
- labstr[0]=0;
- break;
- case ps_mes:
- getarg(ptyp(sp_cst2));
- if (argval == ms_emx) {
- getarg(ptyp(sp_cst2));
- if (argval != EM_WSIZE)
- fatal("bad word size");
- getarg(ptyp(sp_cst2));
- if (argval != EM_PSIZE)
- fatal("bad pointer size");
- if ( getarg(any_ptyp)!=sp_cend )
- fatal("too many parameters");
-#ifdef REGVARS
- } else if (argval == ms_gto) {
- getarg(ptyp(sp_cend));
- if (!regallowed)
- error("mes 3 not allowed here");
- fixregvars(TRUE);
- regallowed=0;
- } else if (argval == ms_reg) {
- long r_off;
- int r_size,r_type,r_score;
- struct regvar *linkreg();
-
- if (!regallowed)
- error("mes 3 not allowed here");
- if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend) {
- fixregvars(FALSE);
- regallowed=0;
- } else {
- r_off = argval;
-#ifdef EM_BSIZE
- if (r_off >= 0)
- r_off += EM_BSIZE;
-#endif
- getarg(ptyp(sp_cst2));
- r_size = argval;
- getarg(ptyp(sp_cst2));
- r_type = argval;
- if (r_type<reg_any || r_type>reg_float)
- fatal("Bad type in register message");
- if(getarg(ptyp(sp_cst2)|ptyp(sp_cend)) == sp_cend)
- r_score = 0;
- else {
- r_score = argval;
- if ( getarg(any_ptyp)!=sp_cend )
- fatal("too many parameters");
- }
- tryreg(linkreg(r_off,r_size,r_type,r_score),r_type);
- }
-#endif
- } else
- mes((word)argval);
- break;
- case ps_exa:
- strarg(getarg(sym_ptyp));
- ex_ap(argstr);
- break;
- case ps_ina:
- strarg(getarg(sym_ptyp));
- in_ap(argstr);
- break;
- case ps_exp:
- strarg(getarg(ptyp(sp_pnam)));
- ex_ap(argstr);
- break;
- case ps_inp:
- strarg(getarg(ptyp(sp_pnam)));
- in_ap(argstr);
- break;
- case ps_pro:
- switchseg(SEGTXT);
- procno++;
- strarg(getarg(ptyp(sp_pnam)));
- newilb(argstr);
- getarg(cst_ptyp);
- prolog((full)argval);
-#ifdef REGVARS
- regallowed++;
-#endif
- break;
- case ps_end:
- getarg(cst_ptyp | ptyp(sp_cend));
- cleanregs();
-#ifdef REGVARS
- unlinkregs();
-#endif
- tstoutput();
- break;
- default:
- error("No table entry for %d",savetab1);
- }
-}
-
-/* ----- input ----- */
-
-int getarg(typset) {
- register t,argtyp;
-
- argtyp = t = table2();
- if (t == EOF)
- fatal("unexpected EOF");
- t -= sp_fspec;
- t = 1 << t;
- if ((typset & t) == 0)
- error("bad argument type %d",argtyp);
- return(argtyp);
-}
-
-int table1() {
- register i;
-
- i = get8();
- if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
- opcode = i;
- return(sp_fmnem);
- }
- if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
- opcode = i;
- return(sp_fpseu);
- }
- if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
- argval = i - sp_filb0;
- return(sp_ilb2);
- }
- return(table3(i));
-}
-
-int table2() {
- register i;
-
- i = get8();
- if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
- argval = i - sp_zcst0;
- return(sp_cstx);
- }
- return(table3(i));
-}
-
-int table3(i) {
- word consiz;
-
- switch(i) {
- case sp_ilb1:
- argval = get8();
- break;
- case sp_dlb1:
- dlbval = get8();
- break;
- case sp_dlb2:
- dlbval = get16();
- break;
- case sp_cst2:
- i = sp_cstx;
- case sp_ilb2:
- argval = get16();
- break;
- case sp_cst4:
- i = sp_cstx;
- argval = get32();
- break;
- case sp_dnam:
- case sp_pnam:
- case sp_scon:
- getstring();
- break;
- case sp_doff:
- offtyp = getarg(sym_ptyp);
- getarg(cst_ptyp);
- break;
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- getarg(cst_ptyp);
- consiz = (word) argval;
- getstring();
- argval = consiz;
- break;
- }
- return(i);
-}
-
-int get16() {
- register int l_byte, h_byte;
-
- l_byte = get8();
- h_byte = get8();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-long get32() {
- register long l;
- register int h_byte;
-
- l = get8();
- l |= ((unsigned) get8())*256 ;
- l |= get8()*256L*256L ;
- h_byte = get8() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-
-getstring() {
- register char *p;
- register n;
-
- getarg(cst_ptyp);
- if (argval < 0 || argval > MAXSTR-1)
- fatal("string/identifier too long");
- strsiz = n = (int) argval;
- p = str;
- while (--n >= 0)
- *p++ = get8();
- *p++ = '\0';
-}
-
-char *strarg(t) {
- register char *p;
-
- switch (t) {
- case sp_ilb1:
- case sp_ilb2:
- sprintf(argstr,ilb_fmt,procno,(int)argval);
- break;
- case sp_dlb1:
- case sp_dlb2:
- sprintf(argstr,dlb_fmt,dlbval);
- break;
- case sp_cstx:
- sprintf(argstr,cst_fmt,(full)argval);
- break;
- case sp_dnam:
- case sp_pnam:
- p = argstr;
- if (strsiz < 8 || str[0] == id_first)
- *p++ = id_first;
- sprintf(p,"%.*s",strsiz,str);
- break;
- case sp_doff:
- strarg(offtyp);
- for (p = argstr; *p; p++)
- ;
- if (argval >= 0)
- *p++ = '+';
- sprintf(p,off_fmt,(full)argval);
- break;
- case sp_cend:
- return("");
- }
- return(mystrcpy(argstr));
-}
-
-bss(n,t,b) full n; {
- register long s;
-
- if (n % EM_WSIZE)
- fatal("bad BSS size");
- if (b==0
-#ifdef BSS_INIT
- || (t==sp_cstx && argval==BSS_INIT)
-#endif BSS_INIT
- ) {
- switchseg(SEGBSS);
- newlbss(labstr,n);
- labstr[0]=0;
- return;
- }
- switchseg(SEGCON);
- dumplab();
- while (n > 0)
- n -= (s = con(t));
- if (s % EM_WSIZE)
- fatal("bad BSS initializer");
-}
-
-long con(t) {
- register i;
-
- strarg(t);
- switch (t) {
- case sp_ilb1:
- case sp_ilb2:
- case sp_pnam:
- part_flush();
- con_ilb(argstr);
- return((long)EM_PSIZE);
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- case sp_doff:
- part_flush();
- con_dlb(argstr);
- return((long)EM_PSIZE);
- case sp_cstx:
- con_part(EM_WSIZE,(word)argval);
- return((long)EM_WSIZE);
- case sp_scon:
- for (i = 0; i < strsiz; i++)
- con_part(1,(word) str[i]);
- return((long)strsiz);
- case sp_icon:
- case sp_ucon:
- if (argval > EM_WSIZE) {
- part_flush();
- con_mult((word)argval);
- } else {
- con_part((int)argval,(word)atol(str));
- }
- return(argval);
- case sp_fcon:
- part_flush();
- con_float();
- return(argval);
- }
- assert(FALSE);
- /* NOTREACHED */
-}
-
-extern char *segname[];
-
-swtxt() {
- switchseg(SEGTXT);
-}
-
-switchseg(s) {
-
- if (s == curseg)
- return;
- part_flush();
- if ((curseg = s) >= 0)
- fprintf(codefile,"%s\n",segname[s]);
-}
-
-savelab() {
- register char *p,*q;
-
- part_flush();
- if (labstr[0]) {
- dlbdlb(argstr,labstr);
- return;
- }
- p = argstr;
- q = labstr;
- while (*q++ = *p++)
- ;
-}
-
-dumplab() {
-
- if (labstr[0] == 0)
- return;
- assert(part_size == 0);
- newdlb(labstr);
- labstr[0] = 0;
-}
-
-xdumplab() {
-
- if (labstr[0] == 0)
- return;
- assert(part_size == 0);
- newdlb(labstr);
-}
-
-part_flush() {
-
- /*
- * Each new data fragment and each data label starts at
- * a new target machine word
- */
- if (part_size == 0)
- return;
- con_cst(part_word);
- part_size = 0;
- part_word = 0;
-}
-
-string holstr(n) word n; {
-
- sprintf(str,hol_off,n,holno);
- return(mystrcpy(str));
-}
-
-
-/* ----- machine dependent routines ----- */
-
-#include "mach.c"
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include <stdio.h>
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-FILE *codefile;
-
-out_init(filename) char *filename; {
-
-#ifndef NDEBUG
- static char stderrbuff[512];
-
- if (Debug) {
- codefile = stderr;
- if (!isatty(2))
- setbuf(stderr,stderrbuff);
- } else {
-#endif
- if (filename == (char *) 0)
- codefile = stdout;
- else
- if ((codefile=freopen(filename,"w",stdout))==NULL)
- error("Can't create %s",filename);
-#ifndef NDEBUG
- }
-#endif
-}
-
-out_finish() {
-
-#ifndef NDEBUG
- if (Debug)
- fflush(stderr);
- else
-#endif
- fclose(codefile);
-}
-
-tstoutput() {
-
- if (ferror(codefile))
- error("Write error on output");
-}
-
-gencode(code) register char *code; {
- register c;
- int tokno,fldno,insno,regno,subno;
- register token_p tp;
-
- swtxt();
- while ((c= *code++)!=0) switch(c) {
- default:
- fputc(c,codefile);
- break;
- case PR_TOK:
- tokno = *code++;
- tp = &fakestack[stackheight-tokno];
- if (tp->t_token==-1)
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[0].ar].r_repr]);
- else
- prtoken(tp);
- break;
- case PR_TOKFLD:
- tokno = *code++;
- fldno = *code++;
- tp = &fakestack[stackheight-tokno];
- assert(tp->t_token != -1);
- switch(tokens[tp->t_token].t_type[fldno-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,tp->t_att[fldno-1].aw);
- break;
- case EV_STR:
- fprintf(codefile,"%s",tp->t_att[fldno-1].as);
- break;
- case EV_REG:
- assert(tp->t_att[fldno-1].ar>0 && tp->t_att[fldno-1].ar<NREGS);
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[fldno-1].ar].r_repr]);
- break;
- }
- break;
- case PR_EMINT:
- insno = *code++;
- fprintf(codefile,WRD_FMT,dollar[insno-1].e_v.e_con);
- break;
- case PR_EMSTR:
- insno = *code++;
- fprintf(codefile,"%s",dollar[insno-1].e_v.e_str);
- break;
- case PR_ALLREG:
- regno = *code++;
- subno = (*code++)&0377;
- assert(regno>=1 && regno<=nallreg);
- regno = allreg[regno-1];
-#if MAXMEMBERS!=0
- if (subno!=255) {
- assert(subno>=1 && subno<=MAXMEMBERS);
- regno = machregs[regno].r_members[subno-1];
- assert(regno!=0);
- }
-#endif
- fprintf(codefile,"%s",codestrings[machregs[regno].r_repr]);
- break;
-#if MAXMEMBERS!=0
- case PR_SUBREG:
- tokno = *code++;
- subno = *code++;
- tp = &fakestack[stackheight-tokno];
- assert(tp->t_token == -1);
- fprintf(codefile,"%s",codestrings[machregs[machregs[tp->t_att[0].ar].r_members[subno-1]].r_repr]);
- break;
-#endif
- }
-}
-
-genexpr(nodeno) {
- result_t result;
-
- result= compute(&enodes[nodeno]);
- switch(result.e_typ) {
- default: assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,result.e_v.e_con);
- break;
- case EV_REG:
- fprintf(codefile,"%s", codestrings[machregs[result.e_v.e_reg].r_repr]);
- break;
- case EV_STR:
- fprintf(codefile,"%s",result.e_v.e_str);
- break;
- }
-}
-
-gennl() {
- fputc('\n',codefile);
-}
-
-prtoken(tp) token_p tp; {
- register c;
- register char *code;
- register tkdef_p tdp;
-
- tdp = &tokens[tp->t_token];
- assert(tdp->t_format != -1);
- code = codestrings[tdp->t_format];
- while ((c = *code++) != 0) {
- if (c>=' ' && c<='~')
- fputc(c,codefile);
- else {
- assert(c>0 && c<=TOKENSIZE);
- switch(tdp->t_type[c-1]) {
- default:
- assert(FALSE);
- case EV_INT:
- fprintf(codefile,WRD_FMT,tp->t_att[c-1].aw);
- break;
- case EV_STR:
- fprintf(codefile,"%s",tp->t_att[c-1].as);
- break;
- case EV_REG:
- fprintf(codefile,"%s",codestrings[machregs[tp->t_att[c-1].ar].r_repr]);
- break;
- }
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include "glosym.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern string myalloc();
-
-glosym_p glolist= (glosym_p) 0;
-
-enterglo(name,romp) string name; word *romp; {
- register glosym_p gp;
- register i;
-
- gp = (glosym_p) myalloc(sizeof *gp);
- gp->gl_next = glolist;
- gp->gl_name = (string) myalloc(strlen(name)+1);
- strcpy(gp->gl_name,name);
- for (i=0;i<=MAXROM;i++)
- gp->gl_rom[i] = romp[i];
- glolist = gp;
-}
-
-glosym_p lookglo(name) string name; {
- register glosym_p gp;
-
- for (gp=glolist;gp != (glosym_p) 0; gp=gp->gl_next)
- if (strcmp(gp->gl_name,name)==0)
- return(gp);
- return((glosym_p) 0);
-}
+++ /dev/null
-/* $Header$ */
-
-typedef struct glosym {
- struct glosym *gl_next;
- string gl_name;
- word gl_rom[MAXROM+1];
-} glosym_t,*glosym_p;
-
-glosym_p lookglo();
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-char *progname;
-extern char startupcode[];
-int maxply=1;
-#ifndef NDEBUG
-int Debug=0;
-#endif
-
-extern int endofprog;
-
-main(argc,argv) char **argv; {
- register unsigned n;
- extern unsigned cc1,cc2,cc3,cc4;
- unsigned ggd();
-
- progname = argv[0];
- while (--argc && **++argv == '-') {
- switch(argv[0][1]) {
-#ifndef NDEBUG
- case 'd':
- Debug=1; break;
-#endif
- case 'p':
- maxply = atoi(argv[0]+2);
- break;
- case 'w': /* weight percentage for size */
- n=atoi(argv[0]+2);
- cc1 *= n;
- cc2 *= 50;
- cc3 *= (100-n);
- cc4 *= 50;
- n=ggd(cc1,cc2);
- cc1 /= n;
- cc2 /= n;
- n=ggd(cc3,cc4);
- cc3 /= n;
- cc4 /= n;
- break;
- default:
- error("Unknown flag %c",argv[0][1]);
- }
- }
- if (argc < 1 || argc > 2)
- error("Usage: %s EMfile [ asfile ]",progname);
- in_init(argv[0]);
- out_init(argv[1]);
- codegen(startupcode,maxply,TRUE,MAXINT,0);
- in_finish();
- if (!endofprog)
- error("Bombed out of codegen");
- out_finish();
-}
-
-unsigned ggd(a,b) register unsigned a,b; {
- register unsigned c;
-
- do {
- c = a%b; a=b; b=c;
- } while (c!=0);
- return(a);
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned costcalc();
-
-move(tp1,tp2,ply,toplevel,maxcost) token_p tp1,tp2; unsigned maxcost; {
- register move_p mp;
- register unsigned t;
- register struct reginfo *rp;
- tkdef_p tdp;
- int i;
- unsigned codegen();
-
- if (eqtoken(tp1,tp2))
- return(0);
- if (tp2->t_token == -1) {
- if (tp1->t_token == -1) {
- if (eqtoken(&machregs[tp1->t_att[0].ar].r_contents,
- &machregs[tp2->t_att[0].ar].r_contents) &&
- machregs[tp1->t_att[0].ar].r_contents.t_token!=0)
- return(0);
- if (tp1->t_att[0].ar!=1) { /* COCO reg; tmp kludge */
- erasereg(tp2->t_att[0].ar);
- machregs[tp2->t_att[0].ar].r_contents =
- machregs[tp1->t_att[0].ar].r_contents ;
- } else
- machregs[tp1->t_att[0].ar].r_contents =
- machregs[tp2->t_att[0].ar].r_contents ;
- } else {
- if (eqtoken(&machregs[tp2->t_att[0].ar].r_contents,tp1))
- return(0);
- machregs[tp2->t_att[0].ar].r_contents = *tp1;
- }
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- if (rp->r_contents.t_token == 0)
- continue;
- assert(rp->r_contents.t_token > 0);
- tdp = &tokens[rp->r_contents.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_REG &&
- clash(rp->r_contents.t_att[i].ar,tp2->t_att[0].ar)) {
- erasereg(rp-machregs);
- break;
- }
- }
- } else if (tp1->t_token == -1) {
- if (eqtoken(tp2,&machregs[tp1->t_att[0].ar].r_contents))
- return(0);
- machregs[tp1->t_att[0].ar].r_contents = *tp2;
- }
- /*
- * If we arrive here the move must really be executed
- */
- for (mp=moves;mp<moves+NMOVES;mp++) {
- if (!match(tp1,&machsets[mp->m_set1],mp->m_expr1))
- continue;
- if (match(tp2,&machsets[mp->m_set2],mp->m_expr2))
- break;
- /*
- * Correct move rule is found
- */
- }
- assert(mp<moves+NMOVES);
- /*
- * To get correct interpretation of things like %[1]
- * in move code we stack tp2 and tp1. This little trick
- * saves a lot of testing in other places.
- */
-
- if (mp->m_cindex!=0) {
- fakestack[stackheight] = *tp2;
- fakestack[stackheight+1] = *tp1;
- stackheight += 2;
- t = codegen(&coderules[mp->m_cindex],ply,toplevel,maxcost,0);
- if (t <= maxcost)
- t += costcalc(mp->m_cost);
- stackheight -= 2;
- } else {
- t = 0;
- }
- return(t);
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <em_spec.h>
-#include <em_flag.h>
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifndef NDEBUG
-#include <stdio.h>
-extern char em_mnem[][4];
-#endif
-
-byte *trypat(bp,len) register byte *bp; {
- register patlen,i;
- result_t result;
-
- getint(patlen,bp);
- if (len == 3) {
- if (patlen < 3)
- return(0);
- } else {
- if (patlen != len)
- return(0);
- }
- for(i=0;i<patlen;i++)
- if (emp[i].em_instr != (*bp++&BMASK))
- return(0);
- for (i=0;i<patlen;i++)
- if (emp[i].em_optyp==OPNO)
- dollar[i].e_typ=EV_UNDEF;
- else if ((dollar[i].e_typ=argtyp(emp[i].em_instr))==EV_INT)
- dollar[i].e_v.e_con=emp[i].em_u.em_ioper;
- else
- dollar[i].e_v.e_str=emp[i].em_soper;
- getint(i,bp);
- if (i!=0) {
- result = compute(&enodes[i]);
- if (result.e_typ != EV_INT || result.e_v.e_con == 0)
- return(0);
- }
-#ifndef NDEBUG
- if (Debug) {
- fprintf(stderr,"Matched:");
- for (i=0;i<patlen;i++)
- fprintf(stderr," %3.3s",em_mnem[emp[i].em_instr-sp_fmnem]);
- fprintf(stderr,"\n");
- }
-#endif
- saveemp = emp;
- emp += patlen;
- return(bp);
-}
-
-extern char em_flag[];
-
-argtyp(mn) {
-
- switch(em_flag[mn-sp_fmnem]&EM_PAR) {
- case PAR_W:
- case PAR_S:
- case PAR_Z:
- case PAR_O:
- case PAR_N:
- case PAR_L:
- case PAR_F:
- case PAR_R:
- case PAR_C:
- return(EV_INT);
- default:
- return(EV_STR);
- }
-}
-
-byte *nextem(toplevel) {
- register i;
- short hash[3];
- register byte *bp;
- byte *cp;
- int index;
- register struct emline *ep;
-
- if (toplevel) {
- if (nemlines && emp>emlines) {
- nemlines -= emp-emlines;
- for (i=0,ep=emlines;i<nemlines;i++)
- *ep++ = *emp++;
- emp=emlines;
- }
- fillemlines();
- }
- hash[0] = emp[0].em_instr;
- hash[1] = (hash[0]<<4) ^ emp[1].em_instr;
- hash[2] = (hash[1]<<4) ^ emp[2].em_instr;
- for (i=2;i>=0;i--) {
- index = pathash[hash[i]&BMASK];
- while (index != 0) {
- bp = &pattern[index];
- if ( bp[PO_HASH] == (hash[i]>>8))
- if ((cp=trypat(&bp[PO_MATCH],i+1)) != 0)
- return(cp);
- index = (bp[PO_NEXT]&BMASK) | (bp[PO_NEXT+1]<<8);
- }
- }
- return(0);
-}
+++ /dev/null
-/* $Header$ */
-
-#define BMASK 0377
-#define BSHIFT 8
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXINT 32767
-#define INFINITY (MAXINT+100)
-
-#define MAXROM 3
-
-/*
- * Tunable constants
- */
-
-#define MAXEMLINES 20
-#define MAXFSTACK 20
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-chrefcount(regno,amount,tflag) {
- register struct reginfo *rp;
- register i;
-
- rp= &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0]==0) {
-#endif
- rp->r_refcount += amount;
- if (tflag)
- rp->r_tcount += amount;
- assert(rp->r_refcount >= 0);
-#if MAXMEMBERS!=0
- } else
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i]!=0)
- chrefcount(rp->r_members[i],amount,tflag);
-#endif
-}
-
-getrefcount(regno) {
- register struct reginfo *rp;
- register i,maxcount;
-
- rp= &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0]==0)
-#endif
- return(rp->r_refcount);
-#if MAXMEMBERS!=0
- else {
- maxcount=0;
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i]!=0)
- maxcount=max(maxcount,getrefcount(rp->r_members[i]));
- return(maxcount);
- }
-#endif
-}
-
-erasereg(regno) {
- register struct reginfo *rp;
-
-#if MAXMEMBERS==0
- awayreg(regno);
-#else
- for (rp=machregs;rp<machregs+NREGS;rp++)
- if (rp->r_clash[regno>>4]&(1<<(regno&017)))
- awayreg(rp-machregs);
-#endif
-}
-
-awayreg(regno) {
- register struct reginfo *rp;
- register tkdef_p tdp;
- register i;
-
- rp = &machregs[regno];
- rp->r_contents.t_token = 0;
- for (i=0;i<TOKENSIZE;i++)
- rp->r_contents.t_att[i].aw = 0;
-
- /* Now erase recursively all registers containing
- * something using this one
- */
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- if (rp->r_contents.t_token == -1) {
- if (rp->r_contents.t_att[0].ar == regno)
- erasereg(rp-machregs);
- } else {
- tdp= & tokens[rp->r_contents.t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_REG &&
- rp->r_contents.t_att[i].ar == regno) {
- erasereg(rp-machregs);
- break;
- }
- }
- }
-}
-
-cleanregs() {
- register struct reginfo *rp;
- register i;
-
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- rp->r_contents.t_token = 0;
- for (i=0;i<TOKENSIZE;i++)
- rp->r_contents.t_att[i].aw = 0;
- }
-}
-
-#ifndef NDEBUG
-inctcount(regno) {
- register struct reginfo *rp;
- register i;
-
- rp = &machregs[regno];
-#if MAXMEMBERS!=0
- if (rp->r_members[0] == 0) {
-#endif
- rp->r_tcount++;
-#if MAXMEMBERS!=0
- } else {
- for (i=0;i<MAXMEMBERS;i++)
- if (rp->r_members[i] != 0)
- inctcount(rp->r_members[i]);
- }
-#endif
-}
-
-chkregs() {
- register struct reginfo *rp;
- register token_p tp;
- register tkdef_p tdp;
- int i;
-
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- assert(rp->r_tcount==0);
- }
- for (tp=fakestack;tp<fakestack+stackheight;tp++) {
- if (tp->t_token == -1)
- inctcount(tp->t_att[0].ar);
- else {
- tdp = &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- inctcount(tp->t_att[i].ar);
- }
- }
-#ifdef REGVARS
-#include <em_reg.h>
- for(i=reg_any;i<=reg_float;i++) {
- int j;
- for(j=0;j<nregvar[i];j++)
- inctcount(rvnumbers[i][j]);
- }
-#endif REGVARS
- for (rp=machregs;rp<machregs+NREGS;rp++) {
- assert(rp->r_refcount==rp->r_tcount);
- rp->r_tcount=0;
- }
-}
-#endif
+++ /dev/null
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-
-#ifdef REGVARS
-
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "regvar.h"
-#include <em_reg.h>
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-struct regvar *rvlist;
-
-struct regvar *
-linkreg(of,sz,tp,sc) long of; {
- struct regvar *rvlp;
-
- rvlp= (struct regvar *) myalloc(sizeof *rvlp);
- rvlp->rv_next = rvlist;
- rvlist=rvlp;
- rvlp->rv_off = of;
- rvlp->rv_size = sz;
- rvlp->rv_type = tp;
- rvlp->rv_score = sc;
- rvlp->rv_reg = 0; /* no register assigned yet */
- return(rvlp);
-}
-
-tryreg(rvlp,typ) struct regvar *rvlp; {
- int score;
- register i;
- struct regassigned *ra;
- struct regvar *save;
-
- if (typ != reg_any && nregvar[typ]!=0) {
- if (machregs[rvnumbers[typ][0]].r_size!=rvlp->rv_size)
- score = -1;
- else
- score = regscore(rvlp->rv_off,
- rvlp->rv_size,
- rvlp->rv_type,
- rvlp->rv_score,
- typ); /* machine dependent */
- ra = regassigned[typ];
- if (score>ra[nregvar[typ]-1].ra_score) {
- save = ra[nregvar[typ]-1].ra_rv;
- for (i=nregvar[typ]-1;i>0 && ra[i-1].ra_score<score;i--)
- ra[i] = ra[i-1];
- ra[i].ra_rv = rvlp;
- ra[i].ra_score = score;
- if((rvlp=save)==0)
- return;
- }
- }
- if (nregvar[reg_any]==0)
- return;
- if (machregs[rvnumbers[reg_any][0]].r_size!=rvlp->rv_size)
- score = -1;
- else
- score = regscore(rvlp->rv_off,
- rvlp->rv_size,
- rvlp->rv_type,
- rvlp->rv_score,
- reg_any); /* machine dependent */
- ra = regassigned[reg_any];
- if (score>ra[nregvar[reg_any]-1].ra_score) {
- for (i=nregvar[reg_any]-1;i>0 && ra[i-1].ra_score<score;i--)
- ra[i] = ra[i-1];
- ra[i].ra_rv = rvlp;
- ra[i].ra_score = score;
- }
-}
-
-fixregvars(saveall) {
- register struct regvar *rv;
- register rvtyp,i;
-
- swtxt();
- i_regsave(); /* machine dependent initialization */
- for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
- for(i=0;i<nregvar[rvtyp];i++)
- if (saveall) {
- struct reginfo *rp;
- rp= &machregs[rvnumbers[rvtyp][i]];
- regsave(codestrings[rp->r_repr],-EM_WSIZE,rp->r_size);
- } else if(regassigned[rvtyp][i].ra_score>0) {
- rv=regassigned[rvtyp][i].ra_rv;
- rv->rv_reg=rvnumbers[rvtyp][i];
- regsave(codestrings[machregs[rv->rv_reg].r_repr],
- rv->rv_off,rv->rv_size);
- }
- }
- f_regsave();
-#ifndef EM_BSIZE
- for(rv=rvlist;rv!=0;rv=rv->rv_next)
- if (rv->rv_off >= 0) rv->rv_off += EM_BSIZE;
-#endif
-}
-
-isregvar(off) long off; {
- register struct regvar *rvlp;
-
- for(rvlp=rvlist;rvlp!=0;rvlp=rvlp->rv_next)
- if(rvlp->rv_off == off)
- return(rvlp->rv_reg);
- return(-1);
-}
-
-unlinkregs() {
- register struct regvar *rvlp,*t;
- register struct regassigned *ra;
- int rvtyp,i;
-
- for(rvlp=rvlist;rvlp!=0;rvlp=t) {
- t=rvlp->rv_next;
- myfree(rvlp);
- }
- rvlist=0;
- for (rvtyp=reg_any;rvtyp<=reg_float;rvtyp++) {
- for(i=0;i<nregvar[rvtyp];i++) {
- ra= ®assigned[rvtyp][i];
- ra->ra_rv = 0;
- ra->ra_score = 0;
- }
- }
-}
-
-#endif REGVARS
-
-/* nothing after this */
+++ /dev/null
-/* $Header$ */
-
-struct regvar {
- struct regvar *rv_next;
- long rv_off;
- int rv_size;
- int rv_type;
- int rv_score;
- int rv_reg;
-};
-
-struct regassigned {
- struct regvar *ra_rv;
- int ra_score;
-};
-
-extern struct regvar *rvlist;
-extern int nregvar[];
-extern struct regassigned *regassigned[];
+++ /dev/null
-/* $Header$ */
-
-struct result {
- int e_typ; /* EV_INT,EV_REG,EV_STR */
- union {
- word e_con;
- int e_reg;
- string e_str;
- } e_v; /* value */
-};
-
-#define EV_UNDEF 0
-#define EV_INT 1
-#define EV_REG 2
-#define EV_STR 3
-
-typedef struct result result_t;
-
-extern result_t compute();
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * Package for string allocation and garbage collection.
- * Call salloc(size) to get room for string.
- * Every now and then call garbage_collect() from toplevel.
- */
-
-#define MAXSTAB 500
-#define THRESHOLD 200
-
-char *stab[MAXSTAB];
-int nstab=0;
-string malloc();
-
-string myalloc(size) {
- register string p;
-
- p = (string) malloc(size);
- if (p==0)
- fatal("Out of memory");
- return(p);
-}
-
-myfree(p) string p; {
-
- free(p);
-}
-
-popstr(nnstab) {
- register i;
-
- for (i=nnstab;i<nstab;i++)
- myfree(stab[i]);
- nstab = nnstab;
-}
-
-char *salloc(size) {
- register char *p;
-
- if (nstab==MAXSTAB)
- fatal("String table overflow");
- p = myalloc(size+1); /* extra room for terminating zero */
- stab[nstab++] = p;
- return(p);
-}
-
-compar(p1,p2) char **p1,**p2; {
-
- assert(*p1 != *p2);
- if (*p1 < *p2)
- return(-1);
- return(1);
-}
-
-garbage_collect() {
- register i;
- struct emline *emlp;
- token_p tp;
- tkdef_p tdp;
- struct reginfo *rp;
- register char **fillp,**scanp;
- char used[MAXSTAB]; /* could be bitarray */
-
- if (nstab<THRESHOLD)
- return;
- qsort(stab,nstab,sizeof (char *),compar);
- for (i=0;i<nstab;i++)
- used[i]= FALSE;
- for(emlp=emlines;emlp<emlines+nemlines;emlp++)
- chkstr(emlp->em_soper,used);
- for (tp= fakestack;tp<&fakestack[stackheight];tp++) {
- if (tp->t_token== -1)
- continue;
- tdp = &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_STR)
- chkstr(tp->t_att[i].as,used);
- }
- for (rp= machregs; rp<machregs+NREGS; rp++) {
- tp = &rp->r_contents;
- assert(tp->t_token != -1);
- tdp= &tokens[tp->t_token];
- for (i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i] == EV_STR)
- chkstr(tp->t_att[i].as,used);
- }
- for (i=0;i<nstab;i++)
- if (!used[i]) {
- myfree(stab[i]);
- stab[i]=0;
- }
- fillp=stab;
- for (scanp=stab;scanp<stab+nstab;scanp++)
- if (*scanp != 0)
- *fillp++ = *scanp;
- nstab = fillp-stab;
-}
-
-chkstr(str,used) string str; char used[]; {
- register low,middle,high;
-
- low=0; high=nstab-1;
- while (high>low) {
- middle= (low+high)>>1;
- if (str==stab[middle]) {
- used[middle]=1;
- return;
- }
- if (str<stab[middle])
- high = middle-1;
- else
- low = middle+1;
- }
- if (low==high) {
- if (str==stab[low]) {
- used[low]=1;
- }
- return;
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "state.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern int nstab; /* salloc.c */
-
-#ifndef STONSTACK
-extern string myalloc();
-
-state_p stlist=0;
-#endif
-
-#ifdef STONSTACK
-savestatus(sp) register state_p sp; {
-#else
-state_p savestatus() {
- register state_p sp;
-
- if ((sp=stlist)==0)
- sp = (state_p) myalloc( sizeof( *sp ) );
- else
- stlist=sp->st_next;
-#endif
- sp->st_sh = stackheight;
- bmove((short *)fakestack,(short *)sp->st_fs,stackheight*sizeof(token_t));
- sp->st_na = nallreg;
- bmove((short *)allreg,(short *)sp->st_ar,nallreg*sizeof(int));
- sp->st_ct = curtoken;
- bmove((short *)dollar,(short *)sp->st_do,LONGESTPATTERN*sizeof(result_t));
- bmove((short *)machregs,(short *)sp->st_mr,NREGS*sizeof(struct reginfo));
- sp->st_ne = nemlines;
- bmove((short *)emlines,(short *)sp->st_el,nemlines*sizeof(struct emline));
- sp->st_em = emp;
- sp->st_se = saveemp;
- sp->st_tl = tokpatlen;
- sp->st_ns = nstab;
-#ifndef STONSTACK
- return(sp);
-#endif
-}
-
-restorestatus(sp) register state_p sp; {
-
- stackheight = sp->st_sh;
- bmove((short *)sp->st_fs,(short *)fakestack,stackheight*sizeof(token_t));
- nallreg = sp->st_na;
- bmove((short *)sp->st_ar,(short *)allreg,nallreg*sizeof(int));
- curtoken = sp->st_ct;
- bmove((short *)sp->st_do,(short *)dollar,LONGESTPATTERN*sizeof(result_t));
- bmove((short *)sp->st_mr,(short *)machregs,NREGS*sizeof(struct reginfo));
- nemlines = sp->st_ne;
- bmove((short *)sp->st_el,(short *)emlines,nemlines*sizeof(struct emline));
- emp = sp->st_em;
- saveemp = sp->st_se;
- tokpatlen = sp->st_tl;
- popstr(sp->st_ns);
-}
-
-#ifndef STONSTACK
-freestatus(sp) state_p sp; {
-
- sp->st_next = stlist;
- stlist = sp;
-}
-#endif
-
-bmove(from,to,nbytes) register short *from,*to; register nbytes; {
-
- if (nbytes<=0)
- return;
- assert(sizeof(short)==2 && (nbytes&1)==0);
- nbytes>>=1;
- do
- *to++ = *from++;
- while (--nbytes);
-}
+++ /dev/null
-/* $Header$ */
-
-#define STONSTACK /* if defined state is saved in stackframe */
-
-typedef struct state {
- struct state *st_next; /* for linked list */
- int st_sh; /* stackheight */
- token_t st_fs[MAXFSTACK]; /* fakestack */
- int st_na; /* nallreg */
- int st_ar[MAXALLREG]; /* allreg[] */
- token_p st_ct; /* curtoken */
- result_t st_do[LONGESTPATTERN]; /* dollar[] */
- struct reginfo st_mr[NREGS]; /* machregs[] */
- int st_ne; /* nemlines */
- struct emline st_el[MAXEMLINES]; /* emlines[] */
- struct emline *st_em; /* emp */
- struct emline *st_se; /* saveemp */
- int st_tl; /* tokpatlen */
- int st_ns; /* nstab */
-} state_t,*state_p;
-
-#ifndef STONSTACK
-state_p savestatus();
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include <stdio.h>
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-#include "extern.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-string myalloc();
-unsigned codegen();
-
-match(tp,tep,optexp) register token_p tp; register set_p tep; {
- register bitno;
- token_p ct;
- result_t result;
-
- if (tp->t_token == -1) { /* register frame */
- bitno = tp->t_att[0].ar+1;
- if (tep->set_val[bitno>>4]&(1<<(bitno&017)))
- if (tep->set_val[0]&1 || getrefcount(tp->t_att[0].ar)<=1)
- goto oklabel;
- return(0);
- } else { /* token frame */
- bitno = tp->t_token+NREGS+1;
- if ((tep->set_val[bitno>>4]&(1<<(bitno&017)))==0)
- return(0);
- }
- oklabel:
- if (optexp==0)
- return(1);
- ct=curtoken;
- curtoken=tp;
- result=compute(&enodes[optexp]);
- curtoken=ct;
- return(result.e_v.e_con);
-}
-
-instance(instno,token) token_p token; {
- inst_p inp;
- int i;
- token_p tp;
- struct reginfo *rp;
- int regno;
- result_t result;
-
- if (instno==0) {
- token->t_token = 0;
- for(i=0;i<TOKENSIZE;i++)
- token->t_att[i].aw=0;
- return;
- }
- inp= &tokeninstances[instno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- tp= &fakestack[stackheight-inp->in_info[0]];
- if (inp->in_info[1]==0) {
- *token = *tp;
- } else {
- token->t_token= -1;
-#if MAXMEMBERS!=0
- if (tp->t_token == -1) {
- rp = &machregs[tp->t_att[0].ar];
- token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
- } else {
-#endif
- assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
- token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
-#if MAXMEMBERS!=0
- }
-#endif
- }
- return;
- case IN_RIDENT:
- token->t_token= -1;
- token->t_att[0].ar= inp->in_info[0];
- return;
-#ifdef REGVARS
- case IN_REGVAR:
- result=compute(&enodes[inp->in_info[0]]);
- i=isregvar((long)result.e_v.e_con);
- assert(i>0);
- token->t_token= -1;
- token->t_att[0].ar = i;
- return;
-#endif
- case IN_ALLOC:
- token->t_token= -1;
- regno=allreg[inp->in_info[0]];
-#if MAXMEMBERS!=0
- if (inp->in_info[1])
- regno=machregs[regno].r_members[inp->in_info[1]-1];
-#endif
- token->t_att[0].ar = regno;
- return;
- case IN_DESCR:
- token->t_token=inp->in_info[0];
- for (i=0;i<TOKENSIZE;i++)
- if (inp->in_info[i+1]==0) {
- assert(tokens[token->t_token].t_type[i]==0);
- token->t_att[i].aw=0;
- } else {
- result=compute(&enodes[inp->in_info[i+1]]);
- assert(tokens[token->t_token].t_type[i]==result.e_typ);
- if (result.e_typ==EV_INT)
- token->t_att[i].aw=result.e_v.e_con;
- else if (result.e_typ==EV_STR)
- token->t_att[i].as= result.e_v.e_str;
- else
- token->t_att[i].ar=result.e_v.e_reg;
- }
- return;
- }
-}
-
-cinstance(instno,token,tp,regno) token_p token,tp; {
- inst_p inp;
- int i;
- struct reginfo *rp;
- result_t result;
- int sh; /* saved stackheight */
-
- assert(instno!=0);
- inp= &tokeninstances[instno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- assert(inp->in_info[0] == 1);
- if (inp->in_info[1]==0) {
- *token = *tp;
- } else {
- token->t_token= -1;
-#if MAXMEMBERS!=0
- if (tp->t_token == -1) {
- rp = &machregs[tp->t_att[0].ar];
- token->t_att[0].ar=rp->r_members[inp->in_info[1]-1];
- } else {
-#endif
- assert(tokens[tp->t_token].t_type[inp->in_info[1]-1] == EV_REG);
- token->t_att[0].ar=tp->t_att[inp->in_info[1]-1].ar;
-#if MAXMEMBERS!=0
- }
-#endif
- }
- return;
- case IN_RIDENT:
- token->t_token= -1;
- token->t_att[0].ar= inp->in_info[0];
- return;
- case IN_ALLOC:
- token->t_token= -1;
- assert(inp->in_info[0]==0);
-#if MAXMEMBERS!=0
- if (inp->in_info[1])
- regno=machregs[regno].r_members[inp->in_info[1]-1];
-#endif
- token->t_att[0].ar = regno;
- return;
- case IN_DESCR:
- sh = stackheight;
- stackheight = tp - fakestack + 1;
- token->t_token=inp->in_info[0];
- for (i=0;i<TOKENSIZE;i++)
- if (inp->in_info[i+1]==0) {
- assert(tokens[token->t_token].t_type[i]==0);
- token->t_att[i].aw=0;
- } else {
- result=compute(&enodes[inp->in_info[i+1]]);
- assert(tokens[token->t_token].t_type[i]==result.e_typ);
- if (result.e_typ==EV_INT)
- token->t_att[i].aw=result.e_v.e_con;
- else if (result.e_typ==EV_STR)
- token->t_att[i].as= result.e_v.e_str;
- else
- token->t_att[i].ar=result.e_v.e_reg;
- }
- stackheight = sh;
- return;
- }
-}
-
-eqtoken(tp1,tp2) token_p tp1,tp2; {
- register i;
- register tkdef_p tdp;
-
- if (tp1->t_token!=tp2->t_token)
- return(0);
- if (tp1->t_token==0)
- return(1);
- if (tp1->t_token==-1) {
- if (tp1->t_att[0].ar!=tp2->t_att[0].ar)
- return(0);
- return(1);
- }
- tdp = &tokens[tp1->t_token];
- for (i=0;i<TOKENSIZE;i++)
- switch(tdp->t_type[i]) {
- default:
- return(1);
- case EV_INT:
- if (tp1->t_att[i].aw != tp2->t_att[i].aw)
- return(0);
- break;
- case EV_REG:
- if (tp1->t_att[i].ar != tp2->t_att[i].ar)
- return(0);
- break;
- case EV_STR:
- if (strcmp(tp1->t_att[i].as, tp2->t_att[i].as))
- return(0);
- break;
- }
- return(1);
-}
-
-distance(cindex) {
- register char *bp;
- register i;
- register token_p tp;
- int tokexp,tpl;
- int expsize,toksize,exact;
- int xsekt=0;
-
- bp = &coderules[cindex];
- switch( (*bp)&037 ) {
- default:
- return(stackheight==0 ? 0 : 100);
- case DO_MATCH:
- break;
- case DO_XXMATCH:
- xsekt++;
- case DO_XMATCH:
- xsekt++;
- break;
- }
- tpl= ((*bp++)>>5)&07;
- if (stackheight < tpl) {
- if (xsekt)
- return(MAXINT);
- tpl = stackheight;
- } else
- if (stackheight != tpl && xsekt==2)
- return(MAXINT);
- exact=0;
- tp= &fakestack[stackheight-1];
- for (i=0;i<tpl;i++,tp--) {
- getint(tokexp,bp);
- if (!match(tp, &machsets[tokexp], 0)) {
- if (xsekt)
- return(MAXINT);
- expsize = ssize(tokexp);
- toksize = tsize(tp);
- if (expsize>toksize)
- return(100);
- if (expsize<toksize)
- return(99-i);
- } else
- exact++;
- }
- if (exact==tpl) {
- if (xsekt)
- return(0);
- return(10-exact);
- }
- return(20-exact);
-}
-
-unsigned costcalc(cost) cost_t cost; {
- result_t result1,result2;
- extern unsigned cc1,cc2,cc3,cc4;
-
- result1=compute(&enodes[cost.c_size]);
- result2=compute(&enodes[cost.c_time]);
- assert(result1.e_typ == EV_INT && result2.e_typ == EV_INT);
- return(result1.e_v.e_con*cc1/cc2 + result2.e_v.e_con*cc3/cc4);
-}
-
-ssize(tokexpno) {
-
- return(machsets[tokexpno].set_size);
-}
-
-tsize(tp) register token_p tp; {
-
- if (tp->t_token==-1)
- return(machregs[tp->t_att[0].ar].r_size);
- return(tokens[tp->t_token].t_size);
-}
-
-#ifdef MAXSPLIT
-instsize(tinstno,tp) token_p tp; {
- inst_p inp;
- struct reginfo *rp;
-
- inp = &tokeninstances[tinstno];
- switch(inp->in_which) {
- default:
- assert(FALSE);
- case IN_COPY:
- assert(inp->in_info[0]==1);
-#if MAXMEMBERS!=0
- if (inp->in_info[1]==0)
-#endif
- return(tsize(tp));
-#if MAXMEMBERS!=0
- else {
- assert(tp->t_token == -1);
- rp = &machregs[tp->t_att[0].ar];
- return(machregs[rp->r_members[inp->in_info[1]-1]].r_size);
- }
-#endif
- case IN_RIDENT:
- return(machregs[inp->in_info[0]].r_size);
- case IN_ALLOC:
- assert(FALSE); /* cannot occur in splitting coercion */
- case IN_DESCR:
- return(tokens[inp->in_info[0]].t_size);
- }
-}
-#endif MAXSPLIT
-
-tref(tp,amount) register token_p tp; {
- register i;
- register tkdef_p tdp;
-
- if (tp->t_token==-1)
- chrefcount(tp->t_att[0].ar,amount,FALSE);
- else {
- tdp= &tokens[tp->t_token];
- for(i=0;i<TOKENSIZE;i++)
- if (tdp->t_type[i]==EV_REG)
- chrefcount(tp->t_att[i].ar,amount,FALSE);
- }
-}
-
-#define MAXSAVE 10
-
-#ifdef MAXSPLIT
-split(tp,ip,ply,toplevel) token_p tp; int *ip; {
- c2_p cp;
- token_t savestack[MAXSAVE];
- int ok;
- register i;
- int diff;
- token_p stp;
- int tpl;
-
- for (cp=c2coercs;cp< &c2coercs[NC2]; cp++) {
- if (!match(tp,&machsets[cp->c2_texpno],0))
- continue;
- ok=1;
- for (i=0; ok && i<cp->c2_nsplit;i++) {
- if (ip[i]==0)
- goto found;
- if (instsize(cp->c2_repl[i],tp) != ssize(ip[i]))
- ok=0;
- }
- goto found;
- }
- return(0);
-found:
- assert(stackheight+cp->c2_nsplit-1<MAXFSTACK);
- stp = &fakestack[stackheight-1];
- diff = stp - tp;
- assert(diff<=MAXSAVE);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i]; /* save top of stack */
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- codegen(&coderules[cp->c2_codep],ply,toplevel,MAXINT,0);
- tokpatlen = tpl;
- for (i=0;i<diff;i++) /* restore top of stack */
- fakestack[stackheight++] = savestack[i];
- return(cp->c2_nsplit);
-}
-#endif MAXSPLIT
-
-unsigned docoerc(tp,cp,ply,toplevel,forced) token_p tp; c3_p cp; {
- token_t savestack[MAXSAVE];
- token_p stp;
- int i,diff;
- unsigned cost;
- int tpl; /* saved tokpatlen */
-
- stp = &fakestack[stackheight-1];
- diff = stp -tp;
- assert(diff<=MAXSAVE);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i];
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- cost = codegen(&coderules[cp->c3_codep],ply,toplevel,MAXINT,forced);
- tokpatlen = tpl;
- for (i=0;i<diff;i++)
- fakestack[stackheight++] = savestack[i];
- nallreg = 0;
- return(cost);
-}
-
-unsigned stackupto(limit,ply,toplevel) token_p limit; {
- token_t savestack[MAXFSTACK];
- token_p stp;
- int i,diff;
- int tpl; /* saved tokpatlen */
- int nareg; /* saved nareg */
- int areg[MAXALLREG];
- c1_p cp;
- register token_p tp;
- unsigned totalcost=0;
- struct reginfo *rp,**rpp;
-
- for (tp=fakestack;tp<=limit;limit--) {
- for (cp=c1coercs;cp< &c1coercs[NC1]; cp++) {
- if (match(tp,&machsets[cp->c1_texpno],cp->c1_expr)) {
- if (cp->c1_prop>=0) {
- for (rpp=reglist[cp->c1_prop];
- (rp = *rpp)!=0 &&
- getrefcount(rp-machregs)!=0;
- rpp++)
- ;
- if (rp==0)
- continue;
- /* look for other possibility */
- }
- stp = &fakestack[stackheight-1];
- diff = stp -tp;
- assert(diff<=MAXFSTACK);
- for (i=1;i<=diff;i++)
- savestack[i-1] = tp[i];
- stackheight -= diff;
- tpl = tokpatlen;
- tokpatlen = 1;
- nareg = nallreg;
- for (i=0;i<nareg;i++)
- areg[i] = allreg[i];
- if (cp->c1_prop>=0) {
- nallreg=1; allreg[0] = rp-machregs;
- chrefcount(allreg[0],1,FALSE);
- } else
- nallreg=0;
- totalcost+= codegen(&coderules[cp->c1_codep],ply,toplevel,MAXINT,0);
- totalcost+= costcalc(cp->c1_cost);
- tokpatlen = tpl;
- for (i=0;i<diff;i++)
- fakestack[stackheight++] = savestack[i];
- nallreg=nareg;
- for (i=0;i<nareg;i++)
- allreg[i] = areg[i];
- goto contin;
- }
- }
- assert(FALSE);
- contin: ;
- }
- return(totalcost);
-}
-
-c3_p findcoerc(tp,tep) token_p tp; set_p tep; {
- register c3_p cp;
- token_t rtoken;
- register i;
- register struct reginfo **rpp;
-
- for (cp=c3coercs;cp< &c3coercs[NC3]; cp++) {
- if (tp!=(token_p) 0) {
- if (!match(tp,&machsets[cp->c3_texpno],0))
- continue;
- } else {
- if (cp->c3_texpno!=0)
- continue;
- }
- if (cp->c3_prop==0) { /* no reg needed */
- cinstance(cp->c3_repl,&rtoken,tp,0);
- if (match(&rtoken,tep,0))
- return(cp);
- } else {
- curreglist = (rl_p) myalloc(sizeof (rl_t));
- curreglist->rl_n = 0;
- for (rpp=reglist[cp->c3_prop];*rpp;rpp++) {
- i = *rpp - machregs;
- cinstance(cp->c3_repl,&rtoken,tp,i);
- if (match(&rtoken,tep,0))
- curreglist->rl_list[curreglist->rl_n++] = i;
- }
- if (curreglist->rl_n != 0)
- return(cp);
- myfree(curreglist);
- }
- }
- return(0); /* nothing found */
-}
-
-
-error(s,a1,a2,a3,a4) char *s; {
-
- fatal(s,a1,a2,a3,a4);
-}
-
-fatal(s,a1,a2,a3,a4) char *s; {
-
- fprintf(stderr,"Error: ");
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- out_finish();
- abort();
- exit(-1);
-}
-
-#ifndef NDEBUG
-badassertion(asstr,file,line) char *asstr, *file; {
-
- fatal("Assertion \"%s\" failed %s(%d)",asstr,file,line);
-}
-#endif
-
-max(a,b) {
-
- return(a>b ? a : b);
-}
+++ /dev/null
-/* $Header$ */
-
-#ifndef EM_WSIZE
-EM_WSIZE should be defined at this point
-#endif
-#ifndef EM_PSIZE
-EM_PSIZE should be defined at this point
-#endif
-#if EM_WSIZE>4 || EM_PSIZE>4
-Implementation will not be correct unless a long integer
-has more then 4 bytes of precision.
-#endif
-
-typedef char byte;
-typedef char * string;
-
-#if EM_WSIZE>2 || EM_PSIZE>2
-#define full long
-#else
-#define full int
-#endif
-
-#if EM_WSIZE>2
-#define word long
-#ifndef WRD_FMT
-#define WRD_FMT "%D"
-#endif WRD_FMT
-#else
-#define word int
-#ifndef WRD_FMT
-#define WRD_FMT "%d"
-#endif WRD_FMT
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "tables.h"
-#include "types.h"
-#include <cg_pattern.h>
-#include "data.h"
-#include "result.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-int stackheight = 0;
-token_t fakestack[MAXFSTACK];
-int nallreg = 0;
-int allreg[MAXALLREG];
-token_p curtoken = (token_p) 0;
-result_t dollar[LONGESTPATTERN];
-int nemlines =0;
-struct emline emlines[MAXEMLINES];
-struct emline *emp=emlines;
-struct emline *saveemp;
-int tokpatlen;
-rl_p curreglist;
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-CFLAGS=-O
-
-dl: dl.o
- cc -n -o dl dl.o
+++ /dev/null
-The interpreter contained here is tested under CP/M on a RC702 Z80
-microcomputer. Make it by typing `doas'.
-E.out files to interpret must be made with a special Pascal library
-using whatever means available, because the UNIX and CP/M conventions
-about end of file and end of line differ.
-Then the following sequence can be used to transmit it to CP/M.
-cv <e.out >file.cv
-dl file.cv file.hex
-< Transmission to file.hex under CP/M using pip >
-LOAD FILE
-
-The resulting file.com can be used as an argument to the interpreter.
-This implementation has been tested but is not guaranteed to be complete.
-Simple UNIX-system calls have been implemented but anything except
-terminal I/O has not been thoroughly tested.
-Please send any errors in the implementation to
-Hans van Staveren
-Vrije Universiteit
-Wiskundig Seminarium
-De Boelelaan 1081
-1081 HV Amsterdam
-Holland
-..!decvax!mcvax!vu44!sater
+++ /dev/null
- .data
-! Set of variables
-
-big: .byte 0
- .byte 0
- .byte 0x40
- .byte 24 ! 2^23
-negfrac:.space 1
-negexp: .space 1
-begzero:
-nd: .space 2
-fl: .space 6
- exp=fl+4
-eexp: .space 2
-flexp: .space 4
-exp5: .space 4
-endzero:
-ten: .byte 0
- .byte 0
- .byte 0x50
- .byte 4 ! 10
-dig: .byte 0
- .byte 0
-fildig: .byte 0 ! here a number from 0 to 31 will be converted flt.
- .byte 7
-bexp: .space 2
-
- .text
-atof: ! entry with stringpointer in hl
- ! exit with pointer to float in hl
- push ix
- push iy
- push bc
- push de
- push af
- ld b,1
-1:
- ld a,(hl)
- inc hl
- cp ' '
- jr z,1b
- cp '-'
- jr nz,1f
- ld b,-1
- jr 2f
-1: cp '+'
- jr z,2f
- dec hl
-2: ld a,b
- ld (negfrac),a
- xor a
- ld de,begzero
- ld b,endzero-begzero
-1: ld (de),a
- inc de
- djnz 1b
-1: ld a,(hl)
- inc hl
- sub '0'
- jr c,1f
- cp 10
- jr nc,1f
- ld (fildig),a
- call cmpbigfl
- jr z,2f
- call mulandadd
- jr 3f
-2: ld de,(exp)
- inc de
- ld (exp),de
-3: ld de,(nd)
- inc de
- ld (nd),de
- jr 1b
-1: cp '.'-'0'
- jr nz,4f
-1: ld a,(hl)
- inc hl
- sub '0'
- jr c,4f
- cp 10
- jr nc,4f
- ld (fildig),a
- call cmpbigfl
- jr z,2f
- call mulandadd
- ld de,(exp)
- dec de
- ld (exp),de
-2: ld de,(nd)
- inc de
- ld (nd),de
- jr 1b
-4:
- ld b,1
- cp 'E'-'0'
- jr z,1f
- cp 'e'-'0'
- jr nz,5f
-1: ld a,(hl)
- inc hl
- cp '+'
- jr z,1f
- cp '-'
- jr nz,2f
- ld b,-1
- jr 1f
-2: dec hl
-1: ld a,b
- ld (negexp),a
- exx
- xor a
- ld h,a
- ld l,a
- ld b,a
- ld d,a
- ld e,a
- exx
-1: ld a,(hl)
- inc hl
- sub '0'
- jr c,1f
- cp 10
- jr nc,1f
- exx
- ld c,a
- add hl,hl
- add hl,hl
- add hl,de
- add hl,hl
- add hl,bc
- ld d,h
- ld e,l
- exx
- jr 1b
-1: exx
- ld hl,negexp
- or a
- bit 7,(hl)
- ld hl,(exp)
- jr z,1f
- sbc hl,de
- jr 2f
-1: add hl,de
-2: ld (exp),hl
- exx
-5: ld a,1
- ld de,(exp)
- push de
- bit 7,d
- jr z,1f
- neg
- ld hl,0
- or a
- sbc hl,de
- ex de,hl
-1: ld (negexp),a
- ld (exp),de
- pop de
- ld hl,(nd)
- add hl,de
- ld de,-33 ! -LOGHUGE ?
- xor a
- sbc hl,de
- jp p,1f
- ld hl,fl
- ld b,6
-2: ld (hl),a
- inc hl
- djnz 2b
-1: ld hl,0x0140 ! 1.0
- ld (flexp+2),hl
- ld hl,0x0350 ! 5.0
- ld (exp5+2),hl
- ld hl,(exp)
- ld (bexp),hl
-1: bit 0,l
- jr z,2f
- call xflt
- .word flexp,exp5,fpmult,4,flexp
-2: sra h
- rr l
- ld a,h
- or l
- jr z,3f
- call xflt
- .word exp5,exp5,fpmult,4,exp5
- jr 1b
-3: ld hl,negexp
- ld a,(bexp)
- bit 7,(hl)
- jr z,1f
- call xflt
- .word flexp,fl,fpdiv,4,fl
- neg
- jr 2f
-1: call xflt
- .word flexp,fl,fpmult,4,fl
-2: ld b,a
- ld a,(fl+3)
- add a,b
- ld (fl+3),a
- ld a,(negfrac)
- bit 7,a
- jr z,1f
- call xflt
- .word fl,fl,fpcomp,4,fl
-1: call xflt
- .word fl,fl,fpnorm,4,fl
- ld hl,fl
- pop af
- pop de
- pop bc
- pop iy
- pop ix
- ret
-
-cmpbigfl:
- call xflt
- .word big,fl,fpcmf,0
- ld a,(fpac+1)
- bit 7,a
- ret
-mulandadd:
- call xflt
- .word fl,ten,fpmult,4,fl
- ld a,7
- ld (fildig+1),a
- call xflt
- .word dig,dig,fpnorm,4,dig
- call xflt
- .word fl,dig,fpadd,4,fl
- ret
-
-xflt:
- ex (sp),iy
- push af
- push bc
- push de
- push hl
- ld h,(iy+1)
- ld l,(iy+0)
- ld de,fpac
- ld bc,4
- ldir
- ld h,(iy+3)
- ld l,(iy+2)
- ld de,fpop
- ld bc,4
- ldir
- push iy
- ld hl,1f
- push hl
- ld h,(iy+5)
- ld l,(iy+4)
- jp (hl)
-1: pop iy
- ld b,(iy+7)
- ld c,(iy+6)
- ld a,b
- or c
- jr z,1f
- inc iy
- inc iy
- ld hl,fpac
- ld d,(iy+7)
- ld e,(iy+6)
- ldir
-1: push iy
- pop hl
- ld de,8
- add hl,de
- push hl
- pop iy
- pop hl
- pop de
- pop bc
- pop af
- ex (sp),iy
- ret
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include <stdio.h>
-
-unsigned memaddr = 0x100;
-
-main() {
- char buf[256];
- register i,len;
-
- while((len=read(0,buf,sizeof(buf))) > 0) {
- putw(memaddr,stdout);
- putw(0,stdout);
- putw(len,stdout);
- memaddr += len;
- for(i=0;i<len;i++)
- putc(buf[i],stdout);
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include <sgtty.h>
-#include <stdio.h>
-#include <assert.h>
-
-struct sgttyb tty;
-
-#define DATTYPE 0
-#define EOFTYPE 1
-#define SEGTYPE 2
-#define PCTYPE 3
-
-#define MAXBYTE 32
-
-int check;
-int echo;
-int istty;
-int bytecount;
-int ttyfd;
-
-char *progname;
-
-char hex[] = "0123456789ABCDEF";
-
-main(argc,argv) char **argv; {
- register nd,pc,sg,osg,first;
- register char *s;
- int uid;
-
- progname = argv[0];
- if (argc > 3)
- fatal("usage: %s [object [tty]]\n",argv[0]);
- s = "a.out";
- if (argc >= 2)
- s = argv[1];
- if (freopen(s,"r",stdin) == NULL)
- fatal("can't open %s",s);
- s = "/dev/tty05";
- if (argc >= 3)
- s = argv[2];
- if ((ttyfd = open(s,2)) < 0)
- if ((ttyfd = creat(s,0666)) < 0)
- fatal("can't open %s",s);
- if (gtty(ttyfd,&tty) == 0) {
- echo++;
- istty++;
- tty.sg_ispeed = tty.sg_ospeed = B2400;
- tty.sg_flags = RAW;
- stty(ttyfd,&tty);
- } else {
- freopen(s,"w",stdout);
- }
- first = 1; osg = 0;
- uid = getuid();
- lock(1);
- for (;;) {
- pc = get2c(stdin);
- if (feof(stdin))
- break;
- sg = get2c(stdin);
- nd = get2c(stdin);
- if (first) {
- put('L'); reply();
- put('S'); reply();
- first = 0;
- }
- if (sg != osg) {
- segment(sg);
- osg = sg;
- }
- while (nd > MAXBYTE) {
- data(MAXBYTE,pc);
- nd -= MAXBYTE;
- pc += MAXBYTE;
- }
- if (nd > 0)
- data(nd,pc);
- assert(feof(stdin) == 0);
- }
- if (first == 0)
- eof();
-/* lock(0); */
-/* setuid(uid); */
-/* if (echo) */
-/* for (;;) */
-/* reply(); */
-}
-
-segment(sg) {
-
- newline(2,0,SEGTYPE);
- word(sg);
- endline();
-}
-
-startad(pc) {
-
- newline(4,0,PCTYPE);
- word(0);
- word(pc);
- endline();
-}
-
-data(nd,pc) {
-
- newline(nd,pc,DATTYPE);
- do
- byte(getc(stdin));
- while (--nd);
- endline();
-}
-
-eof() {
-
- newline(0,0,EOFTYPE);
- byte(0xFF);
- put('\n');
-}
-
-newline(n,pc,typ) {
-
- check = 0;
- bytecount = n+5;
- put('\n'); /* added instruction */
- put(':');
- byte(n);
- word(pc);
- byte(typ);
-}
-
-endline() {
-
- byte(-check);
- assert(bytecount == 0);
- assert(check == 0);
-}
-
-word(w) {
-
- byte(w>>8);
- byte(w);
-}
-
-byte(b) {
-
- check += b;
- --bytecount;
- put(hex[(b>>4) & 017]);
- put(hex[b & 017]);
-}
-
-put(c) {
-
- if (istty)
- write(ttyfd,&c,1);
- else
- putchar(c);
-}
-
-reply() {
- register i;
- int c;
-
- if (echo == 0)
- return;
- i = read(ttyfd,&c,1);
- assert(i > 0);
- write(1,&c,1);
-}
-
-get2c(f) FILE *f; {
- register c;
-
- c = getc(f);
- return((getc(f) << 8) | c);
-}
-
-fatal(s,a) {
-
- fprintf(stderr,"%s: ",progname);
- fprintf(stderr,s,a);
- fprintf(stderr,"\n");
- exit(-1);
-}
+++ /dev/null
-/usr/em/mach/z80/as/as -d em.s atof.s fpp.s mli4.s dvu4.s dvi4.s eb.s >em.list
-dl a.out int.hex
-dosort int.hex
+++ /dev/null
-case $# in
-1) ;;
-*) echo "usage $0 file";exit ;;
-esac
-head -1 $1>$$.head
-tail -1 $1>$$.tail
-tail +2 $1|sort +0.3|tail +2>$$.middle
-cat $$.head $$.middle $$.tail >$1
-rm $$.head $$.middle $$.tail
+++ /dev/null
-.dvi4:
- pop hl
- ld (retaddr),hl
- xor a
- ld (.flag1),a
- ld (.flag2),a
- ld ix,0
- add ix,sp
- ld b,(ix+7) ! dividend
- bit 7,b
- jr z,1f
- ld c,(ix+6)
- ld d,(ix+5)
- ld e,(ix+4)
- call .negbd
- ld (ix+7),b
- ld (ix+6),c
- ld (ix+5),d
- ld (ix+4),e
- ld a,1
- ld (.flag1),a
-1:
- ld b,(ix+3)
- bit 7,b
- jr z,2f
- call .negst
- ld a,1
- ld (.flag2),a
-2:
- call .dvu4
- ld a,(.flag1)
- or a
- jr z,3f
- call .negbd
-3:
- ld (.savebc),bc
- ld (.savede),de
- ld a,(.flag2)
- ld b,a
- ld a,(.flag1)
- xor b
- jr z,4f
- call .negst
-4:
- ld bc,(.savebc)
- ld de,(.savede)
- ld hl,(retaddr)
- jp (hl)
-.negbd:
- xor a
- ld h,a
- ld l,a
- sbc hl,de
- ex de,hl
- ld h,a
- ld l,a
- sbc hl,bc
- ld b,h
- ld c,l
- ret
-.negst:
- pop iy
- pop de
- pop bc
- call .negbd
- push bc
- push de
- jp (iy)
-.data
- .flag1: .byte 0
- .flag2: .byte 0
- retaddr:.word 0
- .savebc: .word 0
- .savede: .word 0
+++ /dev/null
-.define .dvu4
-
-! 4-byte divide routine for z80
-! parameters:
-! stack: divisor
-! dividend
-! stack: quotient (out)
-! bc de: remainder (out) (high part in bc)
-
-
-
-! a n-byte divide may be implemented
-! using 2 (virtual) registers:
-! - a n-byte register containing
-! the divisor
-! - a 2n-byte shiftregister (VSR)
-!
-! Initially, the VSR contains the dividend
-! in its low (right) n bytes and zeroes in its
-! high n bytes. The dividend is shifted
-! left into a "window" bit by bit. After
-! each shift, the contents of the window
-! is compared with the divisor. If it is
-! higher or equal, the divisor is subtracted from
-! it and a "1" bit is inserted in the
-! VSR from the right side; else a "0" bit
-! is inserted. These bits are shifted left
-! too during subsequent iterations.
-! At the end, the rightmost part of VSR
-! contains the quotient.
-! For n=4, we need 2*4+4 = 12 bytes of
-! registers. Unfortunately we only have
-! 5 2-byte registers on the z80
-! (bc,de,hl,ix and iy). Therefore we use
-! an overlay technique for the rightmost
-! 4 bytes of the VSR. The 32 iterations
-! are split up into two groups: during
-! the first 16 iterations we use the high
-! order 16 bits of the dividend; during
-! the last 16 iterations we use the
-! low order 16 bits.
-! register allocation:
-! VSR iy hl ix
-! divisor -de bc
-.dvu4:
- ! initialization
- pop hl ! save return address
- ld (.retaddr),hl
- pop bc ! low part (2 bytes)
- ! of divisor in bc
- xor a ! clear carry, a := 0
- ld h,a ! hl := 0
- ld l,a
- ld (.flag),a ! first pass main loop
- pop de ! high part divisor
- sbc hl,de ! inverse of high part
- ex de,hl ! of divisor in de
- pop hl ! save low part of
- ! dividend in memory
- ld (.low),hl ! used during second
- ! iteration over main loop
- pop ix ! high part of dividend
- push iy ! save LB
- ld h,a ! hl := 0
- ld l,a
- ld iy,0 ! now the VSR is initialized
-
- ! main loop, done twice
-1:
- ld a,16
- ! sub-loop, done 16 times
-2:
- add iy,iy ! shift VSR left
- add ix,ix
- adc hl,hl
- jp nc,3f
- inc iy
-3:
- or a ! subtract divisor from
- ! window (iy hl)
- ld (.iysave),iy
- sbc hl,bc
- jr nc,4f ! decrement iy if there
- ! was no borrow
- dec iy
-4:
- add iy,de ! there is no "sbc iy,ss"
- ! on the z80, so de was
- ! inverted during init.
- inc ix
- ! see if the result is non-negative,
- ! otherwise undo the subtract.
- ! note that this uncooperating machine
- ! does not set its S -or Z flag after
- ! a 16-bit add.
- ex (sp),iy ! does anyone see a better
- ex (sp),hl ! solution ???
- bit 7,h
- ex (sp),hl
- ex (sp),iy
- jp z,5f
- ! undo the subtract
- add hl,bc
- ld iy,(.iysave)
- dec ix
-5:
- dec a
- jr nz,2b
- ld a,(.flag) ! see if this was first or
- ! second iteration of main loop
- or a ! 0=first, 1=second
- jr nz,6f
- inc a ! a := 1
- ld (.flag),a ! flag := 1
- ld (.result),ix ! save high part of result
- ld ix,(.low) ! initialize second
- ! iteration, ix := low
- ! part of dividend
- jr 1b
-6:
- ! clean up
- push iy ! transfer remainder
- pop bc ! from iy-hl to bc-de
- ex de,hl
- pop iy ! restore LB
- ld hl,(.result) ! high part of result
- push hl
- push ix ! low part of result
- ld hl,(.retaddr)
- jp (hl) ! return
-
-.data
-.flag: .byte 0
-.low: .word 0
-.iysave: .word 0
-.retaddr: .word 0
-.result: .word 0
+++ /dev/null
- .bss
-eb:
+++ /dev/null
-#
-! This program is an EM interpreter for the Z80.
-! Register pair bc is used to hold lb.
-! Register ix is used to hold the EM program counter.
-! The interpreter assumes 16-bit words and 16-bit pointers.
-
-! #define CPM1 1
-
-! Definitions:
- zone = 8 ! size of subroutine call block (address + old lb)
- bdos = 5 ! standard entry into I/O-routines
- boot = 0
- fcb = 0x5c ! file descriptor of EM-1 file (5C hex)
-
- reset=0
- delete=19
- makefile=22
- close=16
- readconsole = 10
- writeconsole = 2
- open = 15
- read = 20
- write = 21
- setdma = 26
- printstring = 9
- seqread = 20
- randomread = 33
- seqwrite = 21
- randomwrite = 34
- consolein = 1
- diconio = 6
- RAW=0 !0 for cooked,1 for raw io
-
- timebuf=0xFFDE
-
- b_lolp = 176
- b_loln = 179
- b_lof = 161
- b_loi = 168
- b_lal = 130
- b_lil = 146
- b_stlm = 227
- b_stf = 214
- b_sti = 218
- b_inl = 112
- b_cal = 63
- b_asp = 44
- b_zrl = 249
-
- EARRAY = 0
- ERANGE = 1
- EILLINS=18
- EILLSIZE=19
- ECASE=20
- EMON=25
-
-!--------------------------- Initialization ---------------------------
-
- .base 0x100
-
- jp init ! 3 byte instruction.
-
-!------------------------- MAIN DISPATCH ------------------------------
-!
-! must be put in a suitable place in memory to reduce memory usage
-! must be put on a page boundary
-
-
-dispat = . - 3 ! base of dispatch table
-! .byte loc.0 /256
-! .byte loc.1 /256
-! .byte loc.2 /256
- .byte loc.3 /256
- .byte loc.4 /256
- .byte loc.5 /256
- .byte loc.6 /256
- .byte loc.7 /256
- .byte loc.8 /256
- .byte loc.9 /256
- .byte loc.10 /256
- .byte loc.11 /256
- .byte loc.12 /256
- .byte loc.13 /256
- .byte loc.14 /256
- .byte loc.15 /256
- .byte loc.16 /256
- .byte loc.17 /256
- .byte loc.18 /256
- .byte loc.19 /256
- .byte loc.20 /256
- .byte loc.21 /256
- .byte loc.22 /256
- .byte loc.23 /256
- .byte loc.24 /256
- .byte loc.25 /256
- .byte loc.26 /256
- .byte loc.27 /256
- .byte loc.28 /256
- .byte loc.29 /256
- .byte loc.30 /256
- .byte loc.31 /256
- .byte loc.32 /256
- .byte loc.33 /256
- .byte aar.2 /256
- .byte adf.s0 /256
- .byte adi.2 /256
- .byte adi.4 /256
- .byte adp.l /256
- .byte adp.1 /256
- .byte adp.2 /256
- .byte adp.s0 /256
- .byte adp.sm1 /256
- .byte ads.2 /256
- .byte and.2 /256
- .byte asp.2 /256
- .byte asp.4 /256
- .byte asp.6 /256
- .byte asp.8 /256
- .byte asp.10 /256
- .byte asp.w0 /256
- .byte beq.l /256
- .byte beq.s0 /256
- .byte bge.s0 /256
- .byte bgt.s0 /256
- .byte ble.s0 /256
- .byte blm.s0 /256
- .byte blt.s0 /256
- .byte bne.s0 /256
- .byte bra.l /256
- .byte bra.sm1 /256
- .byte bra.sm2 /256
- .byte bra.s0 /256
- .byte bra.s1 /256
- .byte cal.1 /256
- .byte cal.2 /256
- .byte cal.3 /256
- .byte cal.4 /256
- .byte cal.5 /256
- .byte cal.6 /256
- .byte cal.7 /256
- .byte cal.8 /256
- .byte cal.9 /256
- .byte cal.10 /256
- .byte cal.11 /256
- .byte cal.12 /256
- .byte cal.13 /256
- .byte cal.14 /256
- .byte cal.15 /256
- .byte cal.16 /256
- .byte cal.17 /256
- .byte cal.18 /256
- .byte cal.19 /256
- .byte cal.20 /256
- .byte cal.21 /256
- .byte cal.22 /256
- .byte cal.23 /256
- .byte cal.24 /256
- .byte cal.25 /256
- .byte cal.26 /256
- .byte cal.27 /256
- .byte cal.28 /256
- .byte cal.s0 /256
- .byte cff.z /256
- .byte cif.z /256
- .byte cii.z /256
- .byte cmf.s0 /256
- .byte cmi.2 /256
- .byte cmi.4 /256
- .byte cmp.z /256
- .byte cms.s0 /256
- .byte csa.2 /256
- .byte csb.2 /256
- .byte dec.z /256
- .byte dee.w0 /256
- .byte del.wm1 /256
- .byte dup.2 /256
- .byte dvf.s0 /256
- .byte dvi.2 /256
- .byte fil.l /256
- .byte inc.z /256
- .byte ine.l /256
- .byte ine.w0 /256
- .byte inl.m2 /256
- .byte inl.m4 /256
- .byte inl.m6 /256
- .byte inl.wm1 /256
- .byte inn.s0 /256
- .byte ior.2 /256
- .byte ior.s0 /256
- .byte lae.l /256
- .byte lae.w0 /256
- .byte lae.w1 /256
- .byte lae.w2 /256
- .byte lae.w3 /256
- .byte lae.w4 /256
- .byte lae.w5 /256
- .byte lae.w6 /256
- .byte lal.p /256
- .byte lal.n /256
- .byte lal.0 /256
- .byte lal.m1 /256
- .byte lal.w0 /256
- .byte lal.wm1 /256
- .byte lal.wm2 /256
- .byte lar.2 /256
- .byte ldc.0 /256
- .byte lde.l /256
- .byte lde.w0 /256
- .byte ldl.0 /256
- .byte ldl.wm1 /256
- .byte lfr.2 /256
- .byte lfr.4 /256
- .byte lfr.s0 /256
- .byte lil.wm1 /256
- .byte lil.w0 /256
- .byte lil.0 /256
- .byte lil.2 /256
- .byte lin.l /256
- .byte lin.s0 /256
- .byte lni.z /256
- .byte loc.l /256
- .byte loc.m1 /256
- .byte loc.s0 /256
- .byte loc.sm1 /256
- .byte loe.l /256
- .byte loe.w0 /256
- .byte loe.w1 /256
- .byte loe.w2 /256
- .byte loe.w3 /256
- .byte loe.w4 /256
- .byte lof.l /256
- .byte lof.2 /256
- .byte lof.4 /256
- .byte lof.6 /256
- .byte lof.8 /256
- .byte lof.s0 /256
- .byte loi.l /256
- .byte loi.1 /256
- .byte loi.2 /256
- .byte loi.4 /256
- .byte loi.6 /256
- .byte loi.8 /256
- .byte loi.s0 /256
- .byte lol.p /256
- .byte lol.n /256
- .byte lol.0 /256
- .byte lol.2 /256
- .byte lol.4 /256
- .byte lol.6 /256
- .byte lol.m2 /256
- .byte lol.m4 /256
- .byte lol.m6 /256
- .byte lol.m8 /256
- .byte lol.m10 /256
- .byte lol.m12 /256
- .byte lol.m14 /256
- .byte lol.m16 /256
- .byte lol.w0 /256
- .byte lol.wm1 /256
- .byte lxa.1 /256
- .byte lxl.1 /256
- .byte lxl.2 /256
- .byte mlf.s0 /256
- .byte mli.2 /256
- .byte mli.4 /256
- .byte rck.2 /256
- .byte ret.0 /256
- .byte ret.2 /256
- .byte ret.s0 /256
- .byte rmi.2 /256
- .byte sar.2 /256
- .byte sbf.s0 /256
- .byte sbi.2 /256
- .byte sbi.4 /256
- .byte sdl.wm1 /256
- .byte set.s0 /256
- .byte sil.wm1 /256
- .byte sil.w0 /256
- .byte sli.2 /256
- .byte ste.l /256
- .byte ste.w0 /256
- .byte ste.w1 /256
- .byte ste.w2 /256
- .byte stf.l /256
- .byte stf.2 /256
- .byte stf.4 /256
- .byte stf.s0 /256
- .byte sti.1 /256
- .byte sti.2 /256
- .byte sti.4 /256
- .byte sti.6 /256
- .byte sti.8 /256
- .byte sti.s0 /256
- .byte stl.p /256
- .byte stl.n /256
- .byte stl.p0 /256
- .byte stl.p2 /256
- .byte stl.m2 /256
- .byte stl.m4 /256
- .byte stl.m6 /256
- .byte stl.m8 /256
- .byte stl.m10 /256
- .byte stl.wm1 /256
- .byte teq.z /256
- .byte tgt.z /256
- .byte tlt.z /256
- .byte tne.z /256
- .byte zeq.l /256
- .byte zeq.s0 /256
- .byte zeq.s1 /256
- .byte zer.s0 /256
- .byte zge.s0 /256
- .byte zgt.s0 /256
- .byte zle.s0 /256
- .byte zlt.s0 /256
- .byte zne.s0 /256
- .byte zne.sm1 /256
- .byte zre.l /256
- .byte zre.w0 /256
- .byte zrl.m2 /256
- .byte zrl.m4 /256
- .byte zrl.wm1 /256
- .byte zrl.n /256
- .byte loop1 /256
- .byte loop2 /256
-
- .errnz .-dispat-256
-
- .byte loc.0 %256
- .byte loc.1 %256
- .byte loc.2 %256
- .byte loc.3 %256
- .byte loc.4 %256
- .byte loc.5 %256
- .byte loc.6 %256
- .byte loc.7 %256
- .byte loc.8 %256
- .byte loc.9 %256
- .byte loc.10 %256
- .byte loc.11 %256
- .byte loc.12 %256
- .byte loc.13 %256
- .byte loc.14 %256
- .byte loc.15 %256
- .byte loc.16 %256
- .byte loc.17 %256
- .byte loc.18 %256
- .byte loc.19 %256
- .byte loc.20 %256
- .byte loc.21 %256
- .byte loc.22 %256
- .byte loc.23 %256
- .byte loc.24 %256
- .byte loc.25 %256
- .byte loc.26 %256
- .byte loc.27 %256
- .byte loc.28 %256
- .byte loc.29 %256
- .byte loc.30 %256
- .byte loc.31 %256
- .byte loc.32 %256
- .byte loc.33 %256
- .byte aar.2 %256
- .byte adf.s0 %256
- .byte adi.2 %256
- .byte adi.4 %256
- .byte adp.l %256
- .byte adp.1 %256
- .byte adp.2 %256
- .byte adp.s0 %256
- .byte adp.sm1 %256
- .byte ads.2 %256
- .byte and.2 %256
- .byte asp.2 %256
- .byte asp.4 %256
- .byte asp.6 %256
- .byte asp.8 %256
- .byte asp.10 %256
- .byte asp.w0 %256
- .byte beq.l %256
- .byte beq.s0 %256
- .byte bge.s0 %256
- .byte bgt.s0 %256
- .byte ble.s0 %256
- .byte blm.s0 %256
- .byte blt.s0 %256
- .byte bne.s0 %256
- .byte bra.l %256
- .byte bra.sm1 %256
- .byte bra.sm2 %256
- .byte bra.s0 %256
- .byte bra.s1 %256
- .byte cal.1 %256
- .byte cal.2 %256
- .byte cal.3 %256
- .byte cal.4 %256
- .byte cal.5 %256
- .byte cal.6 %256
- .byte cal.7 %256
- .byte cal.8 %256
- .byte cal.9 %256
- .byte cal.10 %256
- .byte cal.11 %256
- .byte cal.12 %256
- .byte cal.13 %256
- .byte cal.14 %256
- .byte cal.15 %256
- .byte cal.16 %256
- .byte cal.17 %256
- .byte cal.18 %256
- .byte cal.19 %256
- .byte cal.20 %256
- .byte cal.21 %256
- .byte cal.22 %256
- .byte cal.23 %256
- .byte cal.24 %256
- .byte cal.25 %256
- .byte cal.26 %256
- .byte cal.27 %256
- .byte cal.28 %256
- .byte cal.s0 %256
- .byte cff.z %256
- .byte cif.z %256
- .byte cii.z %256
- .byte cmf.s0 %256
- .byte cmi.2 %256
- .byte cmi.4 %256
- .byte cmp.z %256
- .byte cms.s0 %256
- .byte csa.2 %256
- .byte csb.2 %256
- .byte dec.z %256
- .byte dee.w0 %256
- .byte del.wm1 %256
- .byte dup.2 %256
- .byte dvf.s0 %256
- .byte dvi.2 %256
- .byte fil.l %256
- .byte inc.z %256
- .byte ine.l %256
- .byte ine.w0 %256
- .byte inl.m2 %256
- .byte inl.m4 %256
- .byte inl.m6 %256
- .byte inl.wm1 %256
- .byte inn.s0 %256
- .byte ior.2 %256
- .byte ior.s0 %256
- .byte lae.l %256
- .byte lae.w0 %256
- .byte lae.w1 %256
- .byte lae.w2 %256
- .byte lae.w3 %256
- .byte lae.w4 %256
- .byte lae.w5 %256
- .byte lae.w6 %256
- .byte lal.p %256
- .byte lal.n %256
- .byte lal.0 %256
- .byte lal.m1 %256
- .byte lal.w0 %256
- .byte lal.wm1 %256
- .byte lal.wm2 %256
- .byte lar.2 %256
- .byte ldc.0 %256
- .byte lde.l %256
- .byte lde.w0 %256
- .byte ldl.0 %256
- .byte ldl.wm1 %256
- .byte lfr.2 %256
- .byte lfr.4 %256
- .byte lfr.s0 %256
- .byte lil.wm1 %256
- .byte lil.w0 %256
- .byte lil.0 %256
- .byte lil.2 %256
- .byte lin.l %256
- .byte lin.s0 %256
- .byte lni.z %256
- .byte loc.l %256
- .byte loc.m1 %256
- .byte loc.s0 %256
- .byte loc.sm1 %256
- .byte loe.l %256
- .byte loe.w0 %256
- .byte loe.w1 %256
- .byte loe.w2 %256
- .byte loe.w3 %256
- .byte loe.w4 %256
- .byte lof.l %256
- .byte lof.2 %256
- .byte lof.4 %256
- .byte lof.6 %256
- .byte lof.8 %256
- .byte lof.s0 %256
- .byte loi.l %256
- .byte loi.1 %256
- .byte loi.2 %256
- .byte loi.4 %256
- .byte loi.6 %256
- .byte loi.8 %256
- .byte loi.s0 %256
- .byte lol.p %256
- .byte lol.n %256
- .byte lol.0 %256
- .byte lol.2 %256
- .byte lol.4 %256
- .byte lol.6 %256
- .byte lol.m2 %256
- .byte lol.m4 %256
- .byte lol.m6 %256
- .byte lol.m8 %256
- .byte lol.m10 %256
- .byte lol.m12 %256
- .byte lol.m14 %256
- .byte lol.m16 %256
- .byte lol.w0 %256
- .byte lol.wm1 %256
- .byte lxa.1 %256
- .byte lxl.1 %256
- .byte lxl.2 %256
- .byte mlf.s0 %256
- .byte mli.2 %256
- .byte mli.4 %256
- .byte rck.2 %256
- .byte ret.0 %256
- .byte ret.2 %256
- .byte ret.s0 %256
- .byte rmi.2 %256
- .byte sar.2 %256
- .byte sbf.s0 %256
- .byte sbi.2 %256
- .byte sbi.4 %256
- .byte sdl.wm1 %256
- .byte set.s0 %256
- .byte sil.wm1 %256
- .byte sil.w0 %256
- .byte sli.2 %256
- .byte ste.l %256
- .byte ste.w0 %256
- .byte ste.w1 %256
- .byte ste.w2 %256
- .byte stf.l %256
- .byte stf.2 %256
- .byte stf.4 %256
- .byte stf.s0 %256
- .byte sti.1 %256
- .byte sti.2 %256
- .byte sti.4 %256
- .byte sti.6 %256
- .byte sti.8 %256
- .byte sti.s0 %256
- .byte stl.p %256
- .byte stl.n %256
- .byte stl.p0 %256
- .byte stl.p2 %256
- .byte stl.m2 %256
- .byte stl.m4 %256
- .byte stl.m6 %256
- .byte stl.m8 %256
- .byte stl.m10 %256
- .byte stl.wm1 %256
- .byte teq.z %256
- .byte tgt.z %256
- .byte tlt.z %256
- .byte tne.z %256
- .byte zeq.l %256
- .byte zeq.s0 %256
- .byte zeq.s1 %256
- .byte zer.s0 %256
- .byte zge.s0 %256
- .byte zgt.s0 %256
- .byte zle.s0 %256
- .byte zlt.s0 %256
- .byte zne.s0 %256
- .byte zne.sm1 %256
- .byte zre.l %256
- .byte zre.w0 %256
- .byte zrl.m2 %256
- .byte zrl.m4 %256
- .byte zrl.wm1 %256
- .byte zrl.n %256
- .byte loop1 %256
- .byte loop2 %256
-
- .errnz .-dispat-512
-
-!----------------- END OF MAIN DISPATCH -------------------------------
-
-init:
- ld sp,(bdos+1) ! address of fbase
- ld hl,dispat
- ld (hl),loc.0/256
- inc hl
- ld (hl),loc.1/256
- inc hl
- ld (hl),loc.2/256
- call uxinit
-warmstart:
- ld sp,(bdos+1) ! address of fbase
- call makeargv
- ld de,0x80
- ld c,setdma
- call bdos
- ld c,open
- ld de,fcb
- call bdos
- inc a
- jr z,bademfile
- ld c,read
- ld de,fcb
- call bdos
- or a
- jr nz,bademfile ! no file
- ld de,header
- ld hl,0x90 ! start of 2nd half of header
- ld bc,10 ! we copy only first 5 words
- ldir
- ld de,(ntext) ! size of program text in bytes
- ld hl,0
- sbc hl,de
- add hl,sp
- ld sp,hl ! save space for program
- ld (pb),hl ! set procedure base
- ld a,0xa0
- ld (nextp),a
- ld de,(ntext)
- xor a
- ld h,a
- ld l,a
- sbc hl,de
- ex de,hl
- ld h,a
- ld l,a
- add hl,sp
-1: call getb
- ld (hl),c
- inc hl
- inc e
- jr nz,1b
- inc d
- jr nz,1b
- ! now program text has been read,so start read-
- ld iy,0 ! ing data descriptors, (nextp) (was hl) is
- ld ix,eb+eb%2 ! pointer into DMA,ix is pointer into global
- ! data area,iy is #bytes pushed in last instr (used for repeat)
-rddata: ld hl,(ndata)
- ld a,h
- or l
- jr z,prdes ! no data left
- dec hl
- ld (ndata),hl
- call getb ! read 1 byte (here:init type) into register c
- dec c
- jp p,2f
- call getw
- push iy
- pop hl
- ld a,h
- or l
- jr z,5f ! size of block is zero, so no work
- push hl
- push bc
-3: pop hl ! #repeats
- pop bc ! block size
- push bc
- ld a,h
- or l
- jr z,4f ! ready
- dec hl
- push hl
- push ix
- pop hl
- add ix,bc
- dec hl
- ld d,h
- ld e,l
- add hl,bc
- ex de,hl
- lddr
- jr 3b
-4: pop bc
-5: ld iy,0 ! now last instruction = repeat = type 0
- jr rddata
-2: ld b,c ! here other types come
- jr nz,2f ! Z-flag was (re-)set when decrementing c
- call getb ! uninitialized words, fetch #words
- sla c
- rl b
- ld iy,0
- add iy,bc
- add ix,bc
-4: jr rddata
-2: call getb ! remaining types, first fetch #bytes/words
- ld a,b
- cp 7
- jr z,rdflt
- jp p,bademfile ! floats are not accepted,nor are illegal types
- ld b,0
- cp 1
- jr z,2f
- cp 5
- jp m,1f
-2: ld iy,0 ! initialized bytes, simply copy from EM-1 file
- add iy,bc
- ld b,c ! #bytes
-3:
- call getb
- ld (ix),c
- inc ix
- djnz 3b
- jr 4b
-1: cp 2
- jr z,2f
- cp 3
- jr z,3f
- ld hl,(pb)
- jr 4f
-3: ld hl,eb+eb%2
- jr 4f
-2: ld hl,0
-4: ld (ntext),hl ! ntext is used here to hold base address of
- ld iy,0 ! correct type: data,instr or 0 (plain numbers)
- add iy,bc
- add iy,bc
- ld b,c
-1:
- push bc
- ex de,hl ! save e into l
- call getw
- ex de,hl
- ld hl,(ntext)
- add hl,bc
- ld (ix),l
- inc ix
- ld (ix),h
- inc ix
- pop bc
- djnz 1b
-2: jr rddata
-rdflt:
- ld a,c
- cp 4
- jr nz,bademfile
- push ix
- pop hl
-1: call getb
- ld a,c
- ld (hl),a
- inc hl
- or a
- jr nz,1b
- push ix
- pop hl
- call atof
- ld b,4
-1: ld a,(hl)
- ld (ix),a
- inc ix
- inc hl
- djnz 1b
- jr rddata
-
-bademfile:
- ld c,printstring
- ld de,1f
- call bdos
- jp 0
-1: .ascii 'load file error\r\n$'
-
-! now all data has been read,so on with the procedure descriptors
-prdes:
- ld (hp),ix ! initialize heap pointer
- ld de,(nproc)
- ld hl,0
- xor a
- sbc hl,de
- add hl,hl
- add hl,hl ! 4 bytes per proc-descriptor
- add hl,sp
- ld sp,hl ! save space for procedure descriptors
- push hl
- pop ix
- ld (pd),hl ! initialize base
- ld hl,(nproc)
-1: ld a,h
- or l
- jr z,2f
- dec hl
- call getb
- ld (ix),c
- inc ix
- call getb
- ld (ix),c
- inc ix
- call getw
- ex de,hl
- ld hl,(pb)
- add hl,bc
- ld (ix),l
- inc ix
- ld (ix),h
- inc ix
- ex de,hl
- jr 1b
-2:
- ld de,(entry) ! get ready for start of program
- ld ix,0 ! reta, jumping here will stop execution
- push ix
- ld hl,argv
- push hl
- ld hl,(argc)
- push hl
- jr cal ! call EM-1 main program
-
-getw: call getb
- ld b,c
- call getb
- ld a,b
- ld b,c
- ld c,a
- ret
-getb: push hl ! getb reads 1 byte in register c from standard
- push de
- ld a,(nextp) ! DMA buffer and refills if necessary
- or a
- jr nz,1f
- push bc
- ld c,read
- ld de,fcb
- call bdos
- or a
- jr nz,bademfile
- pop bc
- ld a,0x80
-1: ld l,a
- ld h,0
- ld c,(hl)
- inc a
- ld (nextp),a
- pop de
- pop hl
- ret
-
-!------------------------- Main loop of the interpreter ---------------
-
-phl: push hl
-loop:
- .errnz dispat%256
- ld l,(ix) ! l = opcode byte
- inc ix ! advance program counter
- ld h,dispat/256 ! hl=address of high byte of jumpaddress
- ld d,(hl) ! d=high byte of jump address
- inc h ! hl=address of low byte of jumpaddress
- ld e,(hl) ! de=jumpaddress
- xor a ! clear a and carry
- ld h,a ! and clear h
- ex de,hl ! d:=0; hl:=jumpaddress
- jp (hl) ! go execute the routine
-
-loop1: ld e,(ix) ! e = opcode byte
- inc ix ! advance EM program counter to next byte
- ld hl,dispat1 ! hl = address of dispatching table
- xor a
- ld d,a
- add hl,de ! compute address of routine for this opcode
- add hl,de ! hl = address of routine to dispatch to
- ld d,(hl) ! e = low byte of routine address
- inc hl ! hl now points to 2nd byte of routine address
- ld h,(hl) ! h = high byte of routine address
- ld l,d ! hl = address of routine
- ld d,a
- jp (hl) ! go execute the routine
-
-loop2: ld e,(ix) ! e = opcode byte
- inc ix ! advance EM program counter to next byte
- ld hl,dispat2 ! hl = address of dispatching table
- xor a
- ld d,a
- add hl,de ! compute address of routine for this opcode
- add hl,de ! hl = address of routine to dispatch to
- ld d,(hl) ! e = low byte of routine address
- inc hl ! hl now points to 2nd byte of routine address
- ld h,(hl) ! h = high byte of routine address
- ld l,d ! hl = address of routine
- ld d,a
- jp (hl) ! go execute the routine
-
-! Note that d and a are both still 0, and the carry bit is cleared.
-! The execution routines make heavy use of these properties.
-! The reason that the carry bit is cleared is a little subtle, since the
-! two instructions add hl,de affect it. However, since dispat is being
-! added twice a number < 256, no carry can occur.
-
-
-
-!---------------------- Routines to compute addresses of locals -------
-
-! There are four addressing routines, corresponding to four ways the
-! offset can be represented:
-! loml: 16-bit offset. Codes 1-32767 mean offsets -2 to -65534 bytes
-! loms: 8-bit offset. Codes 1-255 mean offsets -2 to -510 bytes
-! lopl: 16-bit offset. Codes 0-32767 mean offsets 0 to +65534 bytes
-! lops: 8-bit offset. Codes 0-255 mean offsets 0 to +510 bytes
-
-loml: ld d,(ix) ! loml is for 16-bit offsets with implied minus
- inc ix
- jr 1f
-loms:
- dec d
-1: ld e,(ix) ! loms is for 8-bit offsets with implied minus
- inc ix
- ld h,b
- ld l,c ! hl = bc
- add hl,de
- add hl,de ! hl now equals lb - byte offset
- jp (iy)
-
-lopl: ld d,(ix) ! lopl is for 16-bit offsets >= 0
- inc ix
-lops: ld h,d
- ld l,(ix) ! fetch low order byte of offset
- inc ix
- add hl,hl ! convert offset to bytes
- ld de,zone ! to account of return address zone
- add hl,de
- add hl,bc ! hl now equals lb - byte offset
- jp (iy)
-
-
-
-!---------------------------- LOADS -----------------------------------
-
-! LOC, LPI
-loc.l: lpi.l:
- ld d,(ix) ! loc with 16-bit offset
- inc ix
-loc.s0: ld e,(ix) ! loc with 8-bit offset
- inc ix
-loc.0: loc.1: loc.2: loc.3: loc.4: loc.5: loc.6: loc.7:
-loc.8: loc.9: loc.10: loc.11: loc.12: loc.13: loc.14: loc.15:
-loc.16: loc.17: loc.18: loc.19: loc.20: loc.21: loc.22: loc.23:
-loc.24: loc.25: loc.26: loc.27: loc.28: loc.29: loc.30: loc.31:
-loc.32: loc.33:
- push de
- jr loop
-
-loc.m1: ld hl,-1
- jr phl
-
-
-loc.sm1:dec d ! for constants -256...-1
- jr loc.s0
-
-
-! LDC
-ldc.f: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- push hl
- ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- jr phl
-ldc.l: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- ld e,d
- bit 7,h
- jr z,1f
- dec de
-1:
- push de
- jr phl
-
-ldc.0: ld e,d
- push de
- push de
- jr loop
-
-
-! LOL
-
-lol.0: lol.1: lol.2: lol.3: lol.4: lol.5: lol.6:
- ld hl,-b_lolp-b_lolp+zone
- add hl,de
- add hl,de
- add hl,bc
- jr ipsh
-
-lol.m2: lol.m4: lol.m6: lol.m8: lol.m10: lol.m12: lol.m14: lol.m16:
- ld hl,b_loln+b_loln
- sbc hl,de
- xor a ! clear carry bit
- sbc hl,de
- add hl,bc ! hl = lb - byte offset
-
-ipsh: ld e,(hl)
- inc hl
- ld d,(hl)
- push de
- jr loop
-
-lol.wm1:ld iy,ipsh
- jr loms
-lol.n: ld iy,ipsh
- jr loml
-lol.w0: ld iy,ipsh
- jr lops
-lol.p: ld iy,ipsh
- jr lopl
-
-
-! LOE
-
-loe.w4: inc d
-loe.w3: inc d
-loe.w2: inc d
-loe.w1: inc d
-loe.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr ipsh
-
-loe.l: ld d,(ix)
- inc ix
- jr loe.w0
-
-
-
-! LOF
-lof.2: lof.4: lof.6: lof.8:
- ld hl,-b_lof-b_lof ! assume lof 1 means stack +2, not -2
- add hl,de
- add hl,de
- 1: pop de
- add hl,de
- jr ipsh
-
-lof.s0: ld h,d
- 2: ld l,(ix)
- inc ix
- jr 1b
-
-lof.l: ld h,(ix)
- inc ix
- jr 2b
-
-
-
-! LAL
-lal.m1: ld h,b
- ld l,c
- dec hl
- jr phl
-lal.0: ld h,b
- ld l,c
- ld de,zone
- add hl,de
- jr phl
-
-lal.wm2:dec d
-lal.wm1:ld iy,phl
- jr loms
-lal.w0: ld iy,phl
- jr lops
-lal.n: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- add hl,bc
- jr phl
-
-lal.p: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- add hl,bc
- ld de,zone
- add hl,de
- jr phl
-
-
-
-! LAE
-
-lae.w8: inc d
-lae.w7: inc d
-lae.w6: inc d
-lae.w5: inc d
-lae.w4: inc d
-lae.w3: inc d
-lae.w2: inc d
-lae.w1: inc d
-lae.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr phl
-
-lae.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- jr phl
-
-
-
-! LIL
-lil.0: lil.2:
- ld hl,-b_lil-b_lil+zone
- add hl,de
- add hl,de
- add hl,bc
- 1: ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- jr ipsh
-
-lil.wm1:ld iy,1b
- jr loms
-lil.n: ld iy,1b
- jr loml
-lil.w0: ld iy,1b
- jr lops
-lil.p: ld iy,1b
- jr lopl
-
-
-
-! LXL, LXA
-lxl.1:
- ld a,1
- jr 7f
-
-lxl.2:
- ld a,2
- jr 7f
-
-lxl.l: ld d,(ix)
- inc ix
-lxl.s: ld a,(ix)
- inc ix
-7: ld iy,phl
-5: ld h,b
- ld l,c
- or a
- jr z,3f
-2: inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- inc hl
- .errnz .-2b-zone
- ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- dec a
- jr nz,2b
-3: cp d
- jr z,4f
- dec d
- jr 2b
-4: jp (iy)
-
-lxa.1:
- ld a,1
- jr 7f
-
-lxa.l: ld d,(ix)
- inc ix
-lxa.s: ld a,(ix)
- inc ix
-7: ld iy,1f
- jr 5b
-1: ld de,zone
- add hl,de
- jr phl
-
-lpb.z:
- pop hl
- .errnz zone/256
- ld e,zone
- add hl,de
- jr phl
-
-dch.z:
- ld e,2
- jr loi
-
-exg.z:
- pop de
- jr exg
-exg.l:
- ld d,(ix)
- inc ix
-exg.s0:
- ld e,(ix)
- inc ix
-exg:
- push bc
- pop iy
- ld hl,0
- add hl,sp
- ld b,h
- ld c,l
- add hl,de
-1:
- ld a,(bc)
- ex af,af2
- ld a,(hl)
- ld (bc),a
- ex af,af2
- ld (hl),a
- inc bc
- inc hl
- dec de
- ld a,d
- or e
- jr nz,1b
- push iy
- pop bc
- jr loop
-
-
-! LDL
-ldl.0: ld de,zone
- ld h,b
- ld l,c
- add hl,de
-dipsh: inc hl
- inc hl
- inc hl
- ld d,(hl)
- dec hl
- ld e,(hl)
- dec hl
- push de
- ld d,(hl)
- dec hl
- ld e,(hl)
- push de
- jr loop
-
-ldl.wm1:ld iy,dipsh
- jr loms
-ldl.n: ld iy,dipsh
- jr loml
-ldl.w0: ld iy,dipsh
- jr lops
-ldl.p: ld iy,dipsh
- jr lopl
-
-
-! LDE
-lde.l: ld d,(ix)
- inc ix
- jr lde.w0
-
-lde.w3: inc d
-lde.w2: inc d
-lde.w1: inc d
-lde.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr dipsh
-
-
-! LDF
-ldf.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- pop hl
- add hl,de
- jr dipsh
-
-
-! LOI,LOS
-los.z:
- ld iy,los.2
- jr pop2
-los.l: call long2
-los.2: pop de
-loi: pop hl
- add hl,de
- dec hl
- srl d
- rr e
- jr nc,1f
- ld a,e
- or d
- jr nz,eilsize
- ld e,(hl) ! here the 1-byte case is caught
- push de
- jr loop
-1: push bc
- pop iy
-2: ld b,(hl)
- dec hl
- ld c,(hl)
- dec hl
- push bc
- dec de
- ld a,d
- or e
- jr nz,2b
-loiend: push iy
- pop bc
- jr loop
-
-loi.1: loi.2: loi.4: loi.6: loi.8:
- ld hl,-b_loi-b_loi
- add hl,de
- adc hl,de ! again we use that the carry is cleared
- jr nz,1f
- inc hl ! in case loi.0 object size is 1 byte!
-1: ex de,hl
- jr loi
-
-loi.l: ld d,(ix)
- inc ix
-loi.s0: ld e,(ix)
- inc ix
- jr loi
-
-
-! ------------------------------ STORES --------------------------------
-
-! STL
-stl.p2: ld hl,2
- jr 4f
-stl.p0: ld hl,0
-4: ld de,zone
- add hl,de
- add hl,bc
- jr ipop
-
-stl.m2: stl.m4: stl.m6: stl.m8: stl.m10:
- ld hl,b_stlm+b_stlm
-stl.zrl:sbc hl,de
- xor a
- sbc hl,de
- add hl,bc
-ipop: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- jr loop
-
-stl.wm1:ld iy,ipop
- jr loms
-stl.n: ld iy,ipop
- jr loml
-stl.w0: ld iy,ipop
- jr lops
-stl.p: ld iy,ipop
- jr lopl
-
-
-
-
-! STE
-
-ste.w3: inc d
-ste.w2: inc d
-ste.w1: inc d
-ste.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr ipop
-
-ste.l: ld d,(ix)
- inc ix
- jr ste.w0
-
-
-
-! STF
-stf.2: stf.4: stf.6:
- ld hl,-b_stf-b_stf
- add hl,de
- add hl,de
- 1: pop de
- add hl,de
- jr ipop
-
-stf.s0: ld h,d
- 2: ld l,(ix)
- inc ix
- jr 1b
-
-stf.l: ld h,(ix)
- inc ix
- jr 2b
-
-
-
-! SIL
-1: ld e,(hl)
- inc hl
- ld h,(hl)
- ld l,e
- jr ipop
-
-sil.wm1:ld iy,1b
- jr loms
-sil.n: ld iy,1b
- jr loml
-sil.w0: ld iy,1b
- jr lops
-sil.p: ld iy,1b
- jr lopl
-
-
-! STI, STS
-sts.z:
- ld iy,sts.2
- jr pop2
-sts.l: call long2
-sts.2: pop de
-sti: pop hl
- srl d
- rr e
- jr nc,1f
- ld a,e
- or d
- jr nz,eilsize
- pop de ! here the 1-byte case is caught
- ld (hl),e
- jr loop
-1: push bc
- pop iy
-2: pop bc
- ld (hl),c
- inc hl
- ld (hl),b
- inc hl
- dec de
- ld a,e
- or d
- jr nz,2b
- jr loiend
-
-sti.1: sti.2: sti.4: sti.6: sti.8:
- ld hl,-b_sti-b_sti
- add hl,de
- adc hl,de ! again we use that the carry is cleared
- jr nz,1f
- inc hl ! in case sti.0 object size is 1 byte!
-1: ex de,hl
- jr sti
-
-sti.l: ld d,(ix)
- inc ix
-sti.s0: ld e,(ix)
- inc ix
- jr sti
-
-
-! SDL
-sdl.wm1:ld iy,1f
- jr loms
-sdl.n: ld iy,1f
- jr loml
-sdl.w0: ld iy,1f
- jr lops
-sdl.p: ld iy,1f
- jr lopl
-
-
-! SDE
-sde.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ld hl,eb+eb%2
-2: add hl,de
-1: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- jr ipop
-
-
-! SDF
-sdf.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- pop hl
- jr 2b
-
-
-!------------------------- SINGLE PRECISION ARITHMETIC ---------------
-
-! ADI, ADP, ADS, ADU
-
-adi.z: adu.z:
- pop de
-9:
- call chk24
- .word adi.2,adi.4
-adi.l: adu.l:
- ld d,(ix) ! I guess a routine chk24.l could do this job
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-ads.z:
- ld iy,adi.2
- jr pop2
-ads.l:
- call long2
-ads.2: adi.2: adu.2:
- pop de
-1: pop hl
- add hl,de
- jr phl
-
-adp.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 1b
-
-adp.sm1:dec d
-adp.s0: ld e,(ix)
- inc ix
- jr 1b
-
-adp.2: pop hl
- inc hl
- jr 1f
-inc.z:
-adp.1: pop hl
-1: inc hl
- jr phl
-
-
-! SBI, SBP, SBS, SBU (but what is SBP?)
-
-sbi.z: sbu.z:
- pop de
-9:
- call chk24
- .word sbi.2,sbi.4
-sbi.l: sbu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-sbs.z:
- ld iy,sbi.2
- jr pop2
-sbs.l:
- call long2
-sbi.2:
- pop de
- pop hl
- sbc hl,de
- jr phl
-
-
-! NGI
-ngi.z:
- pop de
-9:
- call chk24
- .word ngi.2,ngi.4
-ngi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-ngi.2: ld hl,0
- pop de
- sbc hl,de
- jr phl
-
-
-! MLI, MLU Johan version
-mli.z: mlu.z:
- pop de
-9:
- call chk24
- .word mli.2,mli.4
-mli.l: mlu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-mli.2: mlu.2:
- ld iy,loop
-mliint: pop de
- pop hl
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
-0:
- bit 7,d
- jr z,1f
- add hl,bc
-1:
- dec a
- jr z,2f
- ex de,hl
- add hl,hl
- ex de,hl
- add hl,hl
- jr 0b
-2:
- pop bc
- push hl
- jp (iy)
-
-
-! DVI, DVU
-dvi.z:
- pop de
-9:
- call chk24
- .word dvi.2,dvi.4
-dvi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-dvi.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- xor a
- ld h,a
- ld l,a
- sbc hl,bc
- jp m,1f
- ld b,h
- ld c,l
- cpl
-1:
- or a
- ld hl,0
- sbc hl,de
- jp m,1f
- ex de,hl
- cpl
-1:
- push af
- ld hl,0
- ld a,16
-0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
-1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
-2:
- dec a
- jr nz,0b
- pop af
- or a
- jr z,1f
- ld hl,0
- sbc hl,de
- ex de,hl
-1:
- pop bc
- push de
- jr loop
-
-
-dvu.z:
- pop de
-9:
- call chk24
- .word dvu.2,dvu.4
-dvu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-dvu.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
-0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
-1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
-2:
- dec a
- jr nz,0b
- pop bc
- push de
- jr loop
-
-
-! RMI, RMU
-rmi.z:
- pop de
-9:
- call chk24
- .word rmi.2,rmi.4
-rmi.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-rmi.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- xor a
- ld h,a
- ld l,a
- sbc hl,bc
- jp m,1f
- ld b,h
- ld c,l
-1:
- or a
- ld hl,0
- sbc hl,de
- jp m,1f
- ex de,hl
- cpl
-1:
- push af
- ld hl,0
- ld a,16
-0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
-1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
-2:
- dec a
- jr nz,0b
- ex de,hl
- pop af
- or a
- jr z,1f
- ld hl,0
- sbc hl,de
- ex de,hl
-1:
- pop bc
- push de
- jr loop
-
-
-rmu.4:
- ld iy,.dvu4
- jr 1f
-rmi.4:
- ld iy,.dvi4
-1:
- ld (retarea),bc
- ld (retarea+2),ix
- ld hl,1f
- push hl
- push iy
- ret
-1:
- pop hl
- pop hl
- push bc
- push de
- ld bc,(retarea)
- ld ix,(retarea+2)
- jr loop
-rmu.z:
- pop de
-9:
- call chk24
- .word rmu.2,rmu.4
-rmu.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-rmu.2:
- pop hl
- pop de
- push bc
- ld b,h
- ld c,l
- ld hl,0
- ld a,16
-0:
- add hl,hl
- ex de,hl
- add hl,hl
- ex de,hl
- jr nc,1f
- inc hl
- or a
-1:
- sbc hl,bc
- inc de
- jp p,2f
- add hl,bc
- dec de
-2:
- dec a
- jr nz,0b
- pop bc
- jr phl
-
-! SLI, SLU
-
-slu.z: sli.z:
- pop de
-9:
- call chk24
- .word sli.2,sli.4
-slu.l:
-sli.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-sli.2:
- pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
-2: add hl,hl
-1: dec e
- jp m,phl
- jr 2b
-
-sli.4:
-slu.4:
- pop de
- pop iy
- pop hl
- inc d
- dec d
- jr z,1f
- ld e,31
-1:
- dec e
- jp m,2f
- add iy,iy
- adc hl,hl
- jr 1b
-2:
- push hl
- push iy
- jr loop
-
-! SRI, SRU
-
-sri.z:
- pop de
-9:
- call chk24
- .word sri.2,sri.4
-sri.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-sri.2: pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
-2: sra h
- rr l
-1: dec e
- jp m,phl
- jr 2b
-
-
-sri.4:
- pop de
- ld a,e
- inc d
- dec d
- pop de
- pop hl
- jr z,1f
- ld a,31
-1:
- dec a
- jp m,2f
- sra h
- rr l
- rr d
- rr e
- jr 1b
-2:
- push hl
- push de
- jr loop
-
-sru.z:
- pop de
-9:
- call chk24
- .word sru.2,sru.4
-sru.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-sru.2: pop de
- pop hl
- ld a,d
- or a
- jr z,1f
- ld e,15
-2: srl h
- rr l
-1: dec e
- jp m,phl
- jr 2b
-
-sru.4:
- pop de
- ld a,e
- inc d
- dec d
- pop de
- pop hl
- jr z,1f
- ld a,31
-1:
- dec a
- jp m,2f
- srl h
- rr l
- rr d
- rr e
- jr 1b
-2:
- push hl
- push de
- jr loop
-
-! ROL, ROR
-rol.z:
- pop de
-9:
- call chk24
- .word rol.2,rol.4
-rol.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-rol.2: pop de
- pop hl
- ld a,e
- and 15
- jr z,phl
- ld de,0
-1: add hl,hl
- adc hl,de
- dec a
- jr nz,1b
- jr phl
-
-
-rol.4:
- pop de
- pop iy
- pop hl
- ld a,e
- and 31
- jr z,3f
-1:
- add iy,iy
- adc hl,hl
- jr nc,2f
- inc iy
-2:
- dec a
- jr nz,1b
-3:
- push hl
- push iy
-
-ror.z:
- pop de
-9:
- call chk24
- .word ror.2,ror.4
-ror.l:
- ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr 9b
-ror.2: pop de
- pop hl
- ld a,e
- and 15
- jr z,phl
-1: srl h
- rr l
- jr nc,2f
- set 7,h
-2: dec a
- jr nz,1b
- jr phl
-
-
-ror.4:
- pop de
- ld a,e
- pop de
- pop hl
- and 31
- jr z,0f
-1:
- srl h
- rr l
- rr d
- rr e
- jr nc,2f
- set 7,h
-2:
- dec a
- jr nz,1b
-0:
- push hl
- push de
- jr loop
-pop2: ld de,2
- pop hl
- sbc hl,de
- jr nz,eilsize
- xor a
- ld d,a
- jp (iy)
-
-
-chk24:
- ! this routine is used to call indirectly
- ! a routine for either 2 or 4 byte operation
- ! ( e.g. mli.2 or mli.4)
- ! de contains 2 or 4
- ! iy points to a descriptor containing
- ! the addresses of both routines
- pop iy ! address of descriptor
- ld a,d ! high byte must be 0
- or a
- jr nz,unimpld
- ld a,e
- cp 2
- jr z,1f
- inc iy
- inc iy ! points to word containing
- ! address of 4 byte routine
- cp 4
- jr nz,unimpld
-1:
- ld h,(iy+1)
- ld l,(iy)
- xor a
- jp (hl)
-!--------------------- INCREMENT, DECREMENT, ZERO ----------------------
-
-! INC
-inl.m2: inl.m4: inl.m6:
- ld hl, b_inl+b_inl
- sbc hl,de
- xor a
- sbc hl,de
- add hl,bc
-1: inc (hl)
- jr nz,loop
- inc hl
- inc (hl)
- jr loop
-
-inl.wm1:ld iy,1b
- jr loms
-inl.n: ld iy,1b
- jr loml
-inl.p: ld iy,1b
- jr lopl
-
-
-! INE
-
-ine.w3: inc d
-ine.w2: inc d
-ine.w1: inc d
-ine.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr 1b
-
-ine.l: ld d,(ix)
- inc ix
- jr ine.w0
-
-
-! DEC
-dec.z: pop hl
- dec hl
- push hl
- jr loop
-
-1: ld e,(hl)
- inc hl
- ld d,(hl)
- dec de
- ld (hl),d
- dec hl
- ld (hl),e
- jr loop
-
-del.wm1:ld iy,1b
- jr loms
-del.n: ld iy,1b
- jr loml
-del.p: ld iy,1b
- jr lopl
-
-
-! DEE
-
-dee.w3: inc d
-dee.w2: inc d
-dee.w1: inc d
-dee.w0: ld e,(ix)
- inc ix
- ld hl,eb+eb%2
- add hl,de
- add hl,de
- jr 1b
-
-dee.l: ld d,(ix)
- inc ix
- jr dee.w0
-
-
-! ZERO
-zri2: zru2:
- ld h,d
- ld l,d
- jr phl
-
-
-zrf.z:
-zer.z: pop de
-2: ld hl,0
- sra d
- rr e
-1: push hl
- dec de
- ld a,e
- or d
- jr nz,1b
- jr loop
-
-zrf.l:
-zer.l: ld d,(ix)
- inc ix
-zer.s0: ld e,(ix)
- inc ix
- jr 2b
-
-
-zrl.m2: zrl.m4:
- ld h,d
- ld l,d
- push hl
- ld hl,b_zrl+b_zrl
- jr stl.zrl
-
-zrl.wm1:
- ld h,d
- ld l,d
- push hl
- jr stl.wm1
-
-zrl.n:
- ld h,d
- ld l,d
- push hl
- jr stl.n
-
-zrl.w0:
- ld h,d
- ld l,d
- push hl
- jr stl.w0
-
-zrl.p:
- ld h,d
- ld l,d
- push hl
- jr stl.p
-
-
-
-zre.w0:
- ld h,d
- ld l,d
- push hl
- jr ste.w0
-
-zre.l:
- ld h,d
- ld l,d
- push hl
- jr ste.l
-
-
-! ------------------------- CONVERT GROUP ------------------------------
-
-! CII, CIU
-cii.z: ciu.z:
- pop hl
- pop de
- sbc hl,de ! hl and de can only have values 2 or 4, that's
- ! why a single subtract can split the 3 cases
- jr z,loop ! equal, so do nothing
- jp p,2f
-3: pop hl ! smaller, so shrink size from double to single
- pop de
- jr phl
-2: pop hl ! larger, so expand (for cii with sign extend)
- res 1,e
- bit 7,h
- jr z,1f
- dec de
-1: push de
- jr phl
-
-! CUI, CUU
-cui.z: cuu.z:
- pop hl
- pop de
- sbc hl,de
- jr z,loop
- jp m,3b
- res 1,e
- pop hl
- jr 1b
-
-
-! ------------------------------ SETS ---------------------------------
-
-! SET
-set.z: pop hl
-doset: pop de
- push bc
- pop iy
- ld b,h
- ld c,l
- xor a
-0: push af
- inc sp
- dec c
- jr nz,0b
- dec b
- jp p,0b
- push iy
- pop bc
- ex de,hl
- ld a,l
- sra h
- jp m,unimpld
- rr l
- sra h
- rr l
- sra h
- rr l
- push hl
- or a
- sbc hl,de
- pop hl
- jp p,unimpld
- add hl,sp
- ld (hl),1
- and 7
- jr 1f
-0: sla (hl)
- dec a
-1: jr nz,0b
- jr loop
-
-set.l: ld d,(ix)
- inc ix
-set.s0: ld e,(ix)
- inc ix
- ex de,hl
- jr doset
-
-
-! INN
-inn.z: pop hl
- jr 1f
-inn.l: ld d,(ix)
- inc ix
-inn.s0: ld e,(ix)
- inc ix
- ex de,hl
-1:
- pop de
- add hl,sp
- push hl
- pop iy
- ex de,hl
- ld a,l
- sra h
- jp m,0f
- rr l
- sra h
- rr l
- sra h
- rr l
- add hl,sp
- push hl
- or a ! clear carry
- sbc hl,de
- pop hl
- jp m,1f
-0: xor a
- jr 4f
-1: ld e,(hl)
- and 7
- jr 2f
-3: rrc e
- dec a
-2: jr nz,3b
- ld a,e
- and 1
-4: ld l,a
- ld h,0
- ld sp,iy
- jr phl
-
-
-
-! ------------------------- LOGICAL GROUP -----------------------------
-
-! AND
-and.z: pop de
-doand: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
-1: dec hl
- dec de
- ld a,(de)
- and (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
-2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
-
-and.l: ld d,(ix)
- inc ix
-and.s0: ld e,(ix)
- inc ix
- jr doand
-
-and.2: ld e,2
- jr doand
-
-! IOR
-ior.z: pop de
-ior: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
-1: dec hl
- dec de
- ld a,(de)
- or (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
-2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
-
-ior.l: ld d,(ix)
- inc ix
-ior.s0: ld e,(ix)
- inc ix
- jr ior
-
-ior.2: ld e,2
- jr ior
-
-! XOR
-xor.z: pop de
-exor: ld h,d
- ld l,e
- add hl,sp
- push bc
- ld b,h
- ld c,l
- ex de,hl
- add hl,de
-1: dec hl
- dec de
- ld a,(de)
- xor (hl)
- ld (hl),a
- xor a
- sbc hl,bc
- jr z,2f
- add hl,bc
- jr 1b
-2: ld h,b
- ld l,c
- pop bc
- ld sp,hl
- jr loop
-
-xor.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- jr exor
-
-! COM
-com.z: pop hl
-com: add hl,sp
-1: dec hl
- ld a,(hl)
- cpl
- ld (hl),a
- xor a
- sbc hl,sp
- jr z,loop
- add hl,sp
- jr 1b
-
-com.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
- ex de,hl
- jr com
-
-
-! ------------------------- COMPARE GROUP ------------------------------
-
-! CMI
-
-
-cmi.2: pop de
- pop hl
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr phl
-1: xor d ! now a equals (original) h again
- jp m,phl
- set 0,l ! to catch case hl=0>de bit 0 is set explicitly
- jr phl
-
-
-
-! CMU, CMP
-
-cmi.4: inc a
- ld de,4
- jr docmu
-cmp.z: ld de,2
- jr docmu
-cmi.z: inc a
-cmu.z:
- pop de
- jr docmu
-
-cmi.l: inc a
-cmu.l: ld d,(ix)
- inc ix
- ld e,(ix)
- inc ix
-docmu: push bc
- pop iy
- ld b,d
- ld c,e
- ld hl,0
- add hl,sp
- add hl,bc
- dec hl
- ld d,h
- ld e,l
- add hl,bc
- ld (retarea),hl ! save new sp-1
- or a
- jr z,1f
- ld a,(de)
- cp (hl)
- dec hl
- dec de
- dec bc
- jr z,1f
- jp p,4f
- jp pe,5f
- jr 6f
-1:
- ld a,(de)
- cp (hl)
- dec de
- dec hl
- dec bc
- jr nz,2f
- ld a,b
- or c
- jr nz,1b
- ld d,a
- ld e,a
- jr 3f
-2:
- jr nc,5f
-6:
- ld de,1
- jr 3f
-4:
- jp pe,6b
-5:
- ld de,-1
-3:
- ld hl,(retarea)
- inc hl
- ld sp,hl
- push de
- push iy
- pop bc
- jr loop
-
-
-
-! CMS
-
-cms.z: pop hl
- jr 1f
-cms.l: ld d,(ix)
- inc ix
-cms.s0: ld e,(ix)
- inc ix
- ex de,hl
-1: push bc
- pop iy
- ld b,h
- ld c,l
- add hl,sp
-0:
- dec sp
- pop af
- cpi
- jr nz,1f
- ld a,b
- or c
- jr nz,0b
- ld de,0
- jr 2f
-1:
- add hl,bc
- ld de,1
-2:
- ld sp,hl
- push de
- push iy
- pop bc
- jr loop
-
-
-! TLT, TLE, TEQ, TNE, TGE, TGT
-tlt.z:
- ld h,d
- ld l,d
- pop de
- bit 7,d
- jr z,1f
- inc l
-1:
- jr phl
-
-tle.z: ld hl,1
- pop de
- xor a
- add a,d
- jp m,phl
- jr nz,1f
- xor a
- add a,e
- jr z,2f
-1: dec l
-2:
- jr phl
-
-teq.z:
- ld h,d
- ld l,d
- pop de
- ld a,d
- or e
- jr nz,1f
- inc l
-1:
- jr phl
-
-tne.z:
- ld h,d
- ld l,d
- pop de
- ld a,d
- or e
- jr z,1f
- inc l
-1:
- jr phl
-
-tge.z:
- ld h,d
- ld l,d
- pop de
- bit 7,d
- jr nz,1f
- inc l
-1:
- jr phl
-
-tgt.z:
- ld h,d
- ld l,d
- pop de
- xor a
- add a,d
- jp m,phl
- jr nz,1f
- xor a
- add a,e
- jr z,2f
-1: inc l
-2:
- jr phl
-
-
-! ------------------------- BRANCH GROUP -------------------------------
-
-! BLT, BLE, BEQ, BNE, BGE, BGT, BRA
-
-b.pl: ld d,(ix)
- inc ix
-b.ps: ld e,(ix)
- inc ix
- push ix
- pop hl
- add hl,de
- pop de
- ex (sp),hl
- xor a
- jp (iy)
-
-
-bra.l: ld d,(ix)
- inc ix
- jr bra.s0
-
-bra.sm2:dec d
-bra.sm1:dec d
- dec d
-bra.s1: inc d
-bra.s0: ld e,(ix)
- inc ix
- add ix,de
- jr loop
-
-
-bgo: pop ix ! take branch
- jr loop
-
-
-blt.s0: ld iy,blt
- jr b.ps
-blt.l: ld iy,blt
- jr b.pl
-blt: ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
-1: xor d
-2: jp m,bgo
- pop de
- jr loop
-
-
-ble.s0: ld iy,ble
- jr b.ps
-ble.l: ld iy,ble
- jr b.pl
-ble: ex de,hl
- jr bge
-
-
-beq.s0: ld iy,beq
- jr b.ps
-beq.l: ld iy,beq
- jr b.pl
-beq: sbc hl,de
- jr z,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
-
-
-bne.s0: ld iy,bne
- jr b.ps
-bne.l: ld iy,bne
- jr b.pl
-bne: sbc hl,de
- jr nz,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
-
-
-bge.s0: ld iy,bge
- jr b.ps
-bge.l: ld iy,bge
- jr b.pl
-bge: ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
-1: xor d ! now a equals (original) h again
-2: jp p,bgo
- pop de ! keep stack clean, so dump unused jump address
- jr loop
-
-
-bgt.s0: ld iy,bgt
- jr b.ps
-bgt.l: ld iy,bgt
- jr b.pl
-bgt: ex de,hl
- jr blt
-
-
-
-! ZLT, ZLE, ZEQ, ZNE, ZGE, ZGT
-
-
-z.pl: ld d,(ix)
- inc ix
-z.ps: ld e,(ix)
- inc ix
- push ix
- pop hl
- add hl,de
- ex de,hl
- pop hl
- xor a
- add a,h
- jp (iy)
-
-
-
-zlt.l: ld iy,zlt
- jr z.pl
-zlt.s0: ld iy,zlt
- jr z.ps
-zlt: jp m,zgo
- jr loop
-
-
-zle.l: ld iy,zle
- jr z.pl
-zle.s0: ld iy,zle
- jr z.ps
-zle: jp m,zgo
- jr nz,loop
- xor a
- add a,l
- jr z,zgo
- jr loop
-
-
-zeq.l: ld iy,zeq
- jr z.pl
-zeq.s1: inc d
-zeq.s0: ld iy,zeq
- jr z.ps
-zeq: ld a,l
- or h
- jr nz,loop
-zgo: push de
- pop ix
- jr loop
-
-
-zne.sm1:dec d
- jr zne.s0
-zne.l: ld iy,zne
- jr z.pl
-zne.s0: ld iy,zne
- jr z.ps
-zne: ld a,l
- or h
- jr nz,zgo
- jr loop
-
-
-zge.l: ld iy,zge
- jr z.pl
-zge.s0: ld iy,zge
- jr z.ps
-zge: jp m,loop
- jr zgo
-
-
-zgt.l: ld iy,zgt
- jr z.pl
-zgt.s0: ld iy,zgt
- jr z.ps
-zgt: jp m,loop
- jr nz,zgo
- xor a
- add a,l
- jr z,loop
- jr zgo
-
-
-! ------------------- ARRAY REFERENCE GROUP ---------------------------
-
-! AAR
-aar.z:
- ld iy,aar.2
- jr pop2
-aar.l: call long2
-aar.2: ld hl,loop
-aarint: pop iy ! descriptor
- ex (sp),hl ! save return address and hl:=index
- ld e,(iy+0)
- ld d,(iy+1) ! de := lwb
- ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
-1: sbc hl,de
- xor d
-2: call m,e.array
- ld e,(iy+2)
- ld d,(iy+3) ! de := upb - lwb
- push hl
- ex de,hl
- ld a,h
- xor d
- jp m,1f
- sbc hl,de
- jr 2f
-1: xor d
-2: ex de,hl
- pop hl
- call m,e.array
-1: ld e,(iy+4)
- ld d,(iy+5)
- pop iy
- ex (sp),iy
- push iy ! exchange base address and return address
- push de
- push de
- push hl
- ld iy,1f
- jr mliint
-1: pop de
- pop iy
- pop hl
- push iy
- add hl,de
- pop de
- ex (sp),hl
- jp (hl)
-
-lar.l: call long2
-lar.2: ld hl,loi
- jr aarint
-lar.z:
- ld iy,lar.2
- jr pop2
-
-
-sar.l: call long2
-sar.2: ld hl,sti
- jr aarint
-sar.z:
- ld iy,sar.2
- jr pop2
-
-
-! --------------------- PROCEDURE CALL/RETURN --------------------------
-
-! CAL
-
-cal.1: cal.2: cal.3: cal.4: cal.5: cal.6: cal.7: cal.8:
-cal.9: cal.10: cal.11: cal.12: cal.13: cal.14: cal.15: cal.16:
-cal.17: cal.18: cal.19: cal.20: cal.21: cal.22: cal.23: cal.24:
-cal.25: cal.26: cal.27: cal.28:
- ld hl,-b_cal
- add hl,de
- ex de,hl
- jr cal
-
-cal.l: ld d,(ix)
- inc ix
-cal.s0: ld e,(ix)
- inc ix
-cal: push ix ! entry point for main program of interpreter
- push bc
- ld hl,(eb+eb%2)
- push hl
- ld hl,(eb+eb%2+4)
- push hl
-! temporary tracing facility
-! NOP it if you don't want it
- push de
- ld de,(eb+eb%2+4)
- ld hl,(eb+eb%2)
- call prline
- pop de
-! end of temporary tracing
- ld hl,0
- add hl,sp
- ld b,h
- ld c,l
- ld hl,(pd)
- ex de,hl
- add hl,hl
- add hl,hl
- add hl,de
- push hl
- pop iy
- ld e,(iy+0)
- ld d,(iy+1)
- ld l,c
- ld h,b
- xor a
- sbc hl,de
- ld sp,hl
- ld e,(iy+2)
- ld d,(iy+3)
- ld ix,0
- add ix,de
- jr loop
-
-
-! CAI
-
-cai.z: pop de
- jr cal
-
-
-! LFR
-lfr.z: pop de
-2: ld a,e
- rr a
- cp 5
- jp p,eilsize ! only result sizes <= 8 are allowed
- ld hl,retarea
- add hl,de
-1: dec hl
- ld d,(hl)
- dec hl
- ld e,(hl)
- push de
- dec a
- jr nz,1b
- jr loop
-
-lfr.l: ld d,(ix)
- inc ix
-lfr.s0: ld e,(ix)
- inc ix
- jr 2b
-
-lfr.2: ld hl,(retarea)
- jr phl
-
-lfr.4: ld de,4
- jr 2b
-
-
-! RET
-ret.2: ld a,1
- jr 3f
-
-ret.z: pop de
-2: ld a,d
- or e
- jr z,ret.0
- rr a
- cp 5
- jp p,eilsize ! only result sizes <= 8 bytes are allowed
-3: ld hl,retarea
-1: pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- dec a
- jr nz,1b
-ret.0:
- ld h,b
- ld l,c
- ld sp,hl
- pop hl
- ld (eb+eb%2+4),hl
- pop hl
- ld (eb+eb%2),hl
- pop bc ! old LB
- pop ix ! reta
- push ix ! check to see if reta = boot (= 0)
- pop hl
- ld a,l
- or h
- jr nz,loop ! not done yet
- call uxfinish
- jr boot
-
-ret.l: ld d,(ix)
- inc ix
-ret.s0: ld e,(ix)
- inc ix
- jr 2b
-
-
-! ------------------------- MISCELLANEOUS -----------------------------
-
-! SIG, TRP, RTT
-
-sig.z:
- ld hl,(trapproc)
- ex (sp),hl
- ld (trapproc),hl
- jr loop
-
-trp.z:
- ex (sp),hl
- push de
- push af
- push ix
- push iy
- push bc
-! ld iy,trapproc
-! ld a,(iy)
-! or (iy+1)
-! jr nz,1f
- ld iy,2f+13
- call octnr
- ld c,printstring
- ld de,2f
- call bdos
- ld de,(eb+eb%2+4)
- ld hl,(eb+eb%2)
- call prline
-0:
- pop iy ! LB
- ld a,(iy+6)
- or (iy+7) ! reta
- jr nz,3f
- call uxfinish
- jp boot
-3:
- ld c,(iy+4)
- ld b,(iy+5)
- push bc ! next LB
- ld e,(iy)
- ld d,(iy+1) ! file name
- ld l,(iy+2)
- ld h,(iy+3) ! lineno
- call prline
- jr 0b
-!1:
-! ld ix,0
-! push hl
-! ld hl,(trapproc)
-! push hl
-! ld hl,0
-! ld (trapproc),hl
-! jr cai.z
-2: .ascii 'error 0xxxxxx\r\n$'
-
-prline:
-! prints lineno (hl) and filename (de)
- push de
- ld iy,2f+12
- call octnr
- ld c,printstring
- ld de,2f
- call bdos
- pop de
- ld hl,4f
-0:
- ld a,(de)
- or a
- jr z,1f
- ld (hl),a
- inc de
- inc hl
- jr 0b
-1:
- ld (hl),36 ! '$'
- ld de,4f
- ld c,printstring
- call bdos
- ld de,3f
- ld c,printstring
- call bdos
- ret
-2: .ascii 'line 0xxxxxx in $'
-3: .ascii '\r\n$'
-4: .space 12
-
-rtt.z=ret.0
-
-
-
-! NOP
-! changed into output routine to print linenumber
-! in octal (6 digits)
-
-nop.z: push bc
- ld iy,1f+12
- ld hl,(eb+eb%2)
- call octnr
- ld iy,1f+20
- ld hl,0
- add hl,sp
- call octnr
- ld c,printstring
- ld de,1f
- call bdos
- pop bc
- jr loop
-1: .ascii 'test 0xxxxxx 0xxxxxx\r\n$'
-
-octnr:
- ld b,6
-1: ld a,7
- and l
- add a,'0'
- dec iy
- ld (iy+0),a
- srl h
- rr l
- srl h
- rr l
- srl h
- rr l
- djnz 1b
- ret
-
-
-! DUP
-
-dup.2: pop hl
- push hl
- jr phl
-
-dus.z:
- ld iy,1f
- jr pop2
-dus.l: call long2
-1: push bc
- pop iy
- pop bc
- jr dodup
-dup.l:
- push bc
- pop iy
- ld b,(ix)
- inc ix
- ld c,(ix)
- inc ix
-dodup: ld h,d
- ld l,d ! ld hl,0
- add hl,sp
- ld d,h
- ld e,l
- xor a
- sbc hl,bc
- ld sp,hl
- ex de,hl
- ldir
- push iy
- pop bc
- jr loop
-
-
-! BLM, BLS
-bls.z:
- ld iy,blm
- jr pop2
-bls.l: call long2
-blm:
- push bc
- pop iy
- pop bc
- pop de
- pop hl
- ldir
- push iy
- pop bc
- jr loop
-
-blm.l:
- ld d,(ix)
- inc ix
-blm.s0: ld e,(ix)
- inc ix
- push de
- jr blm
-
-
-! ASP, ASS
-ass.z:
- ld iy,1f
- jr pop2
-ass.l: call long2
-1: pop hl
- jr 1f
-asp.l:
- ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
-asp: add hl,hl
-1: add hl,sp
- ld sp,hl
- jr loop
-
-
-asp.2: asp.4: asp.6: asp.8: asp.10:
- ld hl,-b_asp
- add hl,de
- jr asp
-
-asp.w0: ld e,(ix)
- inc ix
- ex de,hl
- jr asp
-
-
-! CSA
-
-csa.z:
- ld iy,csa.2
- jr pop2
-csa.l: call long2
-csa.2:
-!! temporary version while bug in cem remains
-! pop iy
-! pop de
-! push bc
-! ld c,(iy)
-! ld b,(iy+1)
-! ld l,(iy+4)
-! ld h,(iy+5)
-! xor a
-! sbc hl,de
-! jp m,1f
-! ex de,hl
-! ld e,(iy+2)
-! ld d,(iy+3)
-! xor a
-! sbc hl,de
-! jp m,1f
-! end of temporary piece
- pop iy
- pop hl
- push bc
- ld c,(iy)
- ld b,(iy+1)
- ld e,(iy+2)
- ld d,(iy+3)
- xor a
- sbc hl,de
- jp m,1f
- ex de,hl
- ld l,(iy+4)
- ld h,(iy+5)
- xor a
- sbc hl,de
- jp m,1f
- ex de,hl
- add hl,hl
- ld de,6
- add hl,de
- ex de,hl
- add iy,de
- ld l,(iy)
- ld h,(iy+1)
- ld a,h
- or l
- jr nz,2f
-1: ld a,b
- or c
- jr z,e.case
- ld l,c
- ld h,b
-2: pop bc
- push hl
- pop ix
- jr loop
-! CSB
-
-csb.z:
- ld iy,csb.2
- jr pop2
-csb.l: call long2
-csb.2:
- pop ix
- pop iy
- ld e,(ix)
- inc ix
- ld d,(ix)
- inc ix
- push de
- ex (sp),iy
- pop de
- push bc
- ld c,(ix)
- inc ix
- ld b,(ix)
- inc ix
-1:
- ld a,b
- or c
- jr z,noteq
- ld a,(ix+0)
- cp e
- jr nz,2f
- ld a,(ix+1)
- cp d
- jr nz,2f
- ld l,(ix+2)
- ld h,(ix+3)
- jr 3f
-2: inc ix
- inc ix
- inc ix
- inc ix
- dec bc
- jr 1b
-noteq: push iy
- pop hl
-3: ld a,l
- or h
- jr z,e.case
-2:
- pop bc
- push hl
- pop ix
- jr loop
-
-
-! LIN
-lin.l: ld d,(ix)
- inc ix
-lin.s0: ld e,(ix)
- inc ix
- ld (eb+eb%2),de
- jr loop
-
-
-! FIL
-fil.z: pop hl
-1:
- ld (eb+eb%2+4),hl
- jr loop
-
-fil.l: ld h,(ix)
- inc ix
- ld l,(ix)
- inc ix
- ld de,eb+eb%2
- add hl,de
- jr 1b
-
-
-! LNI
-lni.z: ld hl,(eb+eb%2)
- inc hl
- ld (eb+eb%2),hl
- jr loop
-
-
-! RCK
-rck.z:
- ld iy,rck.2
- jr pop2
-rck.l: call long2
-rck.2:
- pop iy
-3: pop hl
- push hl
- ld e,(iy)
- ld d,(iy+1)
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
-1: xor d ! now a equals (original) h again
-2: call m,e.rck
- pop de
- push de
- ld l,(iy+2)
- ld h,(iy+3)
- ld a,h
- xor d ! check sign bit to catch overflow with subtract
- jp m,1f
- sbc hl,de
- jr 2f
-1: xor d ! now a equals (original) h again
-2: call m,e.rck
- jr loop
-
-
-! LIM
-lim.z: ld hl,(ignmask)
- jr phl
-
-
-! SIM
-sim.z: pop de
- ld (ignmask),de
- jr loop
-
-
-! LOR
-
-lor.s0: ld e,(ix)
- inc ix
- ld a,d
- or e
- jr nz,1f
- push bc
- jr loop
-1: ld hl,-1
- adc hl,de
- jr nz,1f
- add hl,sp
- jr phl
-1: ld hl,(hp)
- jr phl
-
-
-! STR
-
-str.s0: ld e,(ix)
- inc ix
- ld a,d
- or e
- jr nz,1f
- pop bc
- jr loop
-1: pop hl
- dec de
- ld a,d
- or e
- jr nz,1f
- ld sp,hl
- jr loop
-1: ld (hp),hl
- jr loop
-
-! Floating point calling routines
-
-loadfregs:
- pop hl
- pop de
- ld (fpac),de
- pop de
- ld (fpac+2),de
- pop de
- ld (fpop),de
- pop de
- ld (fpop+2),de
- jp (hl)
-
-dofltop:
- call loadfregs
- push bc
- push ix
- ld hl,1f
- push hl
- push iy
- ret ! really a call
-1:
- pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- jr phl
-
-pop4:
- pop hl
- or h
- jr nz,9f
- ld a,l
- cp 4
- jr nz,9f
- jp (iy)
-arg4:
- or d
- jr nz,9f
- ld a,(ix)
- inc ix
- cp 4
- jr nz,9f
- jp (iy)
-9: jr unimpld
-
-adf.z: ld iy,doadf
- jr pop4
-adf.l: ld d,(ix)
- inc ix
-adf.s0: ld iy,doadf
- jr arg4
-doadf:
- ld iy,fpadd ! routine to call
- jr dofltop
-
-sbf.z: ld iy,dosbf
- jr pop4
-sbf.l: ld d,(ix)
- inc ix
-sbf.s0: ld iy,dosbf
- jr arg4
-dosbf:
- ld iy,fpsub ! routine to call
- jr dofltop
-
-mlf.z: ld iy,domlf
- jr pop4
-mlf.l: ld d,(ix)
- inc ix
-mlf.s0: ld iy,domlf
- jr arg4
-domlf:
- ld iy,fpmult ! routine to call
- jr dofltop
-
-dvf.z: ld iy,dodvf
- jr pop4
-dvf.l: ld d,(ix)
- inc ix
-dvf.s0: ld iy,dodvf
- jr arg4
-dodvf:
- ld iy,fpdiv ! routine to call
- jr dofltop
-
-cmf.z: ld iy,docmf
- jr pop4
-cmf.l: ld d,(ix)
- inc ix
-cmf.s0: ld iy,docmf
- jr arg4
-docmf:
- call loadfregs
- push bc
- push ix
- call fpcmf
- pop ix
- pop bc
- ld hl,(fpac)
- jr phl
-cfi.z:
- pop de
- call chk24
- .word 1f,0f
-1: ld iy,1f
- jr pop4
-1: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcfi
- pop ix
- pop bc
- ld hl,(fpac)
- jr phl
-0: ld iy,1f
- jr pop4
-1: pop hl
- ld (fpac),hl
- pop hl
-ld (fpac+2),hl!
- push bc
- push ix
- call fpcfd
- jr 8f
-cif.z:
- ld iy,1f
- jr pop4
-1:
- pop de
- call chk24
- .word 1f,0f
-1: pop hl
- ld (fpac),hl
- push bc
- push ix
- call fpcif
-8: pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- jr phl
-0: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcdf
- jr 8b
-
-ngf.l: ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
-ngf.z:
- ld iy,1f
- jr pop4
-1: pop hl
- ld (fpac),hl
- pop hl
- ld (fpac+2),hl
- push bc
- push ix
- call fpcomp
- jr 8b
-
-fif.z:
- ld iy,1f
- jr pop4
-fif.l:
- ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
-1: call loadfregs
- push bc
- push ix
- call fpfif
- pop ix
- pop bc
- ld hl,(fpac+2)
- push hl
- ld hl,(fpac)
- push hl
- ld hl,(fpop+2)
- push hl
- ld hl,(fpop)
- jr phl
-
-fef.z:
- ld iy,1f
- jr pop4
-fef.l:
- ld d,(ix)
- inc ix
- ld iy,1f
- jr arg4
-1: pop hl
- ld (fpop),hl
- pop hl
- ld (fpop+2),hl
- push bc
- push ix
- call fpfef
- pop ix
- pop bc
- ld hl,(fpop+2)
- push hl
- ld hl,(fpop)
- push hl
- ld hl,(fpac)
- jr phl
-
-! double aritmetic
-
-adi.4:
- push bc
- pop iy
- pop hl
- pop de
- pop bc
- add hl,bc
- ex de,hl
- pop bc
- adc hl,bc
- push hl
- push de
- push iy
- pop bc
- jr loop
-sbi.4:
- push bc
- pop iy
- pop bc
- pop de
- pop hl
- sbc hl,bc
- ex de,hl
- ld b,h
- ld c,l
- pop hl
-9:
- sbc hl,bc
- push hl
- push de
- push iy
- pop bc
- jr loop
-ngi.4:
- push bc
- pop iy
- ld hl,0
- pop de
- sbc hl,de
- ex de,hl
- ld hl,0
- pop bc
- jr 9b
-mli.4:
- ld iy,.mli4
-0:
- ld (retarea),bc
- ld (retarea+2),ix
- ld hl,1f
- push hl
- push iy
- ret
-1:
- ld bc,(retarea)
- ld ix,(retarea+2)
- jr loop
-dvu.4:
- ld iy,.dvu4
- jr 0b
-
-dvi.4:
- ld iy,.dvi4
- jr 0b
-
-! list of not yet implemented instructions
-cuf.z:
-cff.z:
-cfu.z:
-unimpld: ! used in dispatch table to
- ! catch unimplemented instructions
- ld hl,EILLINS
-9: push hl
- jr trp.z
-
-eilsize:
- ld hl,EILLSIZE
- jr 9b
-
-e.case:
- ld hl,ECASE
- jr 9b
-e.mon:
- ld hl,EMON
- jr 9b
-e.array:
- push af
- ld a,(ignmask)
- bit 0,a
- jr nz,8f
- ld hl,EARRAY
- jr 9b
-e.rck:
- push af
- ld a,(ignmask)
- bit 1,a
- jr nz,8f
- ld hl,ERANGE
- jr 9b
-8:
- pop af
- ret
-
-long2: ld a,(ix)
- inc ix
- or a
- jr nz,unimpld
- ld a,(ix)
- inc ix
- cp 2
- jr nz,unimpld
- xor a ! clear carry
- ret
-
-! monitor instruction
-! a small collection of UNIX system calls implemented under CP/M
-
- ux_indir=e.mon
- ux_fork=e.mon
- ux_wait=e.mon
- ux_link=e.mon
- ux_exec=e.mon
- ux_chdir=e.mon
- ux_mknod=e.mon
- ux_chmod=e.mon
- ux_chown=e.mon
- ux_break=e.mon
- ux_stat=e.mon
- ux_seek=e.mon
- ux_mount=e.mon
- ux_umount=e.mon
- ux_setuid=e.mon
- ux_getuid=e.mon
- ux_stime=e.mon
- ux_ptrace=e.mon
- ux_alarm=e.mon
- ux_fstat=e.mon
- ux_pause=e.mon
- ux_utime=e.mon
- ux_stty=e.mon
- ux_gtty=e.mon
- ux_access=e.mon
- ux_nice=e.mon
- ux_sync=e.mon
- ux_kill=e.mon
- ux_dup=e.mon
- ux_pipe=e.mon
- ux_times=e.mon
- ux_prof=e.mon
- ux_unused=e.mon
- ux_setgid=e.mon
- ux_getgid=e.mon
- ux_sig=e.mon
- ux_umask=e.mon
- ux_chroot=e.mon
-
- EPERM = 1
- ENOENT = 2
- ESRCH = 3
- EINTR = 4
- EIO = 5
- ENXIO = 6
- E2BIG = 7
- ENOEXEC = 8
- EBADF = 9
- ECHILD = 10
- EAGAIN = 11
- ENOMEM = 12
- EACCES = 13
- EFAULT = 14
- ENOTBLK = 15
- EBUSY = 16
- EEXIST = 17
- EXDEV = 18
- ENODEV = 19
- ENOTDIR = 20
- EISDIR = 21
- EINVAL = 22
- ENFILE = 23
- EMFILE = 24
- ENOTTY = 25
- ETXTBSY = 26
- EFBIG = 27
- ENOSPC = 28
- ESPIPE = 29
- EROFS = 30
- EMLINK = 31
- EPIPE = 32
- EDOM = 33
-! Structure of filearea maintained by this implementation
-! First iobuffer of 128 bytes
-! Then the fcb area of 36 bytes
-! The number of bytes left in the buffer, 1 byte
-! The iopointer into the buffer, 2 bytes
-! The openflag 0 unused, 1 reading, 2 writing, 1 byte
-! The filedescriptor starting at 3, 1 byte
-! The number of CTRL-Zs that have been absorbed, 1 byte
-! The byte read after a sequence of CTRL-Zs, 1 byte
-
- maxfiles=8
- filesize=128+36+1+2+1+1+1+1
-
- filefcb=0 ! pointers point to fcb
- position=33
- nleft=36
- iopointer=37
- openflag=39
- fildes=40
- zcount=41
- zsave=42
-
- .errnz filefcb
-
-0: .space maxfiles*filesize
- filearea = 0b+128
-sibuf:
- .word 0
- .space 82
-siptr: .space 2
-saveargs:
- .space 128
-argv: .space 40 ! not more than 20 args
-argc: .space 2
-ttymode:.byte 9,9,8,21;.short 06310+RAW*040 ! raw = 040
-
-uxinit:
- xor a
- ld c,maxfiles
- ld hl,0b
-1: ld b,filesize
-2: ld (hl),a
- inc hl
- djnz 2b
- dec c
- jr nz,1b
- ret
-
-uxfinish:
- ld a,maxfiles-1
-1: push af
- call closefil
- pop af
- dec a
- cp 0377
- jr nz,1b
- ret
-
-makeargv:
- ld hl,0x80
- ld de,saveargs
- ld bc,128
- ldir
- ld hl,saveargs
- ld e,(hl)
- inc hl
- ld d,0
- add hl,de
- ld (hl),0
- ld hl,saveargs+1
- ld ix,argv
-1: ld a,(hl)
- or a
- jr z,9f
- cp ' '
- jr nz,2f
-4: ld (hl),0
- inc hl
- jr 1b
-2: ld (ix),l
- inc ix
- ld (ix),h
- inc ix
-3: inc hl
- ld a,(hl)
- or a
- jr z,9f
- cp ' '
- jr nz,3b
- jr 4b
-9: push ix
- pop hl
- ld de,-argv
- add hl,de
- srl h;rr l
- ld (argc),hl
- ld (ix+0),0
- ld (ix+1),0
- ret
-
-mon.z:
- pop de ! system call number
- xor a
- or d
- jr nz,unimpld ! too big
- ld a,e
- and 0300 ! only 64 system calls
- jr nz,unimpld
- sla e
- ld hl,systab
- add hl,de
- ld e,(hl)
- inc hl
- ld d,(hl)
- ex de,hl
- jp (hl)
-
-systab:
- .word ux_indir
- .word ux_exit
- .word ux_fork
- .word ux_read
- .word ux_write
- .word ux_open
- .word ux_close
- .word ux_wait
- .word ux_creat
- .word ux_link
- .word ux_unlink
- .word ux_exec
- .word ux_chdir
- .word ux_time
- .word ux_mknod
- .word ux_chmod
- .word ux_chown
- .word ux_break
- .word ux_stat
- .word ux_seek
- .word ux_getpid
- .word ux_mount
- .word ux_umount
- .word ux_setuid
- .word ux_getuid
- .word ux_stime
- .word ux_ptrace
- .word ux_alarm
- .word ux_fstat
- .word ux_pause
- .word ux_utime
- .word ux_stty
- .word ux_gtty
- .word ux_access
- .word ux_nice
- .word ux_ftime
- .word ux_sync
- .word ux_kill
- .word unimpld
- .word unimpld
- .word unimpld
- .word ux_dup
- .word ux_pipe
- .word ux_times
- .word ux_prof
- .word ux_unused
- .word ux_setgid
- .word ux_getgid
- .word ux_sig
- .word unimpld
- .word unimpld
- .word unimpld
- .word unimpld
- .word unimpld
- .word ux_ioctl
- .word unimpld
- .word unimpld
- .word unimpld
- .word unimpld
- .word ux_exece
- .word ux_umask
- .word ux_chroot
- .word unimpld
- .word unimpld
-
-emptyfile:
- ! searches for a free filestructure
- ! returns pointer in iy, 0 if not found
- ld iy,filearea
- ld l,maxfiles
-1:
- xor a
- or (iy+openflag)
- jr nz,3f
- ld a,maxfiles+3
- sub l
- ld (iy+fildes),a
-#ifdef CPM1
- push bc
- push iy
- ld de,-128
- add iy,de
- push iy
- pop de
- ld c,setdma
- call bdos
- pop iy
- pop bc
- or a ! to clear C
-#endif
- ret
-3:
- ld de,filesize
- add iy,de
- dec l
- jr nz,1b
- scf
- ret
-
-findfile:
- ld iy,filearea
- ld de,filesize
-0:
- dec a
- ret m
- add iy,de
- jr 0b
-
-getchar:
- push bc
- push de
- push hl
- dec (iy+nleft)
- jp p,0f
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld (iy+iopointer),l
- ld (iy+iopointer+1),h
- ex de,hl
- push iy
- ld c,setdma
- call bdos
-#ifdef CPM1
- ld c,seqread
-#else
- ld c,randomread
-#endif
- pop de
- call bdos
- or a
- jr z,1f
- ld (iy+zcount),0
- pop hl
- pop de
- pop bc
- scf
- ret
-1:
- inc (iy+position)
- jr nz,2f
- inc (iy+position+1)
-2:
- ld a,127
- ld (iy+nleft),a
-0:
- ld h,(iy+iopointer+1)
- ld l,(iy+iopointer)
- ld a,(hl)
- inc hl
- ld (iy+iopointer),l
- ld (iy+iopointer+1),h
- pop hl
- pop de
- pop bc
- ret
- or a
-
-putchar:
- push hl
- ld h,(iy+iopointer+1)
- ld l,(iy+iopointer)
- ld (hl),a
- dec (iy+nleft)
- jr z,0f
- inc hl
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- pop hl
- ret
-0:
- pop hl
-flsbuf:
- push hl
- push de
- push bc
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- ex de,hl
- push iy
- ld c,setdma
- call bdos
- pop de
-#ifdef CPM1
- ld c,seqwrite
-#else
- ld c,randomwrite
-#endif
- call bdos
- or a
- jr z,1f
- pop bc
- pop de
- pop hl
- scf
- ret
-1:
- inc (iy+position)
- jr nz,2f
- inc (iy+position+1)
-2:
- ld a,128
- ld (iy+nleft),a
- ld b,a
- push iy
- pop hl
- ld de,-128
- add hl,de
- ld a,26 ! ctrl z
-1: ld (hl),a
- inc hl
- djnz 1b
- pop bc
- pop de
- pop hl
- or a
- ret
-
-parsename:
- ! parses file name pointed to by hl and fills in fcb
- ! of the file pointed to by iy.
- ! recognizes filenames as complicated as 'b:file.zot'
- ! and as simple as 'x'
-
- push bc
- push iy
- pop de
- xor a
- push de
- ld b,36 ! sizeof fcb
-0: ld (de),a
- inc de
- djnz 0b
- pop de
- inc hl
- ld a,(hl)
- dec hl
- cp ':' ! drive specified ?
- jr nz,1f
- ld a,(hl)
- inc hl
- inc hl
- dec a
- and 15
- inc a ! now 1<= a <= 16
- ld (de),a
-1: inc de
- ld b,8 ! filename maximum of 8 characters
-1: ld a,(hl)
- or a
- jr nz,8f
- dec hl
- ld a,'.'
-8:
- inc hl
- cp '.'
- jr z,2f
- and 0177 ! no parity
- bit 6,a
- jr z,9f
- and 0337 ! UPPER case
-9:
- ld (de),a
- inc de
- djnz 1b
- ld a,(hl)
- inc hl
- cp '.'
- jr z,3f
- ld a,' '
- ld (de),a
- inc de
- ld (de),a
- inc de
- ld (de),a
- pop bc
- ret ! filenames longer than 8 are truncated
-2: ld a,' ' ! fill with spaces
-0: ld (de),a
- inc de
- djnz 0b
-3: ld b,3 ! length of extension
-1: ld a,(hl)
- inc hl
- or a
- jr z,4f
- cp 0100
- jp m,2f
- and 0137
-2: ld (de),a
- inc de
- djnz 1b
- pop bc
- ret
-4: ld a,' '
-0: ld (de),a
- inc de
- djnz 0b
- pop bc
- ret
-
-! various routines
-ux_close:
- pop hl
- ld a,l
- sub 3
- jp m,1f
- cp maxfiles
- call m,closefil
-1: ld hl,0
- jr phl
-
-closefil:
- call findfile
- ld a,(iy+openflag)
- or a
- jr z,3f
- ld (iy+openflag),0
- cp 1
- jr z,2f
- ld a,(iy+nleft)
- cp 128
- jr z,2f
- call flsbuf
-2:
- push bc
- push iy
- pop de
- ld c,close
- call bdos
- pop bc
-3: ret
-
-ux_ioctl:
- pop hl
- ld a,l
- sub 3
- jp p,1f
- pop hl
- ld a,h
- cp 't'
- jr nz,e.mon
- ld a,l
- cp 8
- jr z,tiocgetp
- cp 9
- jr z,tiocsetp
- jr e.mon
-1: pop hl
- pop hl
- ld hl,-1
- jr phl
-tiocgetp:
- pop de
- ld hl,ttymode
-2: push bc
- ld bc,6
- ldir
- ld h,b
- ld l,c
- pop bc
- jr phl
-tiocsetp:
- pop hl
- ld de,ttymode
- jr 2b
-
-ux_time:
- call time4
- jr loop
-
-ux_ftime:
- pop hl
- ld (retarea+6),hl
- call time4
- ld hl,(retarea+6)
- pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- pop de
- ld (hl),e
- inc hl
- ld (hl),d
- inc hl
- xor a
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- inc hl
- ld (hl),a
- jr loop
-
-time4:
- pop hl
- ld (retarea),bc
- ld (retarea+2),ix
- ld (retarea+4),hl
- ld hl,(timebuf+2)
- push hl
- ld hl,(timebuf)
- push hl
- ld hl,0
- push hl
- ld hl,50
- push hl
- call .dvu4
- ld bc,(retarea)
- ld ix,(retarea+2)
- ld hl,(retarea+4)
- jp (hl)
-ux_exit:
- call uxfinish
- ld c,reset
- call bdos
- ! no return
-
-ux_creat:
- call emptyfile
- jr c,openfailed
- pop hl
- call parsename
- pop hl ! file mode, not used under CP/M
- push bc
- push iy
- push iy
- pop de
- ld c,delete
- call bdos
- pop de
- ld c,makefile
- call bdos
- pop bc
- ld l,1
- jr afteropen
-ux_open:
- call emptyfile
- jr nc,1f
-openfailed:
- pop hl
- pop hl ! remove params
- ld hl,EMFILE
- push hl
- jr phl
-1:
- pop hl ! filename
- call parsename
- push bc
- ld c,open
- push iy
- pop de
- call bdos
- pop bc
- pop hl
-afteropen:
- inc a
- jr nz,1f
- ld hl,ENOENT
- push hl
- jr phl
-1:
- inc l
- ld (iy+openflag),l
- xor a
- ld (iy+nleft),a
- ld (iy+zcount),a
- ld (iy+zsave),26
- bit 1,l
- jr z,2f
- ld (iy+nleft),128
-2:
- ld (iy+position),a
- ld (iy+position+1),a
- push iy
- pop hl
- push bc
- ld b,128
-3: dec hl
- ld (hl),26
- djnz 3b
- pop bc
- ld (iy+iopointer+1),h
- ld (iy+iopointer),l
- ld h,a
- ld l,(iy+fildes)
- push hl
- ld l,a
- jr phl
-
-ux_read:
- pop hl
- ld a,l
- sub 3
- jp p,readfile
- ld a,(ttymode+4)
- bit 5,a
- jr z,1f ! not raw
- push bc
-#ifdef CPM1
-!raw echo interface
- ld c,consolein
- call bdos
-#else
-!no echo interface
-4:
- ld c,diconio
- ld e,0xff
- call bdos
- or a
- jr z,4b
-!end of no echo interface
-#endif
- pop bc
- pop hl
- ld (hl),a
- pop hl
- ld hl,1
- push hl
- ld hl,0
- jr phl
-1:
- ld hl,sibuf+1 ! read from console assumed
- dec (hl)
- jp p,2f
- dec hl ! go read console line
- ld (hl),80 ! max line length
- push bc
- push hl
- ld c,readconsole
- ex de,hl
- call bdos
- ld c,writeconsole
- ld e,'\n'
- call bdos
- pop hl
- pop bc
- inc hl
- inc (hl)
- ld (siptr),hl ! ready for transfer
- push hl
- ld e,(hl)
- ld d,0
- add hl,de
- ld (hl),'\r'
- inc hl
- ld (hl),'\n'
- pop hl
-2:
- push bc
- pop iy
- ld b,(hl)
- inc b ! bytes remaining
- pop hl ! copy to
- pop de ! bytes wanted (probably 512)
- push iy
- ld iy,(siptr) ! copy from
- xor a ! find out minimum of ramaining and wanted
- or d
- jr nz,3f ! more than 255 wanted (forget that)
- ld a,b
- cp e
- jp m,3f ! not enough remaining
- ld b,e
-3:
- ld c,b ! keep copy
-0:
- inc iy
- ld a,(iy)
- ld (hl),a
- inc hl
- djnz 0b
- ld a,(sibuf+1)
- sub c
- inc a
- ld (sibuf+1),a
- ld (siptr),iy
- pop hl
- push bc
- ld c,b
- push bc ! load 0
- ld b,h
- ld c,l
- jr loop
-readfile:
- call findfile
- pop de
- pop hl ! count
- push bc
- ld bc,0
-0:
- xor a
- or l
- jr z,1f
- dec l
-3:
-! warning: this may not work if zcount overflows
- ld a,(iy+zcount)
- or a
- jr nz,5f
- ld a,(iy+zsave)
- cp 26
- jr z,4f
- ld (iy+zsave),26
- jr 8f
-4:
- call getchar
- jr c,2f
- ld (de),a
- sub 26 ! CTRL-Z
- jr z,7f
- ld a,(iy+zcount)
- or a
- jr z,6f
- ld a,(de)
- ld (iy+zsave),a
-5:
- ld a,26
- dec (iy+zcount)
-8:
- ld (de),a
-6:
- inc de
- inc bc
- jr 0b
-1:
- dec l
- dec h
- jp p,3b
-2:
- pop hl
- push bc
- ld b,h
- ld c,l
- ld hl,0
- jr phl
-7:
- inc (iy+zcount)
- jr 4b
-
-ux_write:
- pop hl
- ld a,l
- sub 3
- jp p,writefile
- pop hl ! buffer address
- pop de ! count
- push de
- ld iy,0
- push iy
- push bc
- ld b,e ! count now in 'db'
-0:
- ld a,b
- or a
- jr nz,1f
- ld a,d
- or a
- jr nz,2f
- pop bc
- jr loop
-2:
- dec d
-1:
- dec b
- ld e,(hl)
- inc hl
- push bc
- push de
- push hl
- ld c,writeconsole
- call bdos
- pop hl
- pop de
- pop bc
- jr 0b
-writefile:
- call findfile
- pop de
- pop hl ! count
- push bc
- ld bc,0
-0:
- xor a
- or l
- jr z,1f
- dec l
-3:
- ld a,(de)
- inc de
- call putchar
- jr c,4f
- inc bc
- jr 0b
-1:
- dec l
- dec h
- jp p,3b
- ld iy,0
-2:
- pop hl
- push bc
- ld b,h
- ld c,l
- push iy
- jr loop
-4:
- ld iy,ENOSPC
- jr 2b
-
-ux_unlink:
- pop hl
- ld iy,fcb
- call parsename
- push bc
- ld c,delete
- ld de,fcb
- call bdos
- pop bc
- inc a
- jr nz,1f
- ld hl,ENOENT
- jr phl
-1:
- ld hl,0
- jr phl
-
-ux_getpid:
- ld hl,12345 ! nice number
- jr phl
-
-ux_exece:
- ld iy,fcb
- pop hl
- call parsename
- pop hl
- ld b,h;ld c,l
- pop iy
- ld ix,0x82
- ld (ix-1),' '
-4: ld h,b;ld l,c
-3: ld e,(hl)
- inc hl
- ld d,(hl)
- inc hl
- ld b,h;ld c,l
- ex de,hl
- ld a,h
- or l
- jr z,1f
-2:
- ld a,(hl)
- inc hl
- ld (ix),a
- inc ix
- or a
- jr nz,2b
- ld (ix-1),' '
- jr 4b
-1:
- ld (ix),'X'
- ld (ix+1),'\r'
- ld (ix+2),'\n'
- ld (ix+3),'$'
- ld de,0x81
- push ix
- ld c,printstring
- call bdos
- pop hl
- ld de,-129
- add hl,de
- ld a,l
- ld (0x80),a
- jr warmstart
-
-
-
-
-dispat1: ! base for escaped opcodes
-.word aar.l, aar.z, adf.l, adf.z, adi.l, adi.z, ads.l, ads.z
-.word adu.l, adu.z, and.l, and.z, asp.l, ass.l, ass.z, bge.l
-.word bgt.l, ble.l, blm.l, bls.l, bls.z, blt.l, bne.l, cai.z
-.word cal.l, cfi.z, cfu.z, ciu.z, cmf.l, cmf.z, cmi.l, cmi.z
-.word cms.l, cms.z, cmu.l, cmu.z, com.l, com.z, csa.l, csa.z
-.word csb.l, csb.z, cuf.z, cui.z, cuu.z, dee.l, del.p, del.n
-.word dup.l, dus.l, dus.z, dvf.l, dvf.z, dvi.l, dvi.z, dvu.l
-.word dvu.z, fef.l, fef.z, fif.l, fif.z, inl.p, inl.n, inn.l
-.word inn.z, ior.l, ior.z, lar.l, lar.z, ldc.l, ldf.l, ldl.p
-.word ldl.n, lfr.l, lil.p, lil.n, lim.z, los.l, los.z, lor.s0
-.word lpi.l, lxa.l, lxl.l, mlf.l, mlf.z, mli.l, mli.z, mlu.l
-.word mlu.z, mon.z, ngf.l, ngf.z, ngi.l, ngi.z, nop.z, rck.l
-.word rck.z, ret.l, rmi.l, rmi.z, rmu.l, rmu.z, rol.l, rol.z
-.word ror.l, ror.z, rtt.z, sar.l, sar.z, sbf.l, sbf.z, sbi.l
-.word sbi.z, sbs.l, sbs.z, sbu.l, sbu.z, sde.l, sdf.l, sdl.p
-.word sdl.n, set.l, set.z, sig.z, sil.p, sil.n, sim.z, sli.l
-.word sli.z, slu.l, slu.z, sri.l, sri.z, sru.l, sru.z, sti.l
-.word sts.l, sts.z, str.s0, tge.z, tle.z, trp.z, xor.l, xor.z
-.word zer.l, zer.z, zge.l, zgt.l, zle.l, zlt.l, zne.l, zrf.l
-.word zrf.z, zrl.p, dch.z, exg.s0, exg.l, exg.z, lpb.z
-
-dispat2: ! base for 4 byte offsets
-.word ldc.f
-
-
-ignmask: .word 0 ! ignore mask (variable)
-retarea: .word 0 ! base of buffer for result values (max 8 bytes)
- .word 0
- .word 0
- .word 0
-
-trapproc:
- .word 0
-
-nextp: .byte 0
-
-header:
-ntext: .word 0
-ndata: .word 0
-nproc: .word 0
-entry: .word 0
-nline: .word 0
-
-hp: .word 0
-pb: .word 0
-pd: .word 0
+++ /dev/null
-! floating point pakket voor Z80
-! geimplementeerd zoals beschreven in
-! Electronica top internationaal.
-! September 1979
-! Auteur: Hr. R. Beverdam, Zuidbroekweg 9,7642 NW Wierden
-
-xa: .space 1
-fpac:
-fal: .space 1
-fan: .space 1
-fam: .space 1
-fax: .space 1
-xo: .space 1
-fpop:
-fol: .space 1
-fon: .space 1
-fom: .space 1
-fox: .space 1
- .errnz xa/256-fox/256
-
-fpsub:
- call fpcomp ! inverteer fpacc
-fpadd:
- ld de,(fam) ! d fax,e fam
- ld bc,(fom) ! b fox,c fom
- ld a,e ! test fpacc
- or a ! 0?
- jr z,movop ! ja: som=fpop dus verplaats
- xor a
- add a,c
- ret z ! som is dus fpacc, klaar
- ld a,b
- sub d ! a:=fox-fax
- ld l,a ! bewaar verschil exponenten
- jp p,skpneg ! maak positief
- neg
-skpneg:
- cp 0x18 ! verschil meer dan 23?
- ld a,l
- jp m,lineup ! spring indien binnen bereik
- and a ! getallen te groot tov elkaar
- ret m ! klaar als fpacc het grootst
-movop:
- ld hl,fol ! verplaats fpop naar fpacc
- ld de,fal ! want fpop is het antwoord
- ld bc,4
- ldir
- ret
-lineup:
- and a ! kijk welke groter is
- jp m,shifto ! spring als fpop>fpac
- inc a ! bereken sa
- ld b,a ! save sa in b register
- ld a,1 ! so 1
- push af ! bewaar so op stapel
- jr shacop ! gr schuiven
-shifto:
- neg ! bereken fox-fax
-eqexp:
- inc a ! so 1+(fox-fax)
- push af ! bewaar so op stapel
- ld b,1 ! sa 1
-shacop:
- ld hl,(fal) ! l fal,h fan
- xor a ! xa 0
-moracc:
- sra e ! schuif fam
- rr h ! fan
- rr l ! fal
- rra ! xa
- inc d ! update voor fax
- djnz moracc ! herhaal sa keer
- ld (xa),a ! berg alles
- ld (fal),hl ! weg in
- ld (fam),de ! fpacc en xa
- pop af ! haal so terug van stapel
- ld b,a ! en zet in b register
- xor a ! xo 0
- ld hl,(fol) ! l fol,h fon
-morop:
- sra c ! schuif: fom
- rr h ! fon
- rr l !
- rra ! xo
- djnz morop ! herhaal so keer
- ld (xo),a
- ld (fol),hl
- ld (fom),bc ! berg alles weg in fpop en xo
- ld de,xa
- ld hl,xo
- ld b,4
- or a ! reset carry
-addmor:
- ld a,(de) ! haal een byte
- adc a,(hl) ! tel er een bij op
- ld (de),a ! en berg de som weer op
- inc e
- inc l
- djnz addmor ! herhaal dit 4 keer
- jr fpnorm
-
-fpmult:
- call setsgn
- add a,(hl) ! bereken exponent produkt
- ld (hl),a ! fax exponent produkt
- ld l,fom%256
- ex de,hl ! gebruik de als wijzer
- xor a
- ld h,a
- ld l,a ! hoogste 16 bits van pp worden nul
- exx
- ld bc,(fal)
- ld de,(fam) ! haal mc in registers
- ld d,a ! d:=0 tbv 16-bit add
- ld h,a
- ld l,a ! middelste 16 bits van pp worden nul
- ld ix,0 ! laagste 16 bits ook
- exx
- ld c,3
-mult:
- ld a,(de) ! haal een byte van mr
- dec e
- ld b,8 ! bits in a byte
-shift:
- rla ! schuif vooste bit in carry
- exx
- jr nc,noadd ! vooste bit is 0, dan niet optellen
- add ix,bc ! pp:=pp+mc
- adc hl,de ! continued
-noadd:
- add ix,ix
- adc hl,hl
- exx
- adc hl,hl ! dit schoof het hele partiele produkt <
- djnz shift ! herhaal voor alle 8 bits
- dec c
- jr nz,mult ! herhaal voor 3 bytes
- exx
- rl l
- rla
- add a,h
- ld (fal),a
- ld a,d
- exx
- adc a,l
- ld (fan),a ! rond getal in pp af en berg resultaat op
- ld a,c
- adc a,h
- ld (fam),a
- call fpnorm
-exmldv:
- ld hl,xa
- ld c,(hl)
- jp resign ! fix sign
-
-fpdiv:
- call setsgn
- sub (hl)
- ld (hl),a ! berg exponent quotient op
- ld hl,(fol)
- push hl
- pop ix
- ld de,(fal)
- ld a,(fam)
- or a ! fpacc = 0 ?
- jr z,fperr ! fout, deling door nul
- ld b,a ! b:=fam
- ld a,(fom)
- ld c,a
- exx
- ld hl,fam
- ld e,3
-divide:
- ld b,8
-mordiv:
- exx
- and a
- sbc hl,de
- sbc a,b ! probeer de aftrekking
- jp m,nogo ! gaat niet
- push hl
- pop ix
- ld c,a
- ex af,af2 ! quotient in tweede accumulator
- scf
- jr quorot
-nogo:
- ex af,af2
- or a
-quorot:
- rla ! volgende bit in quotient
- ex af,af2
- add ix,ix ! schuif eventueel vernieuwde
- rl c ! dd naar links
- push ix
- pop hl
- ld a,c ! zet nieuwe dd in rekenregisters
- exx
- djnz mordiv ! herhaal 8 keer
- ex af,af2
- ld (hl),a ! zet een byte van het quotient in het geheugen
- dec l
- ex af,af2
- dec e
- jr nz,divide ! herhaal 3 keer
- ld bc,(fal)
- ld hl,(fam) ! haal quotient terug in cpu
- bit 7,l
- jp z,exmldv ! als niet te groot tekenherstellen
- ld a,1 ! wel te groot
- add a,c ! eerst getal afronden
- ld c,a
- ld a,e
- adc a,b
- ld b,a
- ld a,e
- adc a,l
- ld l,a
-shft:
- inc h ! nu getal naar rechts schuiven
- rr l
- rr b
- rr c
- or a
- bit 7,l
- jr nz,shft ! door afronding weer te groot
- ld (fal),bc
- ld (fam),hl
- jr exmldv ! inspecteer teken
-setsgn:
- ld a,(fom) ! ******** setsgn ************
- ld c,1 ! teken -1
- rlca ! fpop 0 ?
- jr nc,tstacc ! nee
- rrc c ! ja, dus teken:=teken*(-1)
- ld hl,fol ! en inverteer fpop
- call complm
-tstacc:
- ld a,(fam)
- rlca ! fpacc 0?
- jr nc,init ! nee
- rrc c ! ja dus teken:=teken*(-1)
- call fpcomp
-init:
- ld hl,xa ! initialiseer nog een paar registers
- ld (hl),c
- ld a,(fox)
- ld l,fax%256
- ret
-
-fpcif:
- ld de,(fpac) ! integer to convert
- xor a
- sra d
- rr e
- rr a
- ld (fan),de
- ld (fal),a
- ld a,16
- ld (fax),a
- jr fpnorm
-
-fpcfi:
- ld a,(fax)
- dec a
- jp m,fpzero ! really integer zero here
- sub 15
- jp p,fperr ! overflow
- ld de,(fan)
- inc a
- neg
- jr z,2f
- ld b,a
- ld a,(fal)
-1:
- sra d
- rr e
- rr a
- djnz 1b
-2:
- bit 7,d
- jr z,0f
- inc de
-0:
- ld (fpac),de
- ret
-
-fpcdf:
- ld de,(fpac)
- ld bc,(fpac+2)
- ld h,31
-3:
- ld a,b
- and 0300
- jr z,1f
- cp 0300
- jr z,1f
- or a
- jp p,2f
- sra b
- rr c
- rr d
- inc h
-2:
- ld a,h
- ld (fax),a
- ld (fan),bc
- ld a,d
- ld (fal),a
- ret
-1:
- sla e
- rl d
- rl c
- rl b
- dec h
- jr 3b
-
-fpcfd:
- ld a,(fax)
- dec a
- jp m,fpzero
- cp 32
- jp p,fperr
- sub 31
- cpl
- ld bc,(fan)
- ld de,(fal)
- ld d,e
- ld e,0
-1:
- dec a
- jp m,2f
- sra b
- rr c
- rr d
- rr e
- jr 1b
-2:
- bit 7,b
- jr z,3f
- sla e
- rl d
- rl c
- rl b
-3:
- ld (fpac+2),bc
- ld (fpac),de
- ret
-fpfef:
- ld a,(fox)
- ld (fpac),a
-9:
- bit 7,a
- jr z,1f
- ld a,0xFF
- jr 2f
-1:
- xor a
-2:
- ld (fpac+1),a
- xor a
- ld (fox),a
- ret
-fpcmf:
- call fpsub
- ld a,(fam)
- ld (fpac),a
- jr 9b
-fpfif:
- call fpmult
- ld a,(fax)
- dec a
- jp m,intzero
- inc a
- ld b,a
- xor a
- ld c,0200
- ld d,a
- ld e,a
-1:
- sra c
- rr d
- rr e
- djnz 1b
- ld hl,fam
- ld b,(hl)
- ld a,c
- and b
- ld (fom),a
- ld a,c
- xor 0177
- and b
- ld (hl),a
- dec l
- ld b,(hl)
- ld a,d
- and b
- ld (fon),a
- ld a,d
- cpl
- and b
- ld (hl),a
- dec l
- ld b,(hl)
- ld a,e
- and b
- ld (fol),a
- ld a,e
- cpl
- and b
- ld (hl),a
- ld a,(fax)
- ld (fox),a
- jr fpnorm
-intzero:
- xor a
- ld hl,fol
- ld b,4
-1: ld (hl),a
- inc hl
- djnz 1b
- ret
-
-fpzero:
- xor a
- ld h,a
- ld l,a
- ld (fal),hl
- ld (fam),hl
- ret
-
-fpnorm:
- ld a,(fam)
- ld c,a
- or a ! fpacc < 0 ?
- call m,fpcomp ! ja -- inverteer
- ld hl,(fal)
- ld de,(fam)
- ld a,l
- or h
- or e
- jr z,fpzero ! als hele facc 0 is
- ld a,e
-mortst:
- bit 6,a ! test meest significante bit
- jr nz,catch ! stop als bit is 1
- add hl,hl ! schuif links zolang bit = 0
- adc a,a
- dec d ! pas fax ook aan
- jr mortst
-catch:
- ld e,a ! herstel nu fpacc in geheugen
- ld (fal),hl
- ld (fam),de
-resign:
- bit 7,c ! test op teken
- ret z ! positief, geen actie
-fpcomp:
- ld hl,fal
-complm:
- ld b,3 ! inverteer alleen mantisse
- xor a
-morcom:
- sbc a,(hl)
- ld (hl),a
- inc hl
- ld a,0
- djnz morcom
- or a
- ret
-fperr:
- scf
- ret
+++ /dev/null
-.define .mli4
-
-! 32-bit multiply routine for z80
-! parameters:
-! on stack
-
-
-
-! register utilization:
-! ix: least significant 2 bytes of result
-! hl: most significant 2 bytes of result
-! bc: least significant 2 bytes of multiplicand
-! de: most significant 2 bytes of multiplicand
-! iy: 2 bytes of multiplier (first most significant,
-! later least significant)
-! a: bit count
-.mli4:
- !initialization
- pop hl ! return address
- pop de
- ld (.mplier+2),de! least significant bytes of
- ! multiplier
- pop de
- ld (.mplier),de ! most sign. bytes
- pop de ! least significant bytes of
- ! multiplicand
- pop bc ! most sign. bytes
- push hl ! return address
- push iy ! LB
- ld ix,0
- xor a
- ld h,a ! clear result
- ld l,a
- ld (.flag),a ! indicate that this is
- ! first pass of main loop
- ld iy,(.mplier)
- ! main loop, done twice, once for each part (2 bytes)
- ! of multiplier
-1:
- ld a,16
- ! sub-loop, done 16 times
-2:
- add iy,iy ! shift left multiplier
- jr nc,3f ! skip if most sign. bit is 0
- add ix,de ! 32-bit add
- adc hl,bc
-3:
- dec a
- jr z,4f ! done with this part of multiplier
- add ix,ix ! 32-bit shift left
- adc hl,hl
- jr 2b
-4:
- ! see if we have just processed the first part
- ! of the multiplier (flag = 0) or the second
- ! part (flag = 1)
- ld a,(.flag)
- or a
- jr nz,5f
- inc a ! a := 1
- ld (.flag),a ! set flag
- ld iy,(.mplier+2)! least significant 2 bytes now in iy
- add ix,ix ! 32-bit shift left
- adc hl,hl
- jr 1b
-5:
- ! clean up
- pop iy ! restore LB
- ex (sp),hl ! put most sign. 2 bytes of result
- ! on stack; put return address in hl
- push ix ! least sign. 2 bytes of result
- jp (hl) ! return
-.data
-.flag: .byte 0
-.mplier: .space 4
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../../h -I. -DNDEBUG
-PFLAGS=
-CFLAGS=$(PREFLAGS) $(PFLAGS) -O
-LDFLAGS=-i $(PFLAGS)
-LINTOPTS=-hbxac
-LIBS=../../../lib/em_data.a
-CDIR=../../proto/cg
-CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
- $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
- $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
- $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
-OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
- move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
-
-all:
- make tables.c
- make cg
-
-cg: tables.o $(OFILES)
- cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
-
-tables.o: tables.c
- cc -c $(PREFLAGS) -I$(CDIR) tables.c
-
-codegen.o: $(CDIR)/codegen.c
- cc -c $(CFLAGS) $(CDIR)/codegen.c
-compute.o: $(CDIR)/compute.c
- cc -c $(CFLAGS) $(CDIR)/compute.c
-equiv.o: $(CDIR)/equiv.c
- cc -c $(CFLAGS) $(CDIR)/equiv.c
-fillem.o: $(CDIR)/fillem.c
- cc -c $(CFLAGS) $(CDIR)/fillem.c
-gencode.o: $(CDIR)/gencode.c
- cc -c $(CFLAGS) $(CDIR)/gencode.c
-glosym.o: $(CDIR)/glosym.c
- cc -c $(CFLAGS) $(CDIR)/glosym.c
-main.o: $(CDIR)/main.c
- cc -c $(CFLAGS) $(CDIR)/main.c
-move.o: $(CDIR)/move.c
- cc -c $(CFLAGS) $(CDIR)/move.c
-nextem.o: $(CDIR)/nextem.c
- cc -c $(CFLAGS) $(CDIR)/nextem.c
-reg.o: $(CDIR)/reg.c
- cc -c $(CFLAGS) $(CDIR)/reg.c
-regvar.o: $(CDIR)/regvar.c
- cc -c $(CFLAGS) $(CDIR)/regvar.c
-salloc.o: $(CDIR)/salloc.c
- cc -c $(CFLAGS) $(CDIR)/salloc.c
-state.o: $(CDIR)/state.c
- cc -c $(CFLAGS) $(CDIR)/state.c
-subr.o: $(CDIR)/subr.c
- cc -c $(CFLAGS) $(CDIR)/subr.c
-var.o: $(CDIR)/var.c
- cc -c $(CFLAGS) $(CDIR)/var.c
-
-install: all
- ../install cg
-
-cmp: all
- -../compare cg
-
-
-tables.c: table
- -mv tables.h tables.h.save
- ../../../lib/cpp -P table | ../../../lib/cgg > debug.out
- -if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
- -if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
-
-lint: $(CFILES)
- lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
-clean:
- rm -f *.o tables.c tables.h debug.out cg tables.h.save
-
-codegen.o: $(CDIR)/assert.h
-codegen.o: $(CDIR)/data.h
-codegen.o: $(CDIR)/equiv.h
-codegen.o: $(CDIR)/extern.h
-codegen.o: $(CDIR)/param.h
-codegen.o: $(CDIR)/result.h
-codegen.o: $(CDIR)/state.h
-codegen.o: tables.h
-codegen.o: $(CDIR)/types.h
-compute.o: $(CDIR)/assert.h
-compute.o: $(CDIR)/data.h
-compute.o: $(CDIR)/extern.h
-compute.o: $(CDIR)/glosym.h
-compute.o: $(CDIR)/param.h
-compute.o: $(CDIR)/result.h
-compute.o: tables.h
-compute.o: $(CDIR)/types.h
-equiv.o: $(CDIR)/assert.h
-equiv.o: $(CDIR)/data.h
-equiv.o: $(CDIR)/equiv.h
-equiv.o: $(CDIR)/extern.h
-equiv.o: $(CDIR)/param.h
-equiv.o: $(CDIR)/result.h
-equiv.o: tables.h
-equiv.o: $(CDIR)/types.h
-fillem.o: $(CDIR)/assert.h
-fillem.o: $(CDIR)/data.h
-fillem.o: $(CDIR)/extern.h
-fillem.o: mach.c
-fillem.o: mach.h
-fillem.o: $(CDIR)/param.h
-fillem.o: $(CDIR)/regvar.h
-fillem.o: $(CDIR)/result.h
-fillem.o: tables.h
-fillem.o: $(CDIR)/types.h
-gencode.o: $(CDIR)/assert.h
-gencode.o: $(CDIR)/data.h
-gencode.o: $(CDIR)/extern.h
-gencode.o: $(CDIR)/param.h
-gencode.o: $(CDIR)/result.h
-gencode.o: tables.h
-gencode.o: $(CDIR)/types.h
-glosym.o: $(CDIR)/glosym.h
-glosym.o: $(CDIR)/param.h
-glosym.o: tables.h
-glosym.o: $(CDIR)/types.h
-main.o: $(CDIR)/param.h
-move.o: $(CDIR)/assert.h
-move.o: $(CDIR)/data.h
-move.o: $(CDIR)/extern.h
-move.o: $(CDIR)/param.h
-move.o: $(CDIR)/result.h
-move.o: tables.h
-move.o: $(CDIR)/types.h
-nextem.o: $(CDIR)/assert.h
-nextem.o: $(CDIR)/data.h
-nextem.o: $(CDIR)/extern.h
-nextem.o: $(CDIR)/param.h
-nextem.o: $(CDIR)/result.h
-nextem.o: tables.h
-nextem.o: $(CDIR)/types.h
-reg.o: $(CDIR)/assert.h
-reg.o: $(CDIR)/data.h
-reg.o: $(CDIR)/extern.h
-reg.o: $(CDIR)/param.h
-reg.o: $(CDIR)/result.h
-reg.o: tables.h
-reg.o: $(CDIR)/types.h
-regvar.o: $(CDIR)/assert.h
-regvar.o: $(CDIR)/data.h
-regvar.o: $(CDIR)/extern.h
-regvar.o: $(CDIR)/param.h
-regvar.o: $(CDIR)/regvar.h
-regvar.o: $(CDIR)/result.h
-regvar.o: tables.h
-regvar.o: $(CDIR)/types.h
-salloc.o: $(CDIR)/assert.h
-salloc.o: $(CDIR)/data.h
-salloc.o: $(CDIR)/extern.h
-salloc.o: $(CDIR)/param.h
-salloc.o: $(CDIR)/result.h
-salloc.o: tables.h
-salloc.o: $(CDIR)/types.h
-state.o: $(CDIR)/assert.h
-state.o: $(CDIR)/data.h
-state.o: $(CDIR)/extern.h
-state.o: $(CDIR)/param.h
-state.o: $(CDIR)/result.h
-state.o: $(CDIR)/state.h
-state.o: tables.h
-state.o: $(CDIR)/types.h
-subr.o: $(CDIR)/assert.h
-subr.o: $(CDIR)/data.h
-subr.o: $(CDIR)/extern.h
-subr.o: $(CDIR)/param.h
-subr.o: $(CDIR)/result.h
-subr.o: tables.h
-subr.o: $(CDIR)/types.h
-var.o: $(CDIR)/data.h
-var.o: $(CDIR)/param.h
-var.o: $(CDIR)/result.h
-var.o: tables.h
-var.o: $(CDIR)/types.h
+++ /dev/null
-Makefile
-ack.h
-data.c
-data.h
-dmach.c
-dmach.h
-files.c
-grows.c
-grows.h
-intable.c
-list.c
-list.h
-main.c
-malloc.c
-mktables.c
-pc
-rmach.c
-run.c
-scan.c
-svars.c
-trans.c
-trans.h
-util.c
+++ /dev/null
-HFILES=ack.h list.h trans.h data.h dmach.h grows.h
-DSRC=list.c data.c main.c scan.c svars.c trans.c util.c rmach.c run.c grows.c\
- files.c
-ISRC=dmach.c intable.c
-OBJ=list.o data.o main.o scan.o svars.o trans.o util.o rmach.o run.o \
- dmach.o intable.o grows.o files.o
-ACKDIR=../../lib/ack
-FE=fe
-INTABLES=pdp int
-LNTABLES=6500 m68k2 m68k4 6809 8080 acc apc nascom vax2 vax4 z80 i86
-CFLAGS=-O -n
-BINDIR=../../bin
-
-head: ack
-
-install: ack
- cp ack $(BINDIR)/ack
- -cd $(BINDIR) ; \
- for i in $(INTABLES) $(LNTABLES) ; do ln ack $$i ; done
- (cd pc ; make install )
-
-cmp: ack
- cmp ack $(BINDIR)/ack
- (cd pc ; make cmp )
-
-clean:
- -rm -f *.old *.o ack
- (cd pc ; make clean )
-
-ack: $(OBJ)
- $(CC) -o ack $(CFLAGS) $(OBJ)
-
-grows.o files.o list.o run.o \
-data.o main.o scan.o trans.o rmach.o util.o : ack.h list.h
-
-files.o data.o main.o scan.o run.o trans.o rmach.o: trans.h data.h
-
-files.o rmach.o trans.o grows.c : grows.h
-
-rmach.c: dmach.h
-
-files.o main.o rmach.o : ../../h/em_path.h
-
-main.o : ../../h/local.h
-
-malloc.o svars.o: ack.h
-
-dmach.c intable.c: mktables dmach.h
- : mktables $(ACKDIR) # $(FE) $(INTABLES)
- mktables $(ACKDIR)
-
-mktables: mktables.c
- cc -o mktables mktables.c
-
-pr:
- @pr Makefile $(HFILES) $(DSRC) $(ACKDIR)/*
- @(cd pc ; make pr)
-
-opr:
- make pr | opr
-
-lint: $(ISRC)
- lint -hbx $(DSRC) $(ISRC)
+++ /dev/null
-/****************************************************************************/
-/* User settable options */
-/****************************************************************************/
-
-#define FRONTENDS "fe" /* The front-end definitions */
-#define ACKNAME "AckXXXXXX" /* Handed to mktemp for temp. files */
-
-/****************************************************************************/
-/* Internal mnemonics, should not be tinkered with */
-/****************************************************************************/
-
-/* The names of some string variables */
-
-#define HOME "EM"
-#define RTS "RTS"
-#define NEEDS "NEEDS"
-#define HEAD "HEAD"
-#define TAIL "TAIL"
-#define SRC "SOURCE"
-#define LIBVAR "LNAME"
-
-/* Intended for flags, possibly in bit fields */
-
-#define YES 1
-#define NO 0
-#define MAYBE 2
-
-#define EXTERN extern
-
-#define SUFCHAR '.' /* Start of SUFFIX in file name */
-#define SPACE ' '
-#define TAB '\t'
-#define EQUAL '='
-#define S_VAR '{' /* Start of variable */
-#define C_VAR '}' /* End of variable */
-#define A_VAR '?' /* Variable alternative */
-#define BSLASH '\\' /* Backslash */
-#define STAR '*' /* STAR */
-#define C_IN '<' /* Token specifying input */
-#define C_OUT '>' /* Token specifying output */
-#define S_EXPR '(' /* Start of expression */
-#define C_EXPR ')' /* End of expression */
-#define M_EXPR ':' /* Middle of two suffix lists */
-#define T_EXPR '=' /* Start of tail */
-
-#define NO_SCAN 0200 /* Bit set in character to defeat recogn. */
-
-typedef struct {
- char *p_path; /* points to the full pathname */
- int p_keeps:1; /* The string should be thrown when unused */
- int p_keep:1; /* The file should be thrown away after use */
-} path ;
-
-/* Return values of setpath() */
-enum f_path { F_OK, F_NOMATCH, F_NOPATH } ;
-
-/* Library routines */
-
-extern char *index();
-extern char *rindex();
-extern char *strcpy();
-extern char *strcat();
-extern char *mktemp();
-extern int unlink();
-extern int close();
-extern int open();
-extern int creat();
-
-/* Own routines */
-enum f_path setpath();
-enum f_path scan_end();
-extern int noodstop();
-extern char *getvar();
-extern char *keeps();
-extern char *basename();
-extern char *skipblank();
-extern char *firstblank();
-extern char *getcore();
-extern char *changecore();
-#define freecore(area) free(area)
-
-/* #define DEBUG 1 /* Allow debugging of Ack */
-
-#ifndef DEBUG
-# define debug 0 /* To surprise all these 'if ( debug ) 's */
-#else
-extern int debug ;
-#endif
+++ /dev/null
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-
-
-#undef EXTERN
-#define EXTERN
-
-#include "data.h"
+++ /dev/null
-EXTERN char *stopsuffix; /* Suffix to stop at */
-EXTERN char *machine; /* The machine id */
-EXTERN char *rts; /* The runtime-system id */
-
-EXTERN list_head arguments; /* List of arguments */
-EXTERN list_head flags; /* List of flags */
-
-EXTERN list_head c_arguments; /* List of linker arguments */
-
-EXTERN list_head tr_list; /* List of transformations */
-
-EXTERN list_head R_list; /* List of -R flags */
-EXTERN list_head head_list; /* List of suffices for headers */
-EXTERN list_head tail_list; /* List of suffices for tails */
-
-EXTERN int k_flag; /* Like -k of lint */
-EXTERN int g_flag; /* do_run() */
-EXTERN int t_flag; /* Preserve intermediate files */
-EXTERN int v_flag; /* Verbose */
-EXTERN int w_flag; /* Don't print warnings */
-EXTERN int nill_flag; /* Don't file names */
-EXTERN int Optflag; /* Optimizing */
-
-#ifdef DEBUG
-EXTERN int debug; /* Debugging control */
-#endif
-
-EXTERN int n_error; /* Number of errors encountered */
-
-EXTERN char *progname; /* The program call name */
-
-EXTERN char *outfile; /* The result file e.g. a.out */
-EXTERN char *template; /* The template for temporary file
- names */
-
-EXTERN trf *combiner; /* Pointer to the Loader/Linker */
-EXTERN trf *cpp_trafo; /* Pointer to C-preprocessor */
-
-EXTERN path in; /* The current input pathname */
-EXTERN path out; /* The current output pathname */
-EXTERN path orig; /* The original input path */
-EXTERN char *p_basename; /* The current basename */
-EXTERN char *p_suffix; /* The current input suffix */
+++ /dev/null
-/***************************************************************/
-/* */
-/* Definition for table that maps a name on an intable index */
-/* */
-/***************************************************************/
-
-
-typedef struct {
- char *ma_name ; /* The name of the machine */
- int ma_index ;
-} dmach ;
-
-extern dmach massoc[] ;
-
-extern char intable[] ;
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "data.h"
-#include "../../h/em_path.h"
-
-setfiles(phase) register trf *phase ; {
- /* Set the out structure according to the in structure,
- the transformation and some global data */
- growstring pathname ;
- register list_elem *elem ;
-
- if ( phase->t_combine ) {
- out.p_keep=YES ;
- out.p_path=outfile ;
- out.p_keeps=NO ;
- in.p_path= (char *)0 ;
- in.p_keep=YES ;
- in.p_keeps=NO ;
- } else {
- gr_init(&pathname) ;
- if ( !phase->t_keep && !t_flag ) {
- gr_cat(&pathname,TMP_DIR) ;
- gr_cat(&pathname,"/") ;
- gr_cat(&pathname,template) ;
- out.p_keep=NO ;
- } else {
- gr_cat(&pathname,p_basename) ;
- out.p_keep=YES ;
- }
- gr_cat(&pathname,phase->t_out) ;
- out.p_path= gr_final(&pathname) ;
- out.p_keeps= YES ;
- }
- scanlist( l_first(arguments), elem) {
- if ( strcmp(l_content(*elem),out.p_path)==0 ) {
- error("attempt to overwrite argument file") ;
- return 0 ;
- }
- }
- return 1 ;
-}
-
-disc_files() {
- if ( in.p_path ) {
- if ( !in.p_keep ) {
- if ( unlink(in.p_path)!=0 ) {
- werror("couldn't unlink %s",in.p_path);
- }
- }
- if ( in.p_keeps ) throws(in.p_path) ;
- }
- in=out ;
- out.p_path= (char *)0 ;
- out.p_keeps=NO ;
- out.p_keep=NO ;
-}
-
-rmtemps() {
- /* Called in case of disaster, always remove the current output file!
- */
- if ( out.p_path ) {
- unlink(out.p_path) ;
- if ( out.p_keeps ) throws(out.p_path) ;
- out.p_path= (char *)0 ;
- out.p_keeps=NO ;
- out.p_keep=NO ;
- }
- if ( !in.p_keep && in.p_path ) {
- unlink(in.p_path) ;
- if ( in.p_keeps ) throws(in.p_path) ;
- in.p_path= (char *)0 ;
- out.p_keeps= NO ;
- out.p_keep=NO ;
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/**************************************************************************/
-/* */
-/* Bookkeeping for growing strings */
-/* */
-/**************************************************************************/
-
-#include "ack.h"
-#include "grows.h"
-
-gr_add(id,c) register growstring *id ; char c ; {
- if ( id->gr_size==id->gr_max) {
- if ( id->gr_size==0 ) { /* The first time */
- id->gr_max= 2*GR_MORE ;
- id->gr_string= getcore(id->gr_max) ;
- } else {
- id->gr_max += GR_MORE ;
- id->gr_string= changecore(id->gr_string,id->gr_max ) ;
- }
- }
- *(id->gr_string+id->gr_size++)= c ;
-}
-
-gr_cat(id,string) growstring *id ; char *string ; {
- register char *ptr ;
-
-#ifdef DEBUG
- if ( id->gr_size && *(id->gr_string+id->gr_size-1) ) {
- vprint("Non-zero terminated %*s\n",
- id->gr_size, id->gr_string ) ;
- }
-#endif
- if ( id->gr_size ) id->gr_size-- ;
- ptr=string ;
- for (;;) {
- gr_add(id,*ptr) ;
- if ( *ptr++ ) continue ;
- break ;
- }
-}
-
-gr_throw(id) register growstring *id ; {
- /* Throw the string away */
- if ( id->gr_max==0 ) return ;
- freecore(id->gr_string) ;
- id->gr_max=0 ;
- id->gr_size=0 ;
-}
-
-gr_init(id) growstring *id ; {
- id->gr_size=0 ; id->gr_max=0 ;
-}
-
-char *gr_final(id) growstring *id ; {
- /* Throw away the bookkeeping, adjust the string to its final
- length and return a pointer to a string to be get rid of with
- throws
- */
- register char *retval ;
- retval= keeps(gr_start(*id)) ;
- gr_throw(id) ;
- return retval ;
-}
+++ /dev/null
-/* struct used to identify and do bookkeeping for growing strings */
-
-typedef struct {
- char *gr_string ; /* Points to start of string */
- unsigned gr_size ; /* Current string size */
- unsigned gr_max ; /* Maximum string size */
-} growstring ;
-
-#define GR_MORE 50 /* Steps to grow */
-
-#define gr_start(id) (id).gr_string /* The start of the string */
-
-/* Routines used */
-
-extern int gr_throw() ; /* To free the core */
-extern int gr_add() ; /* To add one character */
-extern int gr_cat() ; /* concatenate the contents and the string */
-extern int gr_init() ; /* Initialize the bookkeeping */
-extern char *gr_final() ; /* Transform to a stable storage string */
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-
-/* List handling, operations allowed:
- adding strings to the list,
- throwing away whole lists,
- linearize a list.
-
-Routines:
- l_add(header,string) Add an element to a list.
- header List header, list_head *
- string String pointer, char *
- the string is NOT copied
-
- l_clear(header) Delete an whole list.
- header List header, list_head *
-
-*/
-
-
-l_add(header,string) list_head *header ; char *string ; {
- register list_elem *new;
-
- /* NOSTRICT */
- new= (list_elem *)getcore(sizeof *new);
- l_content(*new)= string ;
- /* NOSTRICT */
- l_next(*new)= (list_elem *)0 ;
- if ( !header->ca_first ) {
- header->ca_first= new ;
- } else {
- header->ca_last->ca_next= new ;
- }
- header->ca_last= new ;
-}
-
-l_clear(header) list_head *header ; {
- register list_elem *old, *next;
- for ( old=header->ca_first ; old ; old= next ) {
- next= old->ca_next ;
- freecore((char *)old) ;
- }
- header->ca_first= (list_elem *) 0 ;
- header->ca_last = (list_elem *) 0 ;
-}
-
-l_throw(header) list_head *header ; {
- register list_elem *old, *next;
- for ( old=header->ca_first ; old ; old= next ) {
- throws(l_content(*old)) ;
- next= old->ca_next ;
- freecore((char *)old) ;
- }
- header->ca_first= (list_elem *) 0 ;
- header->ca_last = (list_elem *) 0 ;
-}
+++ /dev/null
-struct ca_elem {
- struct ca_elem *ca_next; /* The link */
- char *ca_cont; /* The contents */
-} ;
-
-struct ca_list {
- struct ca_elem *ca_first; /* The head */
- struct ca_elem *ca_last; /* The tail */
-} ;
-
-typedef struct ca_list list_head ; /* The decl. for headers */
-typedef struct ca_elem list_elem ; /* The decl. for elements */
-
-/* Some operations */
-
-/* Access */
-#define l_first(header) (header).ca_first
-#define l_next(elem) (elem).ca_next
-#define l_content(elem) (elem).ca_cont
-
-/* To be used for scanning lists, ptr is the running variable */
-#define scanlist(elem,ptr) \
- for ( ptr= elem ; ptr; ptr= l_next(*ptr) )
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "../../h/em_path.h"
-#include "../../h/local.h"
-#include "data.h"
-#include <signal.h>
-
-static int sigs[] = { SIGINT, SIGHUP, SIGTERM, 0 } ;
-
-extern char *getenv();
-
-main(argc,argv) char **argv ; {
- register list_elem *elem ;
- register char *frontend ;
- register int *n_sig ;
-
- progname=argv[0];
- varinit();
- vieuwargs(argc,argv);
- if ( (frontend=getenv("ACKFE")) ) {
- setlist(frontend) ;
- } else {
- setlist(FRONTENDS);
- }
- setlist(machine);
- transini();
- scanneeds();
- template= mktemp(ACKNAME) ;
- if ( n_error && !k_flag ) return n_error ;
-
- for ( n_sig=sigs ; *n_sig ; n_sig++ ) {
- if ( signal(*n_sig,noodstop)==SIG_IGN ) {
- signal(*n_sig,SIG_IGN) ;
- }
- }
- scanlist ( l_first(arguments), elem ) {
- if ( !process(l_content(*elem)) && !k_flag ) return 1 ;
- }
- orig.p_path= (char *)0 ;
-
- if ( !combiner && !stopsuffix ) {
- /* Call combiner directly without any transformation */
- scanlist(l_first(tr_list),elem) {
- if ( t_cont(*elem)->t_combine ) {
- combiner= t_cont(*elem) ;
- }
- }
- }
-
- if ( !combiner || n_error ) return n_error ;
-
- if ( !do_combine() ) return 1 ;
-
- if ( g_flag ) {
- return do_run();
- }
-
- return 0 ;
-}
-
-char *srcvar() {
- return orig.p_path ;
-}
-
-varinit() {
- /* initialize the string variables */
- setsvar(keeps(HOME),keeps(EM_DIR)) ;
- setpvar(keeps(SRC),srcvar) ;
-}
-
-/************************* flag processing ***********************/
-
-vieuwargs(argc,argv) char **argv ; {
- register char *argp;
- register int nextarg ;
- register int eaten ;
-
- firstarg(argv[0]) ;
-
- nextarg= 1 ;
-
- while ( nextarg<argc ) {
- argp= argv[nextarg] ;
- nextarg++ ;
- if ( argp[0]!='-' || argp[1]=='l' ) {
- /* Not a flag, or a library */
- l_add(&arguments,argp) ;
- continue ;
- }
-
- /* Flags */
- eaten=0 ; /* Did not 'eat' tail of flag yet */
- switch ( argp[1] ) {
- case 'm': if ( machine ) fuerror("Two machines?") ;
- machine= &argp[2];
- eaten=1 ;
- break ;
- case 'o': if ( nextarg>=argc ) {
- fuerror("-o can't be the last flag") ;
- }
- if ( outfile ) fuerror("Two results?") ;
- outfile= argv[nextarg++] ;
- break ;
- case 'O': Optflag++ ;
- break ;
- case 'v': v_flag++ ;
- break ;
- case 'g': g_flag++ ;
- break ;
- case 'c': if ( stopsuffix ) fuerror("Two -c flags") ;
- stopsuffix= &argp[2]; eaten=1;
- if ( *stopsuffix && *stopsuffix!=SUFCHAR ) {
- fuerror("-c flag has invalid tail") ;
- }
- break ;
- case 'k': k_flag++ ;
- break ;
- case 't': t_flag++ ;
- break ;
- case 'R': do_Rflag(argp); eaten=1;
- break ;
- case 'r': if ( argp[2]!=SUFCHAR ) {
- error("-r must be followed by %c",SUFCHAR) ;
- }
- keeptail(&argp[2]); eaten=1 ;
- break ;
- case '.': if ( rts ) fuerror("Two run-time systems?") ;
- rts= &argp[1] ; eaten=1;
- keephead(rts) ; keeptail(rts) ;
- break ;
-#ifdef DEBUG
- case 'd': debug++ ;
- break ;
-#endif
- case 0 : nill_flag++ ; eaten++ ;
- break;
- case 'w': { register char *tokeep ;
- w_flag++;
- tokeep=keeps(argp) ;
- *tokeep |= NO_SCAN ;
- l_add(&flags,tokeep) ;
- }
- break ;
- default: /* The flag is not recognized,
- put it on the list for the sub-processes
- */
-#ifdef DEBUG
- if ( debug ) {
- vprint("Flag %s: phase dependent\n",argp) ;
- }
-#endif
- l_add(&flags,keeps(argp)) ;
- eaten=1 ;
- }
- if ( argp[2] && !eaten ) {
- werror("Unexpected characters at end of %s",argp) ;
- }
- }
- if ( !machine && ! (machine=getenv("ACKM")) ) {
-#ifdef ACKM
- machine= ACKM; /* The default machine */
-#else
- fuerror("No machine specified") ;
-#endif
- }
- return ;
-}
-
-firstarg(argp) register char *argp ; {
- register char *name ;
-
- name=rindex(argp,'/') ;
- if ( name && *(name+1) ) {
- name++ ;
- } else {
- name= argp ;
- }
- if ( strcmp(name,"ack")==0 ) return ;
- if ( strcmp(name,"acc")==0 || strcmp(name,"cc")==0 ) {
- rts= ".c" ; keephead(rts) ; keeptail(rts) ;
- return ;
- }
- if ( strcmp(name,"apc")==0 || strcmp(name,"pc")==0 ) {
- rts= ".p" ; keephead(rts) ; keeptail(rts) ;
- return ;
- }
- machine= name;
-}
-
-/************************* argument processing ***********************/
-
-process(arg) char *arg ; {
- /* Process files & library arguments */
- register list_elem *elem ;
- register trf *phase ;
- int first=YES ;
-
-#ifdef DEBUG
- if ( debug ) vprint("Processing %s\n",arg) ;
-#endif
- if ( arg[0]=='-' ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
- p_suffix= rindex(arg,SUFCHAR) ;
- if ( p_basename ) throws(p_basename) ;
- orig.p_keep= YES ; /* Don't throw away the original ! */
- orig.p_path= arg ;
- p_basename= keeps(basename(arg)) ;
- if ( !p_suffix ) { l_add(&c_arguments,keeps(arg)) ; return 1 ; }
- /* Try to find a path through the transformations */
- switch( setpath() ) {
- case F_NOPATH :
- error("Cannot produce the desired file from %s",arg) ;
- l_add(&c_arguments,keeps(arg)) ;
- return 1 ;
- case F_NOMATCH :
- if ( stopsuffix ) werror("Unknown suffix in %s",arg) ;
- l_add(&c_arguments,keeps(arg)) ;
- return 1 ;
- case F_OK :
- break ;
- }
- orig.p_keeps= NO;
- in= orig ;
- scanlist(l_first(tr_list), elem) {
- phase= t_cont(*elem) ;
- if ( phase->t_do ) { /* perform this transformation */
- if ( first ) {
- if ( !nill_flag ) {
- printf("%s\n",arg) ;
- }
- }
- switch ( phase->t_prep ) {
- default : if ( !mayprep() ) break ;
- case YES: if ( !transform(cpp_trafo) ) {
- n_error++ ;
-#ifdef DEBUG
- vprint("Pre-processor failed\n") ;
-#endif
- return 0 ;
- }
- case NO :
- break ;
- }
- if ( cpp_trafo && stopsuffix &&
- strcmp(cpp_trafo->t_out,stopsuffix)==0 ) {
- break ;
- }
- if ( !transform(phase) ) {
- n_error++ ;
-#ifdef DEBUG
- if ( debug ) {
- vprint("phase %s for %s failed\n",
- phase->t_name,orig.p_path) ;
- }
-#endif
- return 0 ;
- }
- first=NO ;
- }
- }
-#ifdef DEBUG
- if ( debug ) vprint("Transformation complete for %s\n",orig.p_path) ;
-#endif
- if ( !in.p_keep ) fatal("attempt to discard the result file") ;
- l_add(&c_arguments,keeps(in.p_path));
- disc_files() ;
- return 1 ;
-}
-
-mayprep() {
- int file ;
- char fc ;
- file=open(in.p_path,0);
- if ( file<0 ) return 0 ;
- if ( read(file,&fc,1)!=1 ) fc=0 ;
- close(file) ;
- return fc=='#' ;
-}
-
-keephead(suffix) char *suffix ; {
- l_add(&head_list, suffix) ;
-}
-
-keeptail(suffix) char *suffix ; {
- l_add(&tail_list, suffix) ;
-}
-
-scanneeds() {
- register list_elem *elem ;
- scanlist(l_first(head_list), elem) { setneeds(l_content(*elem),0) ; }
- l_clear(&head_list) ;
- scanlist(l_first(tail_list), elem) { setneeds(l_content(*elem),1) ; }
- l_clear(&tail_list) ;
-}
-
-setneeds(suffix,tail) char *suffix ; {
- register list_elem *elem ;
- register trf *phase ;
-
- p_suffix= suffix ;
- switch ( setpath() ) {
- case F_OK :
- scanlist( l_first(tr_list), elem ) {
- phase = t_cont(*elem) ;
- if ( phase->t_do ) {
- if ( phase->t_needed ) {
- if ( tail )
- add_tail(phase->t_needed) ;
- else
- add_head(phase->t_needed) ;
- }
- }
- }
- break ;
- case F_NOMATCH :
- werror("\"%s\": unrecognized suffix",suffix) ;
- break ;
- case F_NOPATH :
- werror("incomplete internal specification for %s files",
- suffix) ;
- break ;
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-
-#include "ack.h"
-#ifdef DEBUG
-#define ASSERT(p) if(!(p))botch("p");else
-botch(s)
-char *s;
-{
- printf("malloc/free botched: %s\n",s);
- abort();
-}
-#else
-#define ASSERT(p)
-#endif
-
-/* avoid break bug */
-#ifdef pdp11
-#define GRANULE 64
-#else
-#define GRANULE 0
-#endif
-/* C storage allocator
- * circular first-fit strategy
- * works with noncontiguous, but monotonically linked, arena
- * each block is preceded by a ptr to the (pointer of)
- * the next following block
- * blocks are exact number of words long
- * aligned to the data type requirements of ALIGN
- * pointers to blocks must have BUSY bit 0
- * bit in ptr is 1 for busy, 0 for idle
- * gaps in arena are merely noted as busy blocks
- * last block of arena (pointed to by alloct) is empty and
- * has a pointer to first
- * idle blocks are coalesced during space search
- *
- * a different implementation may need to redefine
- * ALIGN, NALIGN, BLOCK, BUSY, INT
- * where INT is integer type to which a pointer can be cast
-*/
-#define INT int
-#define ALIGN int
-#define NALIGN 1
-#define WORD sizeof(union store)
-#define BLOCK 1024 /* a multiple of WORD*/
-#define BUSY 1
-#define NULL 0
-#define testbusy(p) ((INT)(p)&BUSY)
-#define setbusy(p) (union store *)((INT)(p)|BUSY)
-#define clearbusy(p) (union store *)((INT)(p)&~BUSY)
-
-union store { union store *ptr;
- ALIGN dummy[NALIGN];
- int calloc; /*calloc clears an array of integers*/
-};
-
-static union store allocs[2]; /*initial arena*/
-static union store *allocp; /*search ptr*/
-static union store *alloct; /*arena top*/
-static union store *allocx; /*for benefit of realloc*/
-char *sbrk();
-
-char *
-malloc(nbytes)
-unsigned nbytes;
-{
- register union store *p, *q;
- register nw;
- static temp; /*coroutines assume no auto*/
-
- if(allocs[0].ptr==0) { /*first time*/
- allocs[0].ptr = setbusy(&allocs[1]);
- allocs[1].ptr = setbusy(&allocs[0]);
- alloct = &allocs[1];
- allocp = &allocs[0];
- }
- nw = (nbytes+WORD+WORD-1)/WORD;
- ASSERT(allocp>=allocs && allocp<=alloct);
- ASSERT(allock());
- for(p=allocp; ; ) {
- for(temp=0; ; ) {
- if(!testbusy(p->ptr)) {
- while(!testbusy((q=p->ptr)->ptr)) {
- ASSERT(q>p&&q<alloct);
- p->ptr = q->ptr;
- }
- if(q>=p+nw && p+nw>=p)
- goto found;
- }
- q = p;
- p = clearbusy(p->ptr);
- if(p>q)
- ASSERT(p<=alloct);
- else if(q!=alloct || p!=allocs) {
- ASSERT(q==alloct&&p==allocs);
- return(NULL);
- } else if(++temp>1)
- break;
- }
- temp = ((nw+BLOCK/WORD)/(BLOCK/WORD))*(BLOCK/WORD);
- q = (union store *)sbrk(0);
- if(q+temp+GRANULE < q) {
- return(NULL);
- }
- q = (union store *)sbrk(temp*WORD);
- if((INT)q == -1) {
- return(NULL);
- }
- ASSERT(q>alloct);
- alloct->ptr = q;
- if(q!=alloct+1)
- alloct->ptr = setbusy(alloct->ptr);
- alloct = q->ptr = q+temp-1;
- alloct->ptr = setbusy(allocs);
- }
-found:
- allocp = p + nw;
- ASSERT(allocp<=alloct);
- if(q>allocp) {
- allocx = allocp->ptr;
- allocp->ptr = p->ptr;
- }
- p->ptr = setbusy(allocp);
- return((char *)(p+1));
-}
-
-/* freeing strategy tuned for LIFO allocation
-*/
-free(ap)
-register char *ap;
-{
- register union store *p = (union store *)ap;
-
- ASSERT(p>clearbusy(allocs[1].ptr)&&p<=alloct);
- ASSERT(allock());
- allocp = --p;
- ASSERT(testbusy(p->ptr));
- p->ptr = clearbusy(p->ptr);
- ASSERT(p->ptr > allocp && p->ptr <= alloct);
-}
-
-/* realloc(p, nbytes) reallocates a block obtained from malloc()
- * and freed since last call of malloc()
- * to have new size nbytes, and old content
- * returns new location, or 0 on failure
-*/
-
-char *
-realloc(p, nbytes)
-register union store *p;
-unsigned nbytes;
-{
- register union store *q;
- union store *s, *t;
- register unsigned nw;
- unsigned onw;
-
- if(testbusy(p[-1].ptr))
- free((char *)p);
- onw = p[-1].ptr - p;
- q = (union store *)malloc(nbytes);
- if(q==NULL || q==p)
- return((char *)q);
- s = p;
- t = q;
- nw = (nbytes+WORD-1)/WORD;
- if(nw<onw)
- onw = nw;
- while(onw--!=0)
- *t++ = *s++;
- if(q<p && q+nw>=p)
- (q+(q+nw-p))->ptr = allocx;
- return((char *)q);
-}
-
-#ifdef DEBUG
-allock()
-{
-#ifdef DEBUG
- register union store *p;
- int x;
- x = 0;
- for(p= &allocs[0]; clearbusy(p->ptr) > p; p=clearbusy(p->ptr)) {
- if(p==allocp)
- x++;
- }
- ASSERT(p==alloct);
- return(x==1|p==allocp);
-#else
- return(1);
-#endif
-}
-#endif
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include <stdio.h>
-#include <ctype.h>
-
-char *fname = 0 ;
-char dname[200] ;
-char *tail ;
-
-FILE *intab ;
-FILE *dmach ;
-
-int index ;
-
-main(argc,argv) char **argv ; {
- register i ;
-
- start(argv[1]) ;
- for ( i=2 ; i<argc ; i++ ) {
- fname= argv[i] ;
- readm() ;
- }
- stop(argc>2) ;
- return 0 ;
-}
-
-start(dir) char *dir ; {
- tail= dname ;
- while ( *dir ) {
- *tail++ = *dir ++ ;
- }
- if ( tail!=dname ) *tail++= '/' ;
- index=0 ;
- intab= fopen("intable.c","w");
- dmach= fopen("dmach.c","w");
- if ( intab==NULL || dmach==NULL ) {
- fprintf(stderr,"Couln't create output file(s)\n");
- exit ( 1) ;
- }
- fprintf(dmach,"#include \"dmach.h\"\n\ndmach\tmassoc[] = {\n") ;
- fprintf(intab,"char intable[] = {\n") ;
-}
-
-stop(filled) {
- fprintf(dmach,"\t{\"\",\t-1\t}\n} ;\n") ;
- if ( !filled ) fprintf(intab,"\t0\n") ;
- fprintf(intab,"\n} ;\n") ;
- fclose(dmach); fclose(intab) ;
-}
-
-FILE *do_open(file) char *file ; {
- strcpy(tail,file) ;
- return fopen(dname,"r") ;
-}
-
-readm() {
- register int i ;
- register int token ;
- register FILE *in ;
-
- in=do_open(fname) ;
- if ( in==NULL ) {
- fprintf(stderr,"Cannot open %s\n",fname) ;
- return ;
- }
- i=0 ;
- fprintf(dmach,"\t{\"%s\",\t%d\t},\n",fname,index) ;
- fprintf(intab,"\n/* %s */\n\t",fname) ;
- for (;;) {
- token=getc(in) ;
- index++ ;
- if ( ++i == 10 ) {
- fprintf(intab,"\n\t") ;
- i=0 ;
- } else {
- fprintf(intab," ") ;
- }
- if ( !isascii(token) || !(isprint(token) || isspace(token)) ){
- if ( token!=EOF ) {
- fprintf(stderr,"warning: non-ascii in %s\n",fname) ;
- fprintf(intab,"%4d,",token) ;
- } else {
- fprintf(intab," 0,",token) ;
- break ;
- }
- } else if ( isprint(token) ) {
- switch ( token ) {
- case '\'': fprintf(intab,"'\\''") ; break ;
- case '\\': fprintf(intab,"'\\\\'") ; break ;
- default: fprintf(intab," '%c'",token) ; break ;
- }
- } else switch ( token ) {
- case '\n' : fprintf(intab,"'\\n'") ; break ;
- case '\t' : fprintf(intab,"'\\t'") ; break ;
- case '\r' : fprintf(intab,"'\\r'") ; break ;
- case '\f' : fprintf(intab,"'\\f'") ; break ;
- case ' ' : fprintf(intab," ' '") ; break ;
- default : fprintf(stderr,"warning: unrec. %d\n",
- token) ;
- fprintf(intab,"%4d",token) ;
- break ;
- }
- fprintf(intab,",") ;
- }
- fclose(in) ;
-}
+++ /dev/null
-Makefile
-em_pc.c
+++ /dev/null
-d=../../..
-h=$d/h
-
-PC_PATH=$d/lib/em_pc
-
-em_pc: em_pc.c $h/local.h $h/em_path.h
- cc -n -o em_pc -O -I$h em_pc.c
-
-cmp: em_pc
- cmp em_pc $(PC_PATH)
-
-install: em_pc
- cp em_pc $(PC_PATH)
-
-lint:
- lint -hpxc -I$h em_pc.c
-
-clean:
- rm -f *.o *.old em_pc
-
-opr:
- make pr ^ opr
-
-pr:
- pr -n em_pc.c
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/*
- * put all the pieces of the pascal part of the EM project together
- * original author: Johan Stevenson, Vrije Universiteit, Amsterdam
- * heavily modified by: Ed Keizer, Vrije Universiteit, Amsterdam
- */
-
-#include <stdio.h>
-#include <signal.h>
-#include <sys/types.h>
-#include <sys/dir.h>
-#include <em_path.h>
-#include <pc_size.h>
-#include <local.h>
-
-#define MAX_FLAG 40 /* The Max. no of '{' flags allowed */
-
-#define void int
-
-char *pc_path = PEM_PATH ;
-char *err_path = ERR_PATH;
-
-int toterr;
-int parent;
-
-char *eeflag;
-char *vvflag = "-V";
-int no_pemflag = 0 ;
-char *pemflag[MAX_FLAG];
-char *eflag;
-char *wflag;
-
-int sizes[sz_last+1] = {
- 2, /* sz_addr */
- 8, /* sz_real */
- 0, /* sz_head */
- 512, /* sz_buff */
- 4096, /* sz_mset */
- 2, /* sz_iset */
-};
-
-#define CALLSIZE 60
-char *callvector[CALLSIZE];
-char **av;
-int ac;
-int fileargs; /* number of recognized, processed args */
-int flagargs;
-char *progname;
-char *source;
-
-#define CHARSIZE 2500
-#define CHARMARG 50
-char charbuf[CHARSIZE];
-char *charp = charbuf;
-
-char *tmp_dir = TMP_DIR;
-char *unique = "pcXXXXXX";
-
-char sigs[] = {
- SIGHUP,
- SIGINT,
- SIGTERM,
- 0
-};
-
-/*
- * forward function declarations
- */
-void finish();
-void pem();
-int list();
-char *flag();
-char *tempfile();
-char **initvector();
-char *basename();
-
-/*
- * used library routines and data
- */
-
-extern char *sys_errlist[];
-extern int errno;
-
-int atoi();
-void exit();
-void sleep();
-void execv();
-char *sbrk();
-int chdir();
-int fork();
-int wait();
-int getpid();
-int open();
-int close();
-int read();
-
-main(argc,argv) char **argv; {
- register char *p;
- char *files[3] ;
-
- for (p = sigs; *p; p++)
- if (signal(*p,finish) == SIG_IGN)
- signal(*p,SIG_IGN);
- ac = argc;
- av = argv;
- progname = *av++;
- init();
- while ( --ac>0 ) {
- p = *av++;
- if (*p == '-') {
- flagargs++;
- p = flag(p);
- } else {
- if ( fileargs>=3 ) fatal("Too many file arguments") ;
- files[fileargs++]= p;
- }
- }
- if ( fileargs!=3 ) fatal("Not enough arguments") ;
- source=files[2] ;
- pem(files[0],files[1]) ;
- finish();
-}
-
-char *flag(f) char *f; {
- register char *p;
-
- p = f+1;
- switch (*p++) {
- case 'e':
- eflag = f;
- break;
- case 'E':
- eeflag = f;
- break;
- case 'w':
- wflag = f;
- break;
- case 'V':
- vvflag = f;
- return(0);
- case '{':
- if ( no_pemflag>=MAX_FLAG ) {
- ermess("too many flags, ignored %s",f) ;
- } else {
- pemflag[no_pemflag++] = p;
- }
- return(0);
- case 'R':
- pc_path= p ;
- return 0 ;
- case 'r' :
- err_path= p ;
- return 0 ;
- default:
- return(f);
- }
- if (*p)
- fatal("bad flag %s",f);
- return(0);
-}
-
-initsizes(f) FILE *f; {
- register c, i;
- register char *p;
-
- p = vvflag + 2;
- while (c = *p++) {
- i = atoi(p);
- while (*p >= '0' && *p <= '9')
- p++;
- switch (c) {
- case 'p': sz_addr = i; continue;
- case 'f': sz_real = i; continue;
- case 'h': sz_head = i; continue;
- case 'b': sz_buff = i; continue;
- case 'm': sz_mset = i; continue;
- case 'j': sz_iset = i; continue;
- case 'w':
- case 'i': if (i == 2) continue; break;
- case 'l': if (i == 4) continue; break;
- }
- fatal("bad V-flag %s",vvflag);
- }
- if (sz_head == 0)
- sz_head = 6*sz_word + 2*sz_addr;
- for (i = 0; i <= sz_last; i++)
- fprintf(f, "%d\n",sizes[i]);
-}
-
-/* ------------------ calling sequences -------------------- */
-
-pem(p,q) char *p,*q; {
- register char **v,*d;
- int i;
- FILE *erfil;
-
- v = initvector(pc_path);
- d = tempfile('d');
- if ((erfil = fopen(d,"w")) == NULL)
- syserr(d);
- initsizes(erfil);
- fprintf(erfil,"%s\n",basename(source));
- for ( i=0 ; i<no_pemflag ; i++ ) fprintf(erfil,"%s\n",pemflag[i]);
- fclose(erfil);
- *v++ = q;
- *v++ = d;
- call(v,p,(char *)0);
- if (toterr == 0)
- if (list(p,d) < 0)
- toterr++;
- donewith(d);
-}
-
-/* ------------------- miscellaneous routines --------------- */
-
-char *basename(p) char *p; {
- register char *q;
-
- q = p;
- while (*q)
- if (*q++ == '/')
- p = q;
- return(p);
-}
-
-char *tempfile(suf) {
- register char *p,*q;
- register i;
-
- p = charp; q = tmp_dir;
- while (*p = *q++)
- p++;
- *p++ = '/';
- q = unique;
- while (*p = *q++)
- p++;
- i = fileargs;
- do
- *p++ = i % 10 + '0';
- while (i /= 10);
- *p++ = '.'; *p++ = suf; *p++ = '\0';
- q = charp; charp = p;
- return(q);
-}
-
-call(v,in,out) char **v,*in,*out; {
- register pid;
- int status;
-
- while ((parent = fork()) < 0)
- sleep(1);
- if (parent == 0) {
- if (in) {
- close(0);
- if (open(in,0) != 0)
- syserr(in);
- }
- if (out) {
- close(1);
- if (creat(out,0666) != 1)
- syserr(out);
- }
- *v = 0;
- execv(callvector[0],callvector+1);
- syserr(callvector[0]);
- }
- while ((pid = wait(&status)) != parent) {
- if (pid == -1)
- fatal("process %d disappeared",parent);
- fatal("unknown child %d died",pid);
- }
- if ((status & 0177) > 3) {
-/*
- if ((status & 0200) && tflag==0)
- unlink("core");
-*/
- fatal("signal %d in %s. Ask an expert for help",
- status&0177,callvector[0]);
- }
- if (status & 0177400)
- toterr++;
-}
-
-char **initvector(path) char *path; {
- register char *p,**v;
-
- v = callvector;
- p = path;
- *v++ = p;
- *v++ = basename(p);
- return(v);
-}
-
-finish() {
- register char *p,*q;
- register fd;
- struct direct dir;
-
- signal(SIGINT,SIG_IGN);
- if (parent != 0) {
- chdir(tmp_dir);
- fd = open(".",0);
- while (read(fd,(char *) &dir,sizeof dir) == sizeof dir) {
- if (dir.d_ino == 0)
- continue;
- p = unique;
- q = dir.d_name;
- while (*p++ == *q++)
- if (*p == '\0') {
- unlink(dir.d_name);
- break;
- }
- }
- close(fd);
- }
- exit(toterr ? -1 : 0);
-}
-
-
-donewith(p) char *p; {
-
- if (p >= charbuf && p < &charbuf[CHARSIZE])
- unlink(p);
-}
-
-init() {
- register char *p;
- register i,fd;
-
- if ((fd = open(tmp_dir,0)) < 0)
- tmp_dir = ".";
- close(fd);
- p = unique+2;
- parent = i = getpid();
- do
- *p++ = i % 10 + '0';
- while (i /= 10);
- *p++ = '.'; *p = '\0';
-}
-
-/* ------------------- pascal listing ----------------------- */
-
-#define MAXERNO 300
-#define MAXERRLIST 10
-#define IDMAX 8
-
-struct errec {
- int erno;
- char mess[IDMAX+1];
- int mesi;
- int chno;
- int lino;
-};
-
-struct errec curr;
-struct errec next;
-
-int *index = 0;
-int maxerno;
-
-int errerr;
-int errfat;
-
-int listlino;
-int listorig;
-int listrela;
-char *listfnam;
-
-FILE *inpfil;
-FILE *mesfil;
-FILE *errfil;
-
-int errorline();
-int geterrec();
-int nexterror();
-
-int list(p,q) char *p,*q; {
-
- if ((errfil = fopen(q,"r")) == NULL)
- syserr(q);
- if (geterrec() == 0)
- if (eeflag==0) {
- fclose(errfil);
- return(0);
- }
- if (index == 0) {
- index = (int *) sbrk(MAXERNO * sizeof index[0]);
- fillindex();
- }
- if ((inpfil = fopen(p,"r")) == NULL)
- syserr(p);
- errerr = 0;
- errfat = 0;
- listlino = 0;
- listorig = 0;
- listrela = 0;
- listfnam = source;
- if (eeflag)
- listfull();
- else if (eflag)
- listpartial();
- else
- listshort();
- fclose(errfil);
- fclose(inpfil);
- fflush(stdout);
- return(errfat ? -1 : 1);
-}
-
-listshort() {
-
- while (nexterror()) {
- while (listlino < curr.lino)
- nextline(0);
- printf("%s, line %d: ",listfnam,listrela);
- string(&curr);
- }
-}
-
-listfull() {
-
- if (nexterror())
- do {
- do {
- nextline(1);
- } while (listlino < curr.lino);
- } while (errorline());
- while (nextline(1))
- ;
-}
-
-listpartial() {
-
- if (nexterror())
- do {
- do {
- nextline(listlino >= curr.lino-2);
- } while (listlino < curr.lino);
- } while (errorline());
-}
-
-int nextline(printing) {
- register ch;
-
- listlino++;
- ch = getc(inpfil);
- if (ch == '#') {
- if (lineline(printing) == 0)
- fatal("bad line directive");
- return(1);
- }
- listrela++;
- if (listfnam == source)
- listorig++;
- if (ch != EOF) {
- if (printing)
- printf("%5d\t",listorig);
- do {
- if (printing)
- putchar(ch);
- if (ch == '\n')
- return(1);
- } while ((ch = getc(inpfil)) != EOF);
- }
- return(0);
-}
-
-lineline(printing) {
- register ch;
- register char *p,*q;
- static char line[100];
-
- p = line;
- while ((ch = getc(inpfil)) != '\n') {
- if (ch == EOF || p == &line[100-1])
- return(0);
- *p++ = ch;
- }
- *p = '\0'; p = line;
- if (printing)
- printf("\t#%s\n",p);
- if ((listrela = atoi(p)-1) < 0)
- return(0);
- while ((ch = *p++) != '"')
- if (ch == '\0')
- return(0);
- q = p;
- while (ch = *p++) {
- if (ch == '"') {
- *--p = '\0';
- if ( source ) {
- listfnam = strcmp(q,source)==0 ? source : q;
- return(1);
- }
- source=q ; listfnam=q ;
- return 1 ;
- }
- if (ch == '/')
- q = p;
- }
- return(0);
-}
-
-int errorline() {
- register c;
- register struct errec *p,*q;
- struct errec lerr[MAXERRLIST];
- int goon;
-
- printf("*** ***");
- p = lerr;
- c = 0;
- do {
- if (c < curr.chno) {
- printf("%*c",curr.chno-c,'^');
- c = curr.chno;
- }
- if (p < &lerr[MAXERRLIST])
- *p++ = curr;
- goon = nexterror();
- } while (goon && curr.lino==listlino);
- putchar('\n');
- for (q = lerr; q < p; q++)
- string(q);
- putchar('\n');
- return(goon);
-}
-
-int geterrec() {
- register ch;
- register char *p;
-
- ch = getc(errfil);
- next.erno = 0;
- next.mesi = -1;
- next.mess[0] = '\0';
- if (ch == EOF)
- return(0);
- if (ch >= '0' && ch <= '9') {
- ch = getnum(ch,&next.mesi);
- } else if (ch == '\'') {
- p = next.mess;
- while ((ch = getc(errfil)) != ' ' && ch != EOF)
- if (p < &next.mess[IDMAX])
- *p++ = ch;
- *p = '\0';
- }
- ch = getnum(ch, &next.erno);
- ch = getnum(ch, &next.lino);
- ch = getnum(ch, &next.chno);
- if (ch != '\n')
- fatal("bad error line");
- return(1);
-}
-
-int getnum(ch, ip) register ch; register *ip; {
- register neg;
-
- *ip = 0;
- while (ch == ' ')
- ch = getc(errfil);
- if (neg = ch=='-')
- ch = getc(errfil);
- while (ch >= '0' && ch <= '9') {
- *ip = *ip * 10 - '0' + ch;
- ch = getc(errfil);
- }
- if (neg)
- *ip = -(*ip);
- return(ch);
-}
-
-int nexterror() {
-
- do { /* skip warnings if wflag */
- curr = next;
- if (curr.erno == 0)
- return(0);
- for (;;) {
- if (geterrec() == 0)
- break;
- if (next.lino != curr.lino || next.chno != curr.chno)
- break;
- if (curr.erno < 0 && next.erno > 0)
- /* promote warnings if they cause fatals */
- curr.erno = -curr.erno;
- if (next.mess[0] != '\0' || next.mesi != -1)
- /* give all parameterized errors */
- break;
- if (curr.mess[0] != '\0' || curr.mesi != -1)
- /* and at least a non-parameterized one */
- break;
- }
- } while (curr.erno < 0 && wflag != 0);
- return(1);
-}
-
-fillindex() {
- register *ip,n,c;
-
- if ((mesfil = fopen(err_path,"r")) == NULL)
- syserr(err_path);
- ip = index;
- *ip++ = 0;
- n = 0;
- while ((c = getc(mesfil)) != EOF) {
- n++;
- if (c == '\n') {
- *ip++ = n;
- if (ip > &index[MAXERNO])
- fatal("too many errors on %s",err_path);
- }
- }
- maxerno = ip - index;
-}
-
-string(ep) register struct errec *ep; {
- register i,n;
-
- errerr++;
- if ((i = ep->erno) < 0) {
- i = -i;
- printf("Warning: ");
- } else
- errfat++;
- if (i == 0 || i >= maxerno)
- fatal("bad error number %d",i);
- n = index[i] - index[i-1];
- fseek(mesfil,(long)index[i-1],0);
- while (--n >= 0) {
- i = getc(mesfil);
- if (i == '%' && --n>=0) {
- i = getc(mesfil);
- if (i == 'i')
- printf("%d", ep->mesi);
- else if (i == 's')
- printf("%s", ep->mess);
- else
- putchar(i);
- } else
- putchar(i);
- }
-}
-
-/* ------------------- error routines -------------------------- */
-
-/* VARARGS1 */
-void ermess(s,a1,a2,a3,a4) char *s; {
-
- fprintf(stderr,"%s: ",progname);
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
-}
-
-syserr(s) char *s; {
- fatal("%s: %s",s,sys_errlist[errno]);
-}
-
-/* VARARGS1 */
-void fatal(s,a1,a2,a3,a4) char *s; {
-
- ermess(s,a1,a2,a3,a4);
- toterr++;
- finish();
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "../../h/em_path.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "dmach.h"
-#include "data.h"
-#include <stdio.h>
-
-/************************************************************************/
-/* */
-/* Read machine definitions and transformations */
-/* */
-/************************************************************************/
-
-#define COMMENT '#'
-
-#define VAR "var"
-#define PASS "name"
-#define IN "from"
-#define OUT "to"
-#define PROG "program"
-#define MAPF "mapflag"
-#define ARGS "args"
-#define PROP "prop"
-#define RUNT "rts"
-#define NEEDT "need"
-#define END "end"
-
-extern growstring scanb();
-extern growstring scanvars();
-
-int getline() ;
-int getinchar() ;
-static char *ty_name ;
-static char *bol ;
-
-
-static char *inname ;
-
-setlist(name) char *name ; {
- /* Name is sought in the internal tables,
- if not present, the a file of that name is sought
- in first the current and then the EM Lib directory
- */
-
- inname=name ;
- open_in(name) ;
- while ( getline() ) {
- if ( strcmp(VAR,ty_name)==0 ) {
- doassign(bol,(char *)0,0) ;
- } else
- if ( strcmp(PASS,ty_name)==0 ) {
- intrf() ;
- } else
- error("unknown keyword %s",ty_name) ;
- }
- close_in();
-#ifdef DEBUG
- if ( debug>=3 ) vprint("End %s\n",name) ;
-#endif
-}
-
-intrf() {
- register trf *new ;
- register char *ptr ;
- growstring bline, vline ;
- int twice ;
-
- new= (trf *)getcore(sizeof *new) ;
- new->t_name= keeps(bol) ;
- for (;;) {
- if ( !getline() ) {
- fuerror("unexpected EOF on %s",inname) ;
- }
- twice= NO ;
- if ( strcmp(ty_name,IN)==0 ) {
- if ( new->t_in ) twice=YES ;
- new->t_in= keeps(bol);
- } else
- if ( strcmp(ty_name,OUT)==0 ) {
- if ( new->t_out ) twice=YES ;
- new->t_out= keeps(bol);
- } else
- if ( strcmp(ty_name,PROG)==0 ) {
- if ( new->t_prog ) twice=YES ;
- bline= scanb(bol); /* Scan for \ */
- vline= scanvars(gr_start(bline)); /* Scan for {} */
- gr_throw(&bline);
- new->t_prog= gr_final(&vline);
- clr_noscan(new->t_prog);
- } else
- if ( strcmp(ty_name,MAPF)==0 ) {
- /* First read the mapflags line
- and scan for backslashes */
- bline= scanb(bol) ;
- l_add(&new->t_mapf,gr_final(&bline)) ;
- } else
- if ( strcmp(ty_name,ARGS)==0 ) {
- if ( new->t_argd ) twice=YES ;
- bline= scanb(bol) ;
- new->t_argd= keeps(gr_start(bline)) ;
- gr_throw(&bline) ;
- } else
- if ( strcmp(ty_name,PROP)==0 ) {
- for ( ptr=bol ; *ptr ; ptr++ ) {
- switch( *ptr ) {
- case C_IN: new->t_stdin= YES ; break ;
- case C_OUT: new->t_stdout= YES ; break ;
- case 'P': new->t_isprep= YES ; break ;
- case 'p': new->t_prep= YES ; break ;
- case 'm': new->t_prep= MAYBE ; break ;
- case 'O': new->t_optim= YES ; break ;
- case 'C': new->t_combine= YES ; break ;
- default :
- error("Unkown option %c in %s for %s",
- *ptr,new->t_name,inname) ;
- break ;
- }
- }
- } else
- if ( strcmp(ty_name,RUNT)==0 ) {
- if ( new->t_rts ) twice=YES ;
- new->t_rts= keeps(bol) ;
- } else
- if ( strcmp(ty_name,NEEDT)==0 ) {
- if ( new->t_needed ) twice=YES ;
- new->t_needed= keeps(bol) ;
- } else
- if ( strcmp(ty_name,END)==0 ) {
- break ;
- } else {
- fuerror("illegal keyword %s %s",ty_name,bol);
- }
- if ( twice ) {
- werror("%s: specified twice for %s",
- ty_name, new->t_name) ;
- }
- }
- if ( ! ( new->t_name && new->t_out && new->t_prog ) ) {
- fuerror("insufficient specification for %s in %s",
- new->t_name,inname) ;
- }
- if ( ! new->t_argd ) new->t_argd="" ;
-#ifdef DEBUG
- if ( debug>=3 ) {
- register list_elem *elem ;
- vprint("%s: from %s to %s '%s'\n",
- new->t_name,new->t_in,new->t_out,new->t_prog) ;
- vprint("\targs: ") ; prns(new->t_argd) ;
- scanlist( l_first(new->t_mapf), elem ) {
- vprint("\t%s\n",l_content(*elem)) ;
- }
- if ( new->t_rts ) vprint("\trts: %s\n",new->t_rts) ;
- if ( new->t_needed ) vprint("\tneeded: %s\n",new->t_needed) ;
- }
-#endif
- l_add(&tr_list,(char *)new) ;
-}
-
-/************************** IO from core or file *******************/
-
-static int incore ;
-static growstring rline ;
-static FILE *infile ;
-static char *inptr ;
-
-open_in(name) register char *name ; {
- register dmach *cmac ;
-
- gr_init(&rline) ;
- for ( cmac= massoc ; cmac->ma_index!= -1 ; cmac++ ) {
- if ( strcmp(name,cmac->ma_name)==0 ) {
- incore=YES ;
- inptr= &intable[cmac->ma_index] ;
- return ;
- }
- }
- /* Not in core */
- incore= NO ;
-#ifdef NEW
- gr_cat(&rline,EM_DIR) ;
- gr_cat(&rline,"/lib/n_ack/") ;
-#else
- gr_cat(&rline,ACK_DIR); gr_cat(&rline,"/") ;
-#endif
- gr_cat(&rline,name) ;
- infile= fopen(gr_start(rline),"r") ;
-#ifdef NEW
- if ( !infile ) {
- /* Try to read EM_DIR/lib/MACH/plan */
- gr_throw(&rline) ;
- gr_cat(&rline,EM_DIR) ;
- gr_cat(&rline,"/lib/") ; gr_cat(&rline,name) ;
- gr_cat(&rline,"/plan") ;
- infile= fopen(gr_start(rline),"r") ;
- }
-#endif
- if ( !infile ) {
- infile= fopen(name,"r") ;
- }
- if ( infile==NULL ) {
- fuerror("Cannot find description for %s",name) ;
- }
-}
-
-close_in() {
- if ( !incore ) fclose(infile) ;
- gr_throw(&rline) ;
-}
-
-char *readline() {
- /* Get a line from the input,
- return 0 if at end,
- The line is stored in a volatile buffer,
- a pointer to the line is returned.
- */
- register int nchar ;
- enum { BOL, ESCAPE, SKIPPING, MOL } state = BOL ;
-
- gr_throw(&rline) ;
- for (;;) {
- nchar= getinchar() ;
- if ( nchar==EOF ) {
- if ( state!=BOL ) {
- werror("incomplete line in %s", inname) ;
- }
- return 0 ;
- }
- if ( state==SKIPPING ) {
- if ( nchar=='\n' ) {
- state= MOL ;
- } else {
- continue ;
- }
- }
- if ( state==ESCAPE ) {
- switch( nchar ) {
- case '\n' :
- break ;
- default :
- gr_add(&rline,BSLASH) ;
- case COMMENT :
- case BSLASH :
- gr_add(&rline,nchar) ;
- break ;
- }
- state= MOL ;
- continue ;
- }
- switch ( nchar ) {
- case '\n' : gr_add(&rline,0) ;
- return gr_start(rline) ;
- case COMMENT : state= SKIPPING ;
- break ;
- case BSLASH : state= ESCAPE ;
- break ;
- default : gr_add(&rline,nchar) ;
- state= MOL ;
- }
- }
-}
-
-int getinchar() {
- if ( incore ) {
- if ( *inptr==0 ) return EOF ;
- return *inptr++ ;
- }
- return getc(infile) ;
-}
-
-int getline() {
- register char *c_ptr ;
-
- do {
- if ( (c_ptr=readline())==(char *)0 ) return 0 ;
- ty_name= skipblank(c_ptr) ;
- } while ( *ty_name==0 ) ;
- c_ptr= firstblank(ty_name) ;
- if ( *c_ptr ) {
- *c_ptr++ =0 ;
- c_ptr= skipblank(c_ptr) ;
- }
- bol= c_ptr ;
- return 1 ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "data.h"
-#include <signal.h>
-
-#define ARG_MORE 40 /* The size of args chunks to allocate */
-
-static char **arglist ; /* The first argument */
-static unsigned argcount ; /* The current number of arguments */
-static unsigned argmax; /* The maximum number of arguments so far */
-
-int do_run() {
- fatal("-g flag not implemeted") ;
- /*NOTREACHED*/
- return 0 ;
-}
-
-int runphase(phase) register trf *phase ; {
- register list_elem *elem ;
-
- if ( v_flag || debug ) {
- if ( v_flag==1 && !debug ) {
- vprint("%s",phase->t_name) ;
- if ( !phase->t_combine ) {
- vprint(" %s%s\n",p_basename,
- rindex(in.p_path,SUFCHAR) ) ;
- } else {
- scanlist(l_first(c_arguments), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- vprint("\n") ;
- }
- } else {
- /* list all args */
- vprint("%s",phase->t_prog) ;
- scanlist(l_first(phase->t_flags), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- scanlist(l_first(phase->t_args), elem) {
- vprint(" %s",l_content(*elem)) ;
- }
- vprint("\n") ;
- }
- }
- argcount=0 ;
- x_arg(phase->t_name) ;
- scanlist(l_first(phase->t_flags), elem) {
- x_arg(l_content(*elem)) ;
- }
- scanlist(l_first(phase->t_args), elem) {
- x_arg(l_content(*elem)) ;
- }
- x_arg( (char *)0 ) ;
- return run_exec(phase) ;
-}
-
-int run_exec(phase) trf *phase ; {
- int status, child, waitchild ;
-
- do_flush();
- while ( (child=fork())== -1 ) ;
- if ( child ) {
- /* The parent */
- do {
- waitchild= wait(&status) ;
- if ( waitchild== -1 ) {
- fatal("missing child") ;
- }
- } while ( waitchild!=child) ;
- if ( status ) {
- if ( status&0200 && (status&0177)!=SIGQUIT &&
- !t_flag ) unlink("core") ;
- switch ( status&0177 ) {
- case 0 :
- break ;
- case SIGHUP:
- case SIGINT:
- case SIGQUIT:
- case SIGTERM:
- quit(-5) ;
- default:
- error("%s died with signal %d",
- phase->t_prog,status&0177) ;
- }
- /* The assumption is that processes voluntarely
- dying with a non-zero status already produced
- some sort of error message to the outside world.
- */
- n_error++ ;
- return 0 ;
- }
- return 1 ; /* From the parent */
- }
- /* The child */
- if ( phase->t_stdin ) {
- if ( !in.p_path ) {
- fatal("no input file for %s",phase->t_name) ;
- }
- close(0) ;
- if ( open(in.p_path,0)!=0 ) {
- error("cannot open %s",in.p_path) ;
- exit(1) ;
- }
- }
- if ( phase->t_stdout ) {
- if ( !out.p_path ) {
- fatal("no output file for %s",phase->t_name) ;
- }
- close(1) ;
- if ( creat(out.p_path,0666)!=1 ) {
- close(1); dup(2);
- error("cannot open %s",out.p_path) ;
- exit(1) ;
- }
- }
- execv(phase->t_prog,arglist) ;
- if ( phase->t_stdout ) { close(1) ; dup(2) ; }
- error("Cannot execute %s",phase->t_prog) ;
- exit(1) ;
- /*NOTREACHED*/
-}
-
-x_arg(string) char *string ; {
- /* Add one execute argument to the argument vector */
- if ( argcount==argmax ) {
- if ( argmax==0 ) {
- argmax= 2*ARG_MORE ;
- arglist= (char **)getcore(argmax*sizeof (char *)) ;
- } else {
- argmax += ARG_MORE ;
- arglist= (char **)changecore((char *)arglist,
- argmax*sizeof (char *)) ;
- }
- }
- *(arglist+argcount++) = string ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "data.h"
-
-enum f_path setpath() { /* Try to find a transformation path */
-
- start_scan();
- /*
- The end result is the setting of the t_do flags
- in the transformation list.
- The list is scanned for possible transformations
- stopping at stopsuffix or a combine transformation.
- The scan flags are set by this process.
- When a transformation is found, it is compared with
- the last transformation found, if better (or the first)
- the scan bits are copied to the t_do bits, except for
- the combiner which is remembered in a global pointer.
- At the end of all transformations for all files, the combiner
- is called, unless errors occurred.
- */
- try(l_first(tr_list),p_suffix);
- return scan_end();
-}
-
-/******************** data used only while scanning *******************/
-
-static int last_ncount; /* The # of non-optimizing transformations
- in the best path sofar */
-
-static int last_ocount; /* The # of optimizing transformations in the
- best path sofar */
-static int com_err; /* Complain only once about multiple linkers*/
-
-static trf *final; /* The last non-combining transformation */
-
-static int suf_found; /* Was the suffix at least recognized ? */
-
-/******************** The hard work ********************/
-
-start_scan() {
- register list_elem *scan ;
-
- scanlist(l_first(tr_list),scan) {
- t_cont(*scan)->t_do=NO ; t_cont(*scan)->t_scan=NO ;
- t_cont(*scan)->t_keep=NO ;
- }
- final= (trf *)0 ;
- suf_found= 0 ;
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Scan_start\n");
-#endif
- last_ncount= -1 ;
- last_ocount= 0 ;
-}
-
-try(f_scan,suffix) list_elem *f_scan; char *suffix; {
- register list_elem *scan ;
- register trf *trafo ;
- /* Try to find a transformation path starting at f_scan for a
- file with the indicated suffix.
- If the suffix is already reached or the combiner is found
- call scan_found() to OK the scan.
- If a transformation is found it calls itself recursively
- with as starting point the next transformation in the list.
- */
- if ( stopsuffix && *stopsuffix && strcmp(stopsuffix,suffix)==0 ) {
- scan_found();
- return ;
- }
- scanlist(f_scan, scan) {
- trafo= t_cont(*scan) ;
- if ( satisfy(trafo,suffix) ) {
- /* Found a transformation */
- suf_found= 1;
-#ifdef DEBUG
- if ( debug>=4 ) {
- vprint("Found %s for %s: result %s\n",
- trafo->t_name,suffix,trafo->t_out);
- }
-#endif
- trafo->t_scan=YES ;
- if ( trafo->t_prep ) {
- if ( !cpp_trafo ) {
- find_cpp() ;
- }
- if ( stopsuffix &&
- strcmp(stopsuffix,
- cpp_trafo->t_out)==0 )
- {
- scan_found() ;
- return ;
- }
- }
- if ( trafo->t_combine ) {
- if ( stopsuffix ) {
- trafo->t_scan=NO;
- if ( *stopsuffix ) return ;
- } else {
- if( combiner &&
- combiner!=trafo && !com_err ){
- com_err++ ;
-werror("Multiple linkers present %s and %s",
- trafo->t_name,combiner->t_name) ;
- } else {
- combiner=trafo;
- }
- }
- scan_found() ;
- } else {
- try(l_next(*scan),trafo->t_out);
- }
- trafo->t_scan= NO ;
- }
- }
-}
-
-scan_found() {
- register list_elem *scan;
- int ncount, ocount ;
- register trf *keepit ;
-
- keepit= (trf *)0 ;
- suf_found= 1;
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Scan found\n") ;
-#endif
- /* Gather data used in comparison */
- ncount=0; ocount=0;
- scanlist(l_first(tr_list),scan) {
- if (t_cont(*scan)->t_scan) {
-#ifdef DEBUG
- if ( debug>=4 ) vprint("%s-",t_cont(*scan)->t_name) ;
-#endif
- if( t_cont(*scan)->t_optim ) ocount++ ;else ncount++ ;
- if ( !(t_cont(*scan)->t_combine) ) {
- keepit= t_cont(*scan) ;
- }
- }
- }
-#ifdef DEBUG
- if ( debug>=4 ) vprint("\n");
-#endif
- /* Is this transformation better then any found yet ? */
-#ifdef DEBUG
- if ( debug>=3 ) {
- vprint("old n:%d, o:%d - new n:%d, o:%d\n",
- last_ncount,last_ocount,ncount,ocount) ;
- }
-#endif
- if ( last_ncount== -1 || /* None found yet */
- last_ncount>ncount || /* Shorter nec. path */
- (last_ncount==ncount && /* Same nec. path, optimize?*/
- (Optflag? last_ocount<ocount : last_ocount>ocount ) ) ) {
- /* Yes it is */
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Better\n");
-#endif
- scanlist(l_first(tr_list),scan) {
- t_cont(*scan)->t_do=t_cont(*scan)->t_scan;
- }
- last_ncount=ncount; last_ocount=ocount;
- if ( keepit ) final=keepit ;
- }
-}
-
-int satisfy(trafo,suffix) register trf *trafo; char *suffix ; {
- register char *f_char, *l_char ;
- /* Check whether this transformation is present for
- the current machine and the parameter suffix is among
- the input suffices. If so, return 1. 0 otherwise
- */
- if ( trafo->t_isprep ) return 0 ;
- l_char=trafo->t_in ;
- while ( l_char ) {
- f_char= l_char ;
- if ( *f_char!=SUFCHAR || ! *(f_char+1) ) {
- fuerror("Illegal input suffix entry for %s",
- trafo->t_name) ;
- }
- l_char=index(f_char+1,SUFCHAR);
- if ( l_char ? strncmp(f_char,suffix,l_char-f_char)==0 :
- strcmp(f_char,suffix)==0 ) {
- return 1 ;
- }
- }
- return 0 ;
-}
-
-enum f_path scan_end() { /* Finalization */
- /* Return value indicating whether a transformation was found */
- /* Set the flags for the transformation up to, but not including,
- the combiner
- */
-
-#ifdef DEBUG
- if ( debug>=3 ) vprint("End_scan\n");
-#endif
- if ( last_ncount== -1 ) return suf_found ? F_NOPATH : F_NOMATCH ;
-#ifdef DEBUG
- if ( debug>=2 ) vprint("Transformation found\n");
-#endif
- if ( cpp_trafo && stopsuffix &&
- strcmp(stopsuffix,cpp_trafo->t_out)==0 ) {
- final= cpp_trafo ;
- }
- /* There might not be a final when the file can be eaten
- by the combiner
- */
- if ( final ) final->t_keep=YES ;
- if ( combiner ) {
- if ( !combiner->t_do ) error("Combiner YES/NO");
- combiner->t_do=NO ;
- }
- return F_OK ;
-}
-
-find_cpp() {
- register list_elem *elem ;
- scanlist( l_first(tr_list), elem ) {
- if ( t_cont(*elem)->t_isprep ) {
- if ( cpp_trafo ) fuerror("Multiple cpp's present") ;
- cpp_trafo= t_cont(*elem) ;
- }
- }
- if ( !cpp_trafo ) fuerror("No cpp present") ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-
-/* The processing of string valued variables,
- this is an almost self contained module.
-
- Five externally visible routines:
-
- setsvar(name,result)
- Associate the name with the result.
-
- name a string pointer
- result a string pointer
-
- setpvar(name,routine)
- Associate the name with the routine.
-
- name a string pointer
- routine a routine id
-
- The parameters name and result are supposed to be pointing to
- non-volatile string storage used only for this call.
-
- char *getvar(name)
- returns the pointer to a string associated with name,
- the pointer is produced by returning result or the
- value returned by calling the routine.
-
- name a string pointer
-
- Other routines called
-
- fatal(args*) When something goes wrong
- getcore(size) Core allocation
-
-*/
-
-extern char *getcore();
-extern fatal();
-
-struct vars {
- char *v_name;
- enum { routine, string } v_type;
-
- union {
- char *v_string;
- char *(*v_routine)();
- } v_value ;
- struct vars *v_next ;
-};
-
-static struct vars *v_first ;
-
-static struct vars *newvar(name) char *name; {
- register struct vars *new ;
-
- for ( new=v_first ; new ; new= new->v_next ) {
- if ( strcmp(name,new->v_name)==0 ) {
- throws(name) ;
- if ( new->v_type== string ) {
- throws(new->v_value.v_string) ;
- }
- return new ;
- }
- }
- new= (struct vars *)getcore( (unsigned)sizeof (struct vars));
- new->v_name= name ;
- new->v_next= v_first ;
- v_first= new ;
- return new ;
-}
-
-setsvar(name,str) char *name, *str ; {
- register struct vars *new ;
-
- new= newvar(name);
-#ifdef DEBUG
- if ( debug>=2 ) vprint("%s=%s\n", name, str) ;
-#endif
- new->v_type= string;
- new->v_value.v_string= str;
-}
-
-setpvar(name,rout) char *name, *(*rout)() ; {
- register struct vars *new ;
-
- new= newvar(name);
-#ifdef DEBUG
- if ( debug>=2 ) vprint("%s= (*%o)()\n",name,rout) ;
-#endif
- new->v_type= routine;
- new->v_value.v_routine= rout;
-}
-
-char *getvar(name) char *name ; {
- register struct vars *scan ;
-
- for ( scan=v_first ; scan ; scan= scan->v_next ) {
- if ( strcmp(name,scan->v_name)==0 ) {
- switch ( scan->v_type ) {
- case string:
- return scan->v_value.v_string ;
- case routine:
- return (*scan->v_value.v_routine)() ;
- }
- }
- }
- return (char *)0 ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ack.h"
-#include "list.h"
-#include "trans.h"
-#include "grows.h"
-#include "data.h"
-
-/****************************************************************************/
-/* Routines for transforming from one file type to another */
-/****************************************************************************/
-
-static growstring head ;
-static int touch_head= NO ;
-static growstring tail ;
-static int touch_tail= NO ;
-
-char *headvar(),*tailvar() ;
-
-int transform(phase) register trf *phase ; {
- int ok ;
-
- if ( !setfiles(phase) ) return 0 ;
- if ( !phase->t_visited ) {
- /* The flags are set up once.
- At the first time the phase is used.
- The program name and flags may already be touched
- by vieuwargs.
- */
- phase->t_visited=YES ;
- if ( !rts && phase->t_rts ) rts= phase->t_rts ;
- if ( phase->t_needed ) {
- add_head(phase->t_needed) ;
- add_tail(phase->t_needed) ;
- }
- }
- getcallargs(phase) ;
- ok= runphase(phase) ;
- if ( !ok ) rmtemps() ;
- /* Free the space occupied by the arguments,
- except for the combiner, since we are bound to exit soon
- and do not foresee further need of memory space */
- if ( !phase->t_combine ) discardargs(phase) ;
- disc_files() ;
- return ok ;
-}
-
-int do_combine() {
- setsvar(keeps(RTS), keeps(rts? rts : "") ) ;
- if ( !outfile ) outfile= combiner->t_out ;
- getmapflags(combiner);
- return transform(combiner) ;
-}
-
-getmapflags(phase) register trf *phase ; {
- register list_elem *elem ;
- int scanned ;
- register char *ptr ;
-
- scanlist(l_first(flags),elem) {
- scanned= *(l_content(*elem))&NO_SCAN ;
- *(l_content(*elem)) &= ~NO_SCAN ;
- if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
- scanned=NO_SCAN ;
-#ifdef DEBUG
- if ( debug >=4 ) {
- vprint("phase %s, added mapflag for %s\n",
- phase->t_name,
- l_content(*elem) ) ;
- }
-#endif
- }
- *(l_content(*elem)) |= scanned ;
- }
- if ( phase->t_combine ) {
- scanlist(l_first(c_arguments),elem) {
- if ( mapflag(&(phase->t_mapf),l_content(*elem)) ) {
- throws(l_content(*elem)) ;
- ptr= keeps(getvar(LIBVAR)) ;
- clr_noscan(ptr) ;
- l_content(*elem)= ptr ;
- }
- }
- scanlist(l_first(flags),elem) {
- /* Get the flags remaining for the loader,
- That is: all the flags neither eaten by ack nor
- one of the subprograms called so-far.
- The last fact is indicated by the NO_SCAN bit
- in the first character of the flag.
- */
- if ( !( *(l_content(*elem))&NO_SCAN ) ) {
- l_add(&(phase->t_flags),l_content(*elem)) ;
- }
- }
- }
-}
-
-
-do_Rflag(argp) char *argp ; {
- l_add(&R_list,argp) ;
-}
-
-char *needvar() {
- static growstring needed ;
- static int been_here = NO ;
-
- if ( !been_here ) {
- gr_init(&needed) ;
- been_here=YES ;
- gr_cat(&needed,headvar()) ;
- gr_cat(&needed,tailvar()) ;
- }
- return gr_start(needed) ;
-}
-
-char *headvar() {
- if ( !touch_head) return "" ;
- return gr_start(head) ;
-}
-
-add_head(str) char *str; {
- if ( !touch_head) {
- gr_init(&head) ;
- touch_head=YES ;
- }
- gr_cat(&head,str) ;
-}
-
-char *tailvar() {
- if ( !touch_tail ) return "" ;
- return gr_start(tail) ;
-}
-
-add_tail(str) char *str ; {
- if ( !touch_tail ) {
- gr_init(&tail) ;
- touch_tail=YES ;
- }
- gr_cat(&tail,str) ;
-}
-
-
-transini() {
- register list_elem *elem ;
- register trf *phase ;
-
- scanlist(l_first(R_list), elem) {
- set_Rflag(l_content(*elem)) ;
- }
- l_clear(&R_list) ;
- scanlist(l_first(tr_list), elem) {
- phase = t_cont(*elem) ;
- if ( !phase->t_combine ) getmapflags(phase);
- }
- setpvar(keeps(NEEDS),needvar) ;
- setpvar(keeps(HEAD),headvar) ;
- setpvar(keeps(TAIL),tailvar) ;
-}
-
-set_Rflag(argp) register char *argp ; {
- int seen ;
- register char *eos ;
- register list_elem *prog ;
- register int length ;
- char *eq ;
-
- eos= index(&argp[2],'-');
- eq= index(&argp[2],EQUAL) ;
- if ( !eos ) {
- eos= eq ;
- } else {
- if ( eq && eq<eos ) eos= eq ;
- }
- if ( !eos ) fuerror("Incorrect use of -R flag") ;
- length= eos - &argp[2] ;
- seen=NO ;
- scanlist(l_first(tr_list), prog) {
- if ( strncmp(t_cont(*prog)->t_name, &argp[2], length )==0 ) {
- if ( *eos=='-' ) {
- l_add(&(t_cont(*prog)->t_flags),eos) ;
- } else {
- t_cont(*prog)->t_prog= eos+1 ;
- }
- seen=YES ;
- }
- }
- if ( !seen ) error("Cannot find program for %s",argp) ;
- return ;
-}
-
-/**************************************************************************/
-/* */
-/* The creation of arguments for exec for a transformation */
-/* */
-/**************************************************************************/
-
-growstring scanb(line) char *line ; {
- /* Scan a line for backslashes, setting the NO_SCAN bit in characters
- preceded by a backslash.
- */
- register char *in_c ;
- register int token ;
- growstring result ;
- enum { TEXT, ESCAPED } state = TEXT ;
-
- gr_init(&result) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==BSLASH ) {
- state= ESCAPED ;
- } else {
- gr_add(&result,token) ;
- }
- break ;
- case ESCAPED :
- gr_add(&result,token|NO_SCAN) ;
- state=TEXT ;
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) werror("flag line ends with %c",BSLASH) ;
- return result ;
-}
-
-growstring scanvars(line) char *line ; {
- /* Scan a line variable replacements started by S_VAR.
- Two sequences exist: S_VAR name E_VAR, S_VAR name A_VAR text E_VAR.
- neither name nor text may contain further replacements.
- In the first form an error message is issued if the name is not
- present in the variables, the second form produces text
- in that case.
- The sequence S_VAR S_VAR is transformed into S_VAR.
- This to allow later recognition in mapflags, where B_SLASH
- would be preventing any recognition.
- */
- register char *in_c ;
- register int token ;
- growstring result ;
- growstring name ;
- register char *tr ;
- enum { TEXT, FIRST, NAME, SKIP, COPY } state = TEXT ;
-
- gr_init(&result) ; gr_init(&name) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==S_VAR ) {
- state= FIRST ;
- } else {
- gr_add(&result,token) ;
- }
- break ;
- case FIRST :
- switch ( token ) {
- case S_VAR :
- state= TEXT ;
- gr_add(&result,token) ;
- break ;
- case A_VAR :
- case C_VAR :
- fatal("empty string variable name") ;
- default :
- state=NAME ;
- gr_add(&name,token) ;
- break ;
- }
- break ;
- case NAME:
- switch ( token ) {
- case A_VAR :
- gr_add(&name,0) ;
- if ( tr=getvar(gr_start(name)) ) {
- while ( *tr ) {
- gr_add(&result,*tr++) ;
- }
- state=SKIP ;
- } else {
- state=COPY ;
- }
- gr_throw(&name) ;
- break ;
- case C_VAR :
- gr_add(&name,0) ;
- if ( tr=getvar(gr_start(name)) ) {
- while ( *tr ) {
- gr_add(&result,*tr++);
- }
- } else {
- werror("No definition for %s",
- gr_start(name)) ;
- }
- state=TEXT ;
- gr_throw(&name) ;
- break ;
- default:
- gr_add(&name,token) ;
- break ;
- }
- break ;
- case SKIP :
- if ( token==C_VAR ) state= TEXT ;
- break ;
- case COPY :
- if ( token==C_VAR ) state= TEXT ; else {
- gr_add(&result,token) ;
- }
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) {
- werror("flag line misses %c",C_VAR) ;
- gr_throw(&name) ;
- }
- return result ;
-}
-
-growstring scanexpr(line) char *line ; {
- /* Scan a line for conditional or flag expressions,
- dependent on the type. The format is
- S_EXPR suflist M_EXPR suflist T_EXPR tail C_EXPR
- the head and tail are passed to treat, together with the
- growstring for futher treatment.
- Nesting is not allowed.
- */
- register char *in_c ;
- char *heads ;
- register int token ;
- growstring sufs, tailval ;
- growstring result ;
- static list_head fsuff, lsuff ;
- enum { TEXT, FDOT, FSUF, LDOT, LSUF, FTAIL } state = TEXT ;
-
- gr_init(&result) ; gr_init(&sufs) ; gr_init(&tailval) ;
- for ( in_c= line ; *in_c ; in_c++ ) {
- token= *in_c&0377 ;
- switch( state ) {
- case TEXT :
- if ( token==S_EXPR ) {
- state= FDOT ;
- heads=in_c ;
- } else gr_add(&result,token) ;
- break ;
- case FDOT :
- if ( token==M_EXPR ) {
- state=LDOT ;
- break ;
- }
- token &= ~NO_SCAN ;
- if ( token!=SUFCHAR ) {
- error("Missing %c in expression",SUFCHAR) ;
- }
- gr_add(&sufs,token) ; state=FSUF ;
- break ;
- case FSUF :
- if ( token==M_EXPR || (token&~NO_SCAN)==SUFCHAR) {
- gr_add(&sufs,0) ;
- l_add(&fsuff,gr_final(&sufs)) ;
- }
- if ( token==M_EXPR ) {
- state=LDOT ;
- } else gr_add(&sufs,token&~NO_SCAN) ;
- break ;
- case LDOT :
- if ( token==T_EXPR ) {
- state=FTAIL ;
- break ;
- }
- token &= ~NO_SCAN ;
- if ( token!=SUFCHAR ) {
- error("Missing %c in expression",SUFCHAR) ;
- }
- gr_add(&sufs,token) ; state=LSUF ;
- break ;
- case LSUF :
- if ( token==T_EXPR || (token&~NO_SCAN)==SUFCHAR) {
- gr_add(&sufs,0) ;
- l_add(&lsuff,gr_final(&sufs)) ;
- }
- if ( token==T_EXPR ) {
- state=FTAIL ;
- } else gr_add(&sufs,token&~NO_SCAN) ;
- break ;
- case FTAIL :
- if ( token==C_EXPR ) {
- /* Found one !! */
- gr_add(&tailval,0) ;
- condit(&result,&fsuff,&lsuff,gr_start(tailval)) ;
- l_throw(&fsuff) ; l_throw(&lsuff) ;
- gr_throw(&tailval) ;
- state=TEXT ;
- } else gr_add(&tailval,token) ;
- break ;
- }
- }
- gr_add(&result,0) ;
- if ( state!=TEXT ) {
- l_throw(&fsuff) ; l_throw(&lsuff) ; gr_throw(&tailval) ;
- werror("flag line has unclosed expression starting with %6s",
- heads) ;
- }
- return result ;
-}
-
-condit(line,fsuff,lsuff,tailval) growstring *line ;
- list_head *fsuff, *lsuff;
- char *tailval ;
-{
- register list_elem *first ;
- register list_elem *last ;
-
-#ifdef DEBUG
- if ( debug>=4 ) vprint("Conditional for %s, ",tailval) ;
-#endif
- scanlist( l_first(*fsuff), first ) {
- scanlist( l_first(*lsuff), last ) {
- if ( strcmp(l_content(*first),l_content(*last))==0 ) {
- /* Found */
-#ifdef DEBUG
- if ( debug>=4 ) vprint(" matched\n") ;
-#endif
- while ( *tailval) gr_add(line,*tailval++ ) ;
- return ;
- }
- }
- }
-#ifdef DEBUG
- if ( debug>=4) vprint(" non-matched\n") ;
-#endif
-}
-
-int mapflag(maplist,cflag) list_head *maplist ; char *cflag ; {
- /* Expand a flag expression */
- /* The flag "cflag" is checked for each of the mapflags.
- A mapflag entry has the form
- -text NAME=replacement or -text*text NAME=replacement
- The star matches anything as in the shell.
- If the entry matches the assignment will take place
- This replacement is subjected to argument matching only.
- When a match took place the replacement is returned
- when not, (char *)0.
- The replacement sits in stable storage.
- */
- register list_elem *elem ;
-
- scanlist(l_first(*maplist),elem) {
- if ( mapexpand(l_content(*elem),cflag) ) {
- return 1 ;
- }
- }
- return 0 ;
-}
-
-int mapexpand(mapentry,cflag)
- char *mapentry, *cflag ;
-{
- register char *star ;
- register char *ptr ;
- register char *space ;
- int length ;
-
- star=index(mapentry,STAR) ;
- space=firstblank(mapentry) ;
- if ( star >space ) star= (char *)0 ;
- if ( star ) {
- length= space-star-1 ;
- if ( strncmp(mapentry,cflag,star-mapentry) ||
- strncmp(star+1,cflag+strlen(cflag)-length,length) ) {
- return 0 ;
- }
- /* Match */
- /* Now set star to the first char of the star
- replacement and length to its length
- */
- length=strlen(cflag)-(star-mapentry)-length ;
- if ( length<0 ) return 0 ;
- star=cflag+(star-mapentry) ;
-#ifdef DEBUG
- if ( debug>=6 ) {
- vprint("Starmatch (%s,%s) %.*s\n",
- mapentry,cflag,length,star) ;
- }
-#endif
- } else {
- if ( strncmp(mapentry,cflag,space-mapentry)!=0 ||
- cflag[space-mapentry] ) {
- return 0 ;
- }
- }
- ptr= skipblank(space) ;
- if ( *ptr==0 ) return 1 ;
- doassign(ptr,star,length) ;
- return 1 ;
-}
-
-doassign(line,star,length) char *line, *star ; {
- growstring varval, name, temp ;
- register char *ptr ;
-
- gr_init(&varval) ;
- gr_init(&name) ;
- ptr= line ;
- for ( ; *ptr && *ptr!=SPACE && *ptr!=TAB && *ptr!=EQUAL ; ptr++ ) {
- gr_add(&name,*ptr) ;
- }
- ptr= index(ptr,EQUAL) ;
- if ( !ptr ) {
- error("Missing %c in assignment %s",EQUAL,line);
- return ;
- }
- temp= scanvars(ptr+1) ;
- for ( ptr=gr_start(temp); *ptr; ptr++ ) switch ( *ptr ) {
- case STAR :
- if ( star ) {
- while ( length-- ) gr_add(&varval,*star++|NO_SCAN) ;
- break ;
- }
- default :
- gr_add(&varval,*ptr) ;
- break ;
- }
- gr_throw(&temp) ;
- setsvar(gr_final(&name),gr_final(&varval)) ;
-}
-
-#define ISBLANK(c) ( (c)==SPACE || (c)==TAB )
-
-unravel(line,action) char *line ; int (*action)() ; {
- /* Unravel the line, get arguments a la shell */
- /* each argument is handled to action */
- /* The input string is left intact */
- register char *in_c ;
- register int token ;
- enum { BLANK, ARG } state = BLANK ;
- growstring argum ;
-
- in_c=line ;
- for (;;) {
- token= *in_c&0377 ;
- switch ( state ) {
- case BLANK :
- if ( token==0 ) break ;
- if ( !ISBLANK(token) ) {
- state= ARG ;
- gr_init(&argum) ;
- gr_add(&argum,token&~NO_SCAN) ;
- }
- break ;
- case ARG :
- if ( ISBLANK(token) || token==0 ) {
- gr_add(&argum,0) ;
- (*action)(gr_start(argum)) ;
- gr_throw(&argum) ;
- state=BLANK ;
- } else {
- gr_add(&argum,token&~NO_SCAN) ;
- }
- break ;
- }
- if ( token == 0 ) break ;
- in_c++ ;
- }
-}
-
-char *c_rep(string,place,rep) char *string, *place, *rep ; {
- /* Produce a string in stable storage produced from 'string'
- with the character at place replaced by rep
- */
- growstring name ;
- register char *nc ;
- register char *xc ;
-
- gr_init(&name) ;
- for ( nc=string ; *nc && nc<place ; nc++ ) {
- gr_add(&name,*nc) ;
- }
-#ifdef DEBUG
- if ( *nc==0 ) fatal("Place is not in string") ;
-#endif
- for ( xc=rep ; *xc ; xc++ ) gr_add(&name,*xc|NO_SCAN) ;
- gr_add(&name,0) ;
- gr_cat(&name,nc+1) ;
- return gr_final(&name) ;
-}
-
-static list_head *curargs ;
-
-addargs(string) char *string ; {
- register char *temp, *repc ;
- register list_elem *elem ;
-
- repc=index(string,C_IN) ;
- if ( repc ) {
- /* INPUT FILE TOKEN seen, replace it and scan further */
- if ( repc==string && string[1]==0 ) {
- if ( in.p_path ) { /* All but combiner */
- l_add(curargs,keeps(in.p_path)) ;
- } else {
- scanlist( l_first(c_arguments), elem ) {
- l_add(curargs,l_content(*elem)) ;
- }
- }
- return ;
- }
- if ( in.p_path ) { /* Not for the combiner */
- temp=c_rep(string,repc,in.p_path) ;
- addargs(temp) ;
- throws(temp) ;
- } else { /* For the combiner */
- scanlist( l_first(c_arguments), elem ) {
- temp=c_rep(string,repc,l_content(*elem)) ;
- addargs(temp) ;
- throws(temp) ;
- }
- }
- return ;
- }
- repc=index(string,C_OUT) ;
- if ( repc ) {
- /* replace the outfile token as with the infile token */
-#ifdef DEBUG
- if ( !out.p_path ) fatal("missing output filename") ;
-#endif
- temp=c_rep(string,repc,out.p_path) ;
- addargs(temp) ;
- throws(temp) ;
- return ;
- }
- temp= keeps(string) ;
- clr_noscan(temp) ;
- l_add(curargs,temp) ;
-}
-
-getcallargs(phase) register trf *phase ; {
- growstring arg1, arg2 ;
-
- arg1= scanvars(phase->t_argd) ;
-#ifdef DEBUG
- if ( debug>=3 ) { vprint("\tvars: ") ; prns(gr_start(arg1)) ; }
-#endif
- arg2= scanexpr(gr_start(arg1)) ;
-#ifdef DEBUG
- if ( debug>=3 ) { vprint("\texpr: ") ; prns(gr_start(arg2)) ; }
-#endif
- gr_throw(&arg1) ;
- curargs= &phase->t_args ;
- unravel( gr_start(arg2), addargs ) ;
- gr_throw(&arg2) ;
-}
-
-discardargs(phase) register trf *phase ; {
- l_throw(&phase->t_args) ;
-}
+++ /dev/null
-/* This structure is the center of all actions */
-/* It contains the description of all phases,
- the suffices they consume and produce and various properties */
-
-typedef struct transform trf;
-
-struct transform {
- char *t_in ; /* Suffices in '.o.k' */
- char *t_out ; /* Result '.suffix' or 'name' */
- char *t_name ; /* The name of this transformation */
- list_head t_mapf ; /* Mapflags argument, uses varrep */
- char *t_argd ; /* Argument descriptor, uses varrep */
- char *t_needed ; /* Suffix indicating the libraries needed */
- char *t_rts ; /* Suffix indicating the major language used*/
- int t_stdin:1 ; /* The input is taken on stdin */
- int t_stdout:1 ; /* The output comes on stdout */
- int t_combine:1 ; /* Transform several files to one result */
- int t_visited:1 ; /* NO before setup, YES after */
- int t_prep:2 ; /* Needs preprocessor YES/NO/MAYBE */
- int t_optim:1 ; /* Is optimizer */
- int t_isprep:1 ; /* Is preprocessor */
- int t_keep:1 ; /* Keep the output file */
- char *t_prog ; /* Pathname for load file */
- list_head t_flags ; /* List of flags */
- list_head t_args ; /* List of arguments */
- int t_scan:1 ; /* Used while finding path's */
- int t_do:1 ; /* Is in path to execute */
-} ;
-
-#define t_cont(elem) ((trf *)l_content(elem))
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/**********************************************************************/
-/* */
-/* Several utility routines used throughout ack */
-/* error handling, string handling and such. */
-/* */
-/**********************************************************************/
-
-#include "ack.h"
-#include <ctype.h>
-#include <stdio.h>
-
-extern char *progname ;
-extern int w_flag ;
-extern int n_error;
-
-extern char *calloc();
-extern char *realloc();
-
-#ifdef DEBUG
-# define STDOUT stdout
-#else
-# define STDOUT stderr
-#endif
-
-char *basename(string) char *string ; {
- static char retval[20] ;
- char *last_dot, *last_start ;
- register char *store;
- register char *fetch ;
- register int ctoken ;
-
- last_dot= (char *)0 ;
- last_start= string ;
- for ( fetch=string ; ; fetch++ ) {
- switch ( ctoken= *fetch&0377 ) {
- case SUFCHAR : last_dot=fetch ; break ;
- case '/' : last_start=fetch+1 ; break ;
- case 0 : goto out ;
- }
- if ( !isascii(ctoken) || !isprint(ctoken) ) {
- werror("non-ascii characters in argument %s",string) ;
- }
- }
-out:
- if ( ! *last_start ) fuerror("empty filename \"%s\"",string) ;
- for ( fetch= last_start, store=retval ;
- *fetch && fetch!=last_dot && store< &retval[sizeof retval-1] ;
- fetch++, store++ ) {
- *store= *fetch ;
- }
- *store= 0 ;
- return retval ;
-}
-
-clr_noscan(str) char *str ; {
- register char *ptr ;
- for ( ptr=str ; *ptr ; ptr++ ) {
- *ptr&= ~NO_SCAN ;
- }
-}
-
-char *skipblank(str) char *str ; {
- register char *ptr ;
-
- for ( ptr=str ; *ptr==SPACE || *ptr==TAB ; ptr++ ) ;
- return ptr ;
-}
-
-char *firstblank(str) char *str ; {
- register char *ptr ;
-
- for ( ptr=str ; *ptr && *ptr!=SPACE && *ptr!=TAB ; ptr++ ) ;
- return ptr ;
-}
-
-/* VARARGS1 */
-fatal(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Fatal internal error */
- fprintf(STDOUT,"%s: fatal internal error, ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- quit(-2) ;
-}
-
-
-/* VARARGS1 */
-vprint(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Diagnostic print, no auto NL */
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
-}
-
-#ifdef DEBUG
-prns(s) register char *s ; {
- for ( ; *s ; s++ ) {
- putc((*s&0377)&~NO_SCAN,STDOUT) ;
- }
- putc('\n',STDOUT) ;
-}
-#endif
-
-/* VARARGS1 */
-fuerror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Fatal user error */
- fprintf(STDOUT,"%s: ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- quit(-1) ;
-}
-
-/* VARARGS1 */
-werror(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* Warning user error, w_flag */
- if ( w_flag ) return ;
- fprintf(STDOUT,"%s: warning, ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
-}
-
-/* VARARGS1 */
-error(fmt,p1,p2,p3,p4,p5,p6,p7) char *fmt ; {
- /* User error, it is the callers responsibility to quit */
- fprintf(STDOUT,"%s: ",progname) ;
- fprintf(STDOUT,fmt,p1,p2,p3,p4,p5,p6,p7);
- fprintf(STDOUT,"\n") ;
- n_error++ ;
-}
-
-do_flush() {
- fflush(stdout) ;
- fflush(stderr) ;
-}
-
-noodstop() {
- quit(-3) ;
-}
-
-quit(code) {
- rmtemps();
- exit(code);
-}
-/******
- char *keeps(string)
- Keep the string in stable storage.
- throws(string)
- Remove the string stored by keep from stable storage.
-***********/
-
-char *keeps(str) char *str ; {
- register char *result ;
- result= getcore( (unsigned)(strlen(str)+1) ) ;
- if ( !result ) fatal("Out of core") ;
- return strcpy(result,str) ;
-}
-
-throws(str) char *str ; {
- freecore(str) ;
-}
-
-char *getcore(size) unsigned size ; {
- register char *retptr ;
-
- retptr= calloc(1,size) ;
- if ( !retptr ) fatal("Out of memory") ;
- return retptr ;
-}
-
-char *changecore(ptr,size) char *ptr ; unsigned size ; {
- register char *retptr ;
-
- retptr= realloc(ptr,size) ;
- if ( !retptr ) fatal("Out of memory") ;
- return retptr ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-#include "ip_spec.h"
-
-short opt_line ; /* max_line_no - # lines removed from end
- after perfoming exc's.
- Used to estimate the distance in # of
- instructions.
- */
-/*
-** Determine the exact instruction length & format where possible, and the
-** the upper and lower limits otherwise. Enter limits in labeltable
-*/
-pass_3()
-{
- register line_t *lnp, *rev_lnp;
- line_t *tmp_lnp;
- locl_t *lbp;
- int min_l, max_l, min_bytes;
- short last_line ;
- short hol_err_line ;
- register insno ;
-
- pass = 3;
- opt_line= line_num ; hol_err_line=0 ;
- min_bytes = max_bytes = 0; rev_lnp= lnp_cast 0 ;
- for (lnp = pstate.s_fline ; lnp ; opt_line--, line_num-- ) {
- pstate.s_fline= lnp;
- insno = ctrunc(lnp->instr_num);
- switch( insno ) {
- case sp_fpseu :
- last_line = line_num ;
- line_num = lnp->ad.ad_ln.ln_first ;
- opt_line -= lnp->ad.ad_ln.ln_extra ;
- lnp->ad.ad_ln.ln_first= last_line ;
- break ;
- case sp_ilb1 :
- lbp = lnp->ad.ad_lp;
- lbp->l_defined = SEEN;
- lbp->l_min = min_bytes;
- lbp->l_max = max_bytes;
- break ;
- default:
- if ( lnp->type1==CONST && (em_flag[insno]&EM_PAR)==PAR_G ) {
- if (holbase != 0) {
- lnp->ad.ad_i += holbase;
- if (lnp->ad.ad_i >= holsize) {
- hol_err_line= line_num ;
- }
- }
- } else
- if ( lnp->type1>=VALLOW && (em_flag[insno]&EM_PAR)==PAR_G ) {
- if (holbase != 0) {
- pstate.s_fline= lnp->l_next ;
- newline(CONST) ;
- pstate.s_fline->instr_num= insno ;
- pstate.s_fline->ad.ad_i=
- VAL1(lnp->type1)+holbase ;
- freearea((area_t)lnp,
- (unsigned)linesize[VALLOW]) ;
- lnp= pstate.s_fline ;
- if ( VAL1(lnp->type1) >= holsize) {
- hol_err_line= line_num ;
- }
- }
- }
- if ( !valid(lnp) ) fatal("Invalid operand") ;
-
- determine_props(lnp, &min_l, &max_l);
- min_bytes += min_l; max_bytes += max_l;
- break ;
- }
- tmp_lnp= lnp->l_next ;
- lnp->l_next= rev_lnp ; rev_lnp= lnp ;
- lnp= tmp_lnp ;
- }
- pstate.s_fline= rev_lnp ;
- if ( hol_err_line ) {
- line_num= hol_err_line ;
- werror("address exceeds holsize") ;
- }
-}
-
-
-/*
-** Determine the format that should be used for each instruction,
-** depending on its offsets
-*/
-
-determine_props(lnp, min_len, max_len)
- line_t *lnp;
- int *min_len, *max_len;
-{
- cons_t val ;
- register int insno ;
- register char *f_off, *l_off ;
- char defined ;
-
- insno=ctrunc(lnp->instr_num) ;
- val=parval(lnp,&defined) ;
- if ( !defined ) {
- switch(em_flag[insno]&EM_PAR) {
- case PAR_NO:
- case PAR_W:
- f_off = findnop(insno) ;
- break ;
- case PAR_G:
- /* We want the maximum address that is a multiple
- of the wordsize.
- Assumption: there is no shortie for
- intr max_word_multiple
- where intr is a instruction allowing parameters
- that are not a word multiple (PAR_G).
- */
- f_off = findfit(insno, maxadr&(~(wordsize-1))) ;
- break ;
- case PAR_B:
- f_off = findfit(insno, (cons_t)0) ;
- l_off = findfit(insno, val ) ;
- if ( f_off != l_off ) {
- *min_len=oplength(*f_off) ;
- *max_len=oplength(*l_off) ;
- lnp->opoff = NO_OFF ;
- return ;
- }
- break ;
- }
- } else {
- f_off = findfit(insno,val) ;
- }
- lnp->opoff = f_off ;
- *min_len = *max_len = oplength(*f_off) ;
-}
-
-char *findfit(instr,val) int instr ; cons_t val ; {
- register char *currc,*endc ;
- int found, flags, number ;
- char *opc ;
-
- endc = opindex[instr+1] ;
- for ( currc=opindex[instr], found=0 ;
- !found && currc<endc ; currc++ ) {
- opc = currc ;
- flags=ctrunc(*currc++) ;
- switch ( flags&OPTYPE ) {
- case OPNO :
- continue ;
- case OPMINI :
- case OPSHORT :
- number=ctrunc(*++currc) ;
- }
- found = opfit(flags, number, val, em_flag[instr]&EM_PAR ) ;
- }
- if ( !found ) fatal("Cannot find interpreter opcode") ;
- return opc ;
-}
-
-char *findnop(instr) int instr ; {
- register char *currc,*endc ;
-
- endc = opindex[instr+1] ;
- for ( currc=opindex[instr] ; currc<endc ; currc++ ) {
- switch ( ctrunc(*currc)&OPTYPE ) {
- case OPNO :
- return currc ;
- case OPSHORT :
- case OPMINI :
- currc++ ;
- }
- currc++ ;
- }
- fatal("Cannot find interpreter opcode") ;
- /* NOTREACHED */
-}
-
-int opfit(flag,number,val,i_flag)
-int i_flag,flag,number ; cons_t val ; {
- /* Number is invalid if flag does not contain MINI or SHORT */
- switch ( flag&OPRANGE ) {
- case OP_POS :
- if ( val<0 ) return 0 ;
- break ;
- case OP_NEG :
- if ( val>=0 ) return 0 ;
- break ;
- }
- if ( flag&OPWORD ) {
- if ( val%wordsize ) return 0 ;
- val /= wordsize ;
- }
- if ( flag&OPNZ ) {
- if ( val==0 ) return 0 ;
- val-- ;
- }
- switch ( flag&OPTYPE ) {
- case OPMINI :
- if ( val<0 ) val = -1-val ;
- return val>=0 && val<number ;
- case OPSHORT :
- if ( val<0 ) val = -1-val ;
- return val>=0 && val<number*256 ;
- case OP16 :
- if ( i_flag==PAR_G ) return val>=0 && val<=maxadr ;
- return val>= -32768 && val<=32767 ;
- case OP32 :
- return TRUE ;
- default :
- fatal("illegal OPTYPE value") ;
- /* NOTREACHED */
- }
-}
-
-int oplength(flag) int flag ; {
- int cnt ;
-
- cnt=1 ;
- if ( flag&OPESC ) cnt++ ;
- switch( flag&OPTYPE ) {
- case OPNO :
- case OPMINI : break ;
- case OP8 :
- case OPSHORT : cnt++ ; break ;
- case OP16 : cnt+=2 ; break ;
- case OP32 : cnt+=5 ; break ;
- case OP64 : cnt+=9 ; break ;
- }
- return cnt ;
-}
-
-/*
-** return estimation of value of parameter
-*/
-cons_t parval(lnp,defined)
- line_t *lnp;
- char *defined;
-{
- register int type;
- register locl_t *lbp;
- register glob_t *gbp;
- cons_t offs ;
-
- *defined = TRUE ;
- type = lnp->type1;
- switch(type) {
- default: if ( type>=VALLOW && type<=VALHIGH )
- return VAL1(type) ;
- error("bad type during parval");
- break;
- case CONST:
- return(lnp->ad.ad_i);
- case GLOSYM:
- case GLOOFF:
- if ( type!=GLOOFF) {
- gbp = lnp->ad.ad_gp;
- offs= 0 ;
- } else {
- gbp =lnp->ad.ad_df.df_gp ;
- offs=lnp->ad.ad_df.df_i ;
- }
- if(gbp->g_status&DEF)
- return(gbp->g_val.g_addr+offs);
- else {
- *defined = FALSE ;
- return offs ;
- }
- case LOCSYM:
- lbp = lnp->ad.ad_lp;
- switch(pass) {
- default:error("bad pass in parval");
- case 3:
- *defined = FALSE;
- switch(lbp->l_defined) {
- default : fatal("Illegal local label") ;
- case NO :
- error("Undefined local label") ;
- lbp->l_defined= NOTPRESENT ;
- case NOTPRESENT:
- return max_bytes;
- case SEEN :
- return max_bytes - lbp->l_min ;
- case YES :
- /* l_min contains line_num
- adjusted for exc's.
- */
- return (lbp->l_min - opt_line -1 ) * maxinsl ;
- }
- case 4: if(lbp->l_defined == YES)
- return(lbp->l_min-prog_size-maxinsl);
- return max_bytes - lbp->l_max- prog_size;
- case 5: if (lbp->l_defined == YES )
- return lbp->l_min ;
- *defined = FALSE ;
- break ;
- }
- break;
- case MISSING:
- *defined = FALSE ;
- break;
- case PROCNAME:
- return(lnp->ad.ad_pp->p_num);
- }
- return(0);
-}
-int valid(lnp) register line_t *lnp ; {
- cons_t val ;
- char type ;
-
- type = lnp->type1 ;
- if ( type>=VALLOW && type<=VALHIGH ) {
- val= VAL1(type) ;
- type= CONST ;
- } else if ( type==CONST ) val = lnp->ad.ad_i ;
- switch ( em_flag[ctrunc(lnp->instr_num)]&EM_PAR ) {
- case PAR_NO:
- return type==MISSING ;
- case PAR_C:
- if ( type!=CONST ) return FALSE;
- if ( val>maxint && val<=maxunsig ) {
- lnp->ad.ad_i = val -maxunsig -1 ;
- }
- return TRUE ;
- case PAR_D:
- if ( type!=CONST ) return FALSE;
- if ( val>maxdint && val<=maxdunsig ) {
- lnp->ad.ad_i = val -maxdunsig -1 ;
- }
- return TRUE ;
- case PAR_L:
- case PAR_F:
- return type==CONST ;
- case PAR_N:
- return type==CONST && val>=0 ;
- case PAR_G:
- return type==CONST || type==GLOSYM || type==GLOOFF ;
- case PAR_W:
- if ( type==MISSING ) return TRUE ;
- case PAR_S:
- return type==CONST && val>0 && val%wordsize==0 ;
- case PAR_Z:
- return type==CONST && val>=0 && val%wordsize==0 ;
- case PAR_O:
- return type==CONST && val>=0 &&
- ( val >= wordsize ? val%wordsize : wordsize%val ) == 0 ;
- case PAR_P:
- return type==PROCNAME ;
- case PAR_B:
- return type==LOCSYM ;
- case PAR_R:
- return type==CONST && val>=0 && val<=3 ;
- default:
- fatal("Unknown parameter type") ;
- /* NOTREACHED */
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-/*
-** Make scans to do final assignment of instruction sizes & formats
-** to those not already done. assign final values to labels
-*/
-pass_4()
-{
- register line_t *lnp;
- register locl_t *lbp;
- int min_l, max_l;
- int instr;
-
- pass = 4;
- prog_size= 0 ;
- for (lnp = pstate.s_fline ; lnp ; lnp= lnp->l_next, line_num++) {
- instr = ctrunc(lnp->instr_num);
- if ( instr==sp_fpseu ) {
- line_num = lnp->ad.ad_ln.ln_first ;
- continue ;
- }
- if ( instr==sp_ilb1 ) {
- lbp = lnp->ad.ad_lp;
- lbp->l_min= prog_size; lbp->l_defined = YES;
- continue ;
- }
-
- if (lnp->opoff == NO_OFF)
- {
- determine_props(lnp, &min_l, &max_l);
- if (min_l != max_l)
- fatal("no size known");
- } else {
- min_l = oplength(*(lnp->opoff)) ;
- }
- prog_size += min_l ;
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-#include "ip_spec.h"
-
-/*
-** Pass 5 of EM1 assembler/loader
-** Fix reloc tables
-** Write out code
-*/
-
-pass_5() {
- register line_t *lnp;
- cons_t off1;
- char defined ;
- int afterlength, partype ;
- register int inslength, ope;
- char *op_curr ;
-
- pass = 5;
- afterlength = 0;
- for (lnp = pstate.s_fline ; lnp ; lnp= lnp->l_next, line_num++ ) {
- ope = ctrunc(lnp->instr_num);
- if ( ope==sp_ilb1 ) continue ;
- if ( ope==sp_fpseu ) {
- line_num = lnp->ad.ad_ln.ln_first ;
- continue ;
- }
- off1 = parval(lnp,&defined);
- if ( (op_curr = lnp->opoff)==NO_OFF ) {
- fatal("opoff assertion failed") ;
- }
- inslength = oplength(*op_curr) ;
- afterlength += inslength ;
-
- /*
- * Change absolute offset to a relative for branches.
- */
-
-
- partype= em_flag[ope]&EM_PAR ;
- if ( partype==PAR_B && defined ) {
- off1 -= afterlength;
- }
-
-#ifdef JOHAN
- if ( jflag ) {
- extern char em_mnem[][4] ;
- printf("%s %D\n",em_mnem[ope],off1) ;
- }
-#endif
-
- if ( !defined && partype==PAR_G ) { /* must be external */
- text_reloc((lnp->type1==GLOSYM ?
- lnp->ad.ad_gp:lnp->ad.ad_df.df_gp),
- (FOFFSET)(textbytes+afterlength-inslength) ,
- op_curr-opchoice);
- xputarb(inslength,off1,tfile);
- textoff += inslength ;
- } else {
- genop(op_curr,off1,partype) ;
- }
- } /* end forloop */
- line_num-- ;
-
- patchcase();
- textbytes += prog_size;
- if ( textbytes>maxadr ) fatal("Maximum code area size exceeded") ;
-
-} /* end pass_5 */
-
-genop(startc,value,i_flag) char *startc ; cons_t value ; int i_flag ; {
- char *currc ;
- register flag ;
- char opc ;
-
- /*
- * Real code generation.
- */
-
- currc= startc ;
- flag = ctrunc(*currc++);
- opc = *currc++;
- if ( (flag&OPTYPE)!=OPNO ) {
-
- if ( !opfit(flag,*currc,value,i_flag) ) {
- fatal("parameter value unsuitable for selected opcode") ;
- }
- if ( flag&OPWORD ) {
- if ( value%wordsize!=0 ) {
- error("parameter not word multiple");
- }
- value /= wordsize ;
- }
- if ( flag&OPNZ ) {
- if ( value<=0 ) error("negative parameter");
- value-- ;
- }
- }
- if ( flag&OPESC ) put8(ESC) ;
-
- switch ( flag&OPTYPE ) {
- case OPMINI :
- opc += value<0 ? -1-value : value ;
- break ;
- case OPSHORT :
- if ( value<0 ) {
- opc += -1-(value>>8) ;
- } else {
- opc += value>>8 ;
- }
- break ;
- case OP32 :
- case OP64 :
- put8(ESC_L) ;
- }
-
-#ifdef DUMP
- if ( c_flag ) {
- switch(flag&OPTYPE) {
- case OP32 :
- case OP64 :
- opcnt3[opc&0377]= 1 ;
- break ;
- default :
- if ( flag&OPESC ) opcnt2[opc&0377]= 1 ;
- else opcnt1[opc&0377]= 1 ;
- break ;
- }
- }
-#endif
-
- put8(opc) ;
- switch( flag&OPTYPE ) {
- case OPNO:
- case OPMINI:
- break ;
- case OPSHORT:
- case OP8:
- put8((char)value) ;
- break ;
- case OP16:
- put16(int_cast value) ;
- break ;
- case OP32:
- put32(value) ;
- break ;
- case OP64:
- put64(value) ;
- break ;
- }
-}
-
-patchcase() {
- register relc_t *r;
- register locl_t *k;
-
- if ( r= pstate.s_fdata ) {
- r= r->r_next ;
- } else {
- r= f_data ;
- }
- for( ; r ; r= r->r_next ) {
- if (r->r_typ == RELLOC) {
- r->r_typ = RELADR;
- k = r->r_val.rel_lp;
- if (k->l_defined==YES)
- r->r_val.rel_i = k->l_min + textbytes;
- else
- error("case label at line %d undefined",
- k->l_min);
- }
- }
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-#include "ip_spec.h"
-
-#ifdef DUMP
-static char *typestr[] =
- {"missing","const","procname","glosym","locsym","glosym+off","pseudo"};
-static char *labstr[] = {"EMPTY","no","yes","seen","notpresent"};
-static char formstr[] = { 'm','s','-','1','2','4','8' };
-static char *r_data[] = { "null","glob","head","loc","adr" };
-
-cons_t nicepr(typ,ap) addr_u *ap; char typ; {
- register proc_t *pl;
-
- switch (typ) {
- case CONST:
- return(ap->ad_i);
- case LOCSYM:
- return(int_cast ap->ad_lp);
- case GLOOFF:
- return(ap->ad_df.df_gp - mglobs);
- case GLOSYM:
- return(ap->ad_gp - mglobs);
- case PROCNAME:
- pl = ap->ad_pp;;
- if (pl->p_status&EXT)
- return((pl-xprocs)+1000);
- else
- return(pl-mprocs);
- default:
- if ( typ>=VALLOW && typ<=VALHIGH ) return VAL1(typ) ;
- break ;
- }
- return(0);
-}
-
-char *pflags(flg) int flg ; {
- static char res[9] ;
- register char *cp ;
-
- cp=res ;
- if ( flg&OPESC ) *cp++ = 'e' ;
- switch ( flg&OPRANGE ) {
- case OP_NEG : *cp++ = 'N' ; break ;
- case OP_POS : *cp++ = 'P' ; break ;
- }
- if ( flg&OPWORD ) *cp++ = 'w' ;
- if ( flg&OPNZ ) *cp++ = 'o' ;
- *cp++ = formstr[flg&OPTYPE] ;
- *cp++ = 0 ;
- return res ;
-}
-
-
-dump(n)
-{
- register glob_t *gb;
- register line_t *ln;
- register locl_t *lbp;
- register locl_t *lbhead;
- proc_t *pl;
- int i;
- int insno;
- extern char em_mnem[][4] ;
-
- if (d_flag==0) return;
-if ( (n==0 && d_flag) || (n==4 && d_flag>=2) || (n<100 && d_flag>=3) ) {
- printf("\nEM1-assembler ***** pass %1d complete:\n",n);
- printf("current size %D\n",prog_size) ;
- printf(" %9.9s%9.9s%14.14s%8.8s%8.8s\n", "instr_nr",
- "type1","addr1","length","format");
- for (ln = pstate.s_fline ; ln ;
- ln = ln->l_next, n>=3 || n==0 ? i++ : i-- ) {
- insno = ctrunc(ln->instr_num) ;
- if ( insno==sp_fpseu ) {
- i= ln->ad.ad_ln.ln_first ;
- continue ;
- }
- printf("%4d ",i) ;
- switch(insno) {
- default:
- printf(
- " %3.3s",em_mnem[insno]) ;
- break ;
- case sp_ilb1:
- printf("l ");
- break;
- case sp_fpseu:
- printf("p ");
- break;
- }
- printf(" %9.9s%14D",
- typestr[ln->type1<VALLOW ? ln->type1 : CONST],
- nicepr(ln->type1,&ln->ad)) ;
- if ( ln->opoff != NO_OFF )
- printf("%5d %.6s",
- oplength(*(ln->opoff)),pflags(*(ln->opoff)));
- printf("\n");
- }
- printf("\n %8s%8s%8s%8s%8s\n","labnum","labid","minval","maxval",
- "defined");
- for ( i = 0, lbhead= *pstate.s_locl ; i<LOCLABSIZE ; lbhead++,i++) {
- if ( lbhead->l_defined!=EMPTY ) printf("%4d\n",i);
- for (lbp= lbhead; lbp != lbp_cast 0; lbp= lbp->l_chain) {
- if (lbp->l_defined!=EMPTY)
- printf(" %8d%8d%8d%8d %-s\n",
- lbp->l_hinum*LOCLABSIZE + i,
- int_cast lbp,lbp->l_min,
- lbp->l_max, labstr[lbp->l_defined]);
- }
- }
-}
-if ( ( (n==0 || n>=100) && d_flag) || (n<=1 && d_flag>=2) ) {
- if ( n==0 || n==100 ) {
- printf("File %s",curfile) ;
- if ( archmode ) printf("(%.14s)",archhdr.ar_name);
- printf(" :\n\n") ;
- }
- printf("Local data labels:\n");
- printf(
- "\n\t%8.8s %8.8s %8.8s\n","g_name","g_status","g_addr");
- for (gb = mglobs,i = 0;gb < &mglobs[oursize->n_mlab]; gb++, i++)
- if (gb->g_name[0] != 0) {
- printf("%5d\t%8.6s",i,gb->g_name);
- printf(" %8o %8ld\n",gb->g_status,gb->g_val.g_addr);
- }
- printf("\n\nGlobal data labels\n");
- printf("\n\t%8.8s %8.8s %8.8s\n",
- "g_name","g_status","g_addr");
- for (gb = xglobs,i = 0;gb < &xglobs[oursize->n_glab]; gb++, i++)
- if (gb->g_name[0] != 0) {
- printf("%5d\t%8.6s",i,gb->g_name);
- printf(" %8o %8ld\n",gb->g_status,gb->g_val.g_addr);
- }
- printf("\n\nLocal procedures\n");
- printf("\n\t%8.8s%8s%8s\t%8s%8s\n",
- "name","status","num","off","locals");
- for (pl=mprocs;pl< &mprocs[oursize->n_mproc]; pl++)
- if (pl->p_name[0]) {
- printf("%4d\t%-8s%8o%8d",
- pl-mprocs,pl->p_name,pl->p_status,pl->p_num);
- if (pl->p_status&DEF)
- printf("\t%8ld%8ld",proctab[pl->p_num].pr_off,
- proctab[pl->p_num].pr_loc);
- printf("\n");
- }
- printf("\nGlobal procedures\n");
- printf("\n\t%8s%8s%8s\t%8s%8s\n",
- "name","status","num","off","locals");
- for (pl=xprocs;pl< &xprocs[oursize->n_xproc]; pl++)
- if (pl->p_name[0]) {
- printf("%4d\t%-8s%8o%8d",
- pl-xprocs,pl->p_name,pl->p_status,pl->p_num);
- if (pl->p_status&DEF)
- printf("\t%8ld%8ld",proctab[pl->p_num].pr_off,
- proctab[pl->p_num].pr_loc);
- printf("\n");
- }
- if ( r_flag ) {
- register relc_t *rl ;
- printf("\nData relocation\n") ;
- printf("\n\t%10s %10s %10s\n","offset","type","value");
- for ( rl=f_data ; rl ; rl= rl->r_next ) {
- printf("\t%10D %10s ",rl->r_off,r_data[rl->r_typ]);
- switch(rl->r_typ) {
- case RELADR:
- case RELHEAD:
- printf("%10D\n",rl->r_val.rel_i) ;
- break ;
- case RELGLO:
- printf("%8.8s\n",rl->r_val.rel_gp->g_name) ;
- break ;
- case RELLOC:
- printf("%10d\n",rl->r_val.rel_lp) ;
- break ;
- case RELNULL:
- printf("\n"); break ;
- }
- }
- printf("\n\nText relocation\n") ;
- printf("\n\t%10s %10s %10s\n","offset","flags","value");
- for ( rl=f_text; rl ; rl= rl->r_next ) {
- printf("\t%10D %10s ",
- rl->r_off,pflags(opchoice[rl->r_typ&~RELMNS])) ;
- if ( rl->r_typ&RELMNS )
- printf("%10D\n",rl->r_val.rel_i) ;
- else printf("\n") ;
- }
- }
-
-
-}
-}
-#endif
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-/*
-** utilities of EM1-assembler/loader
-*/
-
-static int globstep;
-
-/*
- * glohash returns an index in table and leaves a stepsize in globstep
- *
- */
-
-static int glohash(aname,size) char *aname; {
- register char *p;
- register i;
- register sum;
-
- /*
- * Computes a hash-value from a string.
- * Algorithm is adding all the characters after shifting some way.
- */
-
- for(sum=i=0,p=aname;*p;i += 3)
- sum += (*p++)<<(i&07);
- sum &= 077777;
- globstep = (sum / size) + 7;
- return(sum % size);
-}
-
-/*
- * lookup idname in labeltable , if it is not there enter it
- * return index in labeltable
- */
-
-glob_t *glo2lookup(name,status) char *name; {
-
- return(glolookup(name,status,mglobs,oursize->n_mlab));
-}
-
-glob_t *xglolookup(name,status) char *name; {
-
- return(glolookup(name,status,xglobs,oursize->n_glab));
-}
-
-static void findext(g) glob_t *g ; {
- glob_t *x;
-
- x = xglolookup(g->g_name,ENTERING);
- if (x && (x->g_status&DEF)) {
- g->g_status |= DEF;
- g->g_val.g_addr = x->g_val.g_addr;
- }
- g->g_status |= EXT;
-}
-
-glob_t *glolookup(name,status,table,size)
-char *name; /* name */
-int status; /* kind of lookup */
-glob_t *table; /* which table to use */
-int size; /* size for hash */
-{
- register glob_t *g;
- register rem,j;
- int new;
-
- /*
- * lookup global symbol name in specified table.
- * Various actions are taken depending on status.
- *
- * DEFINING:
- * Lookup or enter the symbol, check for mult. def.
- * OCCURRING:
- * Lookup the symbol, export if not known.
- * INTERNING:
- * Enter symbol local to the module.
- * EXTERNING:
- * Enter symbol visable from every module.
- * SEARCHING:
- * Lookup the symbol, return 0 if not found.
- * ENTERING:
- * Lookup or enter the symbol, don't check
- */
-
- rem = glohash(name,size);
- j = 0; new=0;
- g = &table[rem];
- while (g->g_name[0] != 0 && strcmp(name,g->g_name) != 0) {
- j++;
- if (j>size)
- fatal("global label table overflow");
- rem = (rem + globstep) % size;
- g = &table[rem];
- }
- if (g->g_name[0] == 0) {
- /*
- * This symbol is shining new.
- * Enter it in table except for status = SEARCHING
- */
- if (status == SEARCHING)
- return(0);
- strcpy(g->g_name,name);
- g->g_status = 0;
- g->g_val.g_addr=0;
- new++;
- }
- switch(status) {
- case SEARCHING: /* nothing special */
- case ENTERING:
- break;
- case INTERNING:
- if (!new)
- werror("INA must be first occurrence of '%s'",name);
- break;
- case EXTERNING: /* lookup in other table */
- /*
- * The If statement is removed to be friendly
- * to Backend writers having to deal with assemblers
- * not following our conventions.
- if (!new)
- error("EXA must be first occurrence of '%s'",name);
- */
- findext(g);
- break;
- case DEFINING: /* Thou shalt not redefine */
- if (g->g_status&DEF)
- error("global symbol '%s' redefined",name);
- g->g_status |= DEF;
- break;
- case OCCURRING:
- if ( new )
- findext(g);
- g->g_status |= OCC;
- break;
- default:
- fatal("bad status in glolookup");
- }
- return(g);
-}
-
-locl_t *loclookup(an,status) {
- register locl_t *lbp,*l_lbp;
- register unsigned num;
- char hinum;
-
- if ( !pstate.s_locl ) fatal("label outside procedure");
- num = an;
- if ( num/LOCLABSIZE>255 ) fatal("local label number too large");
- hinum = num/LOCLABSIZE;
- l_lbp= lbp= &(*pstate.s_locl)[num%LOCLABSIZE];
- if ( lbp->l_defined==EMPTY ) {
- lbp= lbp_cast 0 ;
- } else {
- while ( lbp!= lbp_cast 0 && lbp->l_hinum != hinum ) {
- l_lbp = lbp ;
- lbp = lbp->l_chain;
- }
- }
- if ( lbp == lbp_cast 0 ) {
- if ( l_lbp->l_defined!=EMPTY ) {
- lbp = lbp_cast getarea(sizeof *lbp);
- l_lbp->l_chain= lbp ;
- } else lbp= l_lbp ;
- lbp->l_chain= lbp_cast 0 ;
- lbp->l_hinum=hinum;
- lbp->l_defined = (status==OCCURRING ? NO : YES);
- lbp->l_min= line_num;
- } else
- if (status == DEFINING) {
- if (lbp->l_defined == YES)
- error("multiple defined local symbol");
- else
- lbp->l_defined = YES;
- }
- if ( status==DEFINING ) lbp->l_min= line_num ;
- return(lbp);
-}
-
-proc_t *prolookup(name,status) char *name; {
- register proc_t *p;
- register pstat;
-
- /*
- * Look up a procedure name according to status
- *
- * PRO_OCC: Occurrence
- * Search both tables, local table first.
- * If not found, enter in global table
- * PRO_INT: INP
- * Enter symbol in local table.
- * PRO_DEF: Definition
- * Define local procedure.
- * PRO_EXT: EXP
- * Enter symbol in global table.
- *
- * The EXT bit in this table indicates the the name is used
- * as external in this module.
- */
-
- switch(status) {
- case PRO_OCC:
- p = searchproc(name,mprocs,oursize->n_mproc);
- if (p->p_name[0]) {
- p->p_status |= OCC;
- return(p);
- }
- p = searchproc(name,xprocs,oursize->n_xproc);
- if (p->p_name[0]) {
- p->p_status |= OCC;
- return(p);
- }
- pstat = OCC|EXT;
- unresolved++ ;
- break;
- case PRO_INT:
- p = searchproc(name,xprocs,oursize->n_xproc);
- if (p->p_name[0] && (p->p_status&EXT) )
- error("pro '%s' conflicting use",name);
-
- p = searchproc(name,mprocs,oursize->n_mproc);
- if (p->p_name[0])
- werror("INP must be first occurrence of '%s'",name);
- pstat = 0;
- break;
- case PRO_EXT:
- p = searchproc(name,mprocs,oursize->n_mproc);
- if (p->p_name[0])
- error("pro '%s' exists already localy",name);
- p = searchproc(name,xprocs,oursize->n_xproc);
- if (p->p_name[0]) {
- /*
- * The If statement is removed to be friendly
- * to Backend writers having to deal with assemblers
- * not following our conventions.
- if ( p->p_status&EXT )
- werror("EXP must be first occurrence of '%s'",
- name) ;
- */
- p->p_status |= EXT;
- return(p);
- }
- pstat = EXT;
- unresolved++;
- break;
- case PRO_DEF:
- p = searchproc(name,xprocs,oursize->n_xproc);
- if (p->p_name[0] && (p->p_status&EXT) ) {
- if (p->p_status&DEF)
- error("global pro '%s' redeclared",name);
- else
- unresolved-- ;
- p->p_status |= DEF;
- return(p);
- } else {
- p = searchproc(name,mprocs,oursize->n_mproc);
- if (p->p_name[0]) {
- if (p->p_status&DEF)
- error("local pro '%s' redeclared",
- name);
- p->p_status |= DEF;
- return(p);
- }
- }
- pstat = DEF;
- break;
- default:
- fatal("bad status in prolookup");
- }
- return(enterproc(name,pstat,p));
-}
-
-proc_t *searchproc(name,table,size)
- char *name;
- proc_t *table;
- int size;
-{
- register proc_t *p;
- register rem,j;
-
- /*
- * return a pointer into table to the place where the procedure
- * name is or should be if in the table.
- */
-
- rem = glohash(name,size);
- j = 0;
- p = &table[rem];
- while (p->p_name[0] != 0 && strcmp(name,p->p_name) != 0) {
- j++;
- if (j>size)
- fatal("procedure table overflow");
- rem = (rem + globstep) % size;
- p = &table[rem];
- }
- return(p);
-}
-
-proc_t *enterproc(name,status,place)
-char *name;
-char status;
-proc_t *place; {
- register proc_t *p;
-
- /*
- * Enter the procedure name into the table at place place.
- * Place had better be computed by searchproc().
- *
- * NOTE:
- * At this point the procedure gets assigned a number.
- * This number is used as a parameter of cal and in some
- * other ways. There exists a 1-1 correspondence between
- * procedures and numbers.
- * Two local procedures with the same name in different
- * modules have different numbers.
- */
-
- p=place;
- strcpy(p->p_name,name);
- p->p_status = status;
- if (procnum>=oursize->n_proc)
- fatal("too many procedures");
- p->p_num = procnum++;
- return(p);
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-#include "../../h/em_path.h"
-
-/*
- * this file contains several library routines.
- */
-
-zero(area,length) char *area; unsigned length ; {
- register char *p;
- register n;
- /*
- * Clear area of length bytes.
- */
- if ((n=length)==0)
- return;
- p = area;
- do *p++=0; while (--n);
-}
-
-/* VARARGS1 */
-static void pr_error(string1,a1,a2,a3,a4) char *string1 ; {
- /*
- * diagnostic output
- */
- fprintf(stderr,"%s: ",progname);
- if (curfile) {
- fprintf(stderr,"file %s",curfile);
- if (archmode)
- fprintf(stderr," (%.14s)",archhdr.ar_name);
- fprintf(stderr,": ");
- }
- if ( pstate.s_curpro ) {
- fprintf(stderr,"proc %s, ",pstate.s_curpro->p_name);
- }
- fprintf(stderr,"line %d: ",line_num);
- fprintf(stderr,string1,a1,a2,a3,a4);
- fprintf(stderr,"\n");
-}
-
-/* VARARGS1 */
-void error(string1,a1,a2,a3,a4) char *string1 ; {
- pr_error(string1,a1,a2,a3,a4) ;
- nerrors++ ;
-}
-
-/* VARARGS1 */
-void werror(string1,a1,a2,a3,a4) char *string1 ; {
- if ( wflag ) return ;
- pr_error(string1,a1,a2,a3,a4) ;
-}
-
-fatal(s) char *s; {
- /*
- * handle fatal errors
- */
- error("Fatal error: %s",s);
- dump(0);
- exit(-1);
-}
-
-#ifndef CPM
-FILE *frewind(f) FILE *f ; {
- /* Rewind a file open for writing and open it for reading */
- /* Assumption, file descriptor is r/w */
- register FILE *tmp ;
- rewind(f);
- tmp=fdopen(dup(fileno(f)),"r");
- fclose(f);
- return tmp ;
-}
-#endif
-
-int xgetc(af) register FILE *af; {
- register int nextc;
- /*
- * read next character; fatal if there isn't one
- */
- nextc=fgetc(af) ;
- if ( feof(af) )
- fatal("unexpected end of file");
- return nextc ;
-}
-
-xputc(c,af) register FILE *af; {
- /* output one character and scream if it gives an error */
- fputc(c,af) ;
- if ( ferror(af) ) fatal("write error") ;
-}
-
-
-putblk(stream,from,amount)
- register FILE *stream; register char *from ; register int amount ; {
-
- for ( ; amount-- ; from++ ) {
- fputc(*from,stream) ;
- if ( ferror(stream) ) fatal("write error") ;
- }
-}
-
-int getblk(stream,from,amount)
- register FILE *stream; register char *from ; register int amount ; {
-
- for ( ; amount-- ; from++ ) {
- *from = fgetc(stream) ;
- if ( feof(stream) ) return 1 ;
- }
- return 0 ;
-}
-
-xput16(w,f) FILE *f; {
- /*
- * two times xputc
- */
- xputc(w,f);
- xputc(w>>8,f);
-}
-
-xputarb(l,w,f) int l ; cons_t w ; FILE *f ; {
- while ( l-- ) {
- xputc( int_cast w,f) ;
- w >>=8 ;
- }
-}
-
-put8(n) {
- xputc(n,tfile);
- textoff++;
-}
-
-put16(n) {
- /*
- * note reversed order of bytes.
- * this is done for faster interpretation.
- */
- xputc(n>>8,tfile);
- xputc(n&0377,tfile);
- textoff += 2;
-}
-
-put32(n) cons_t n ; {
- put16( int_cast (n>>16)) ;
- put16( int_cast n) ;
-}
-
-put64(n) cons_t n ; {
- fatal("put64 called") ;
-}
-
-int xget8() {
- /*
- * Read one byte from ifile.
- */
- if (libeof && inpoff >= libeof)
- return EOF ;
- inpoff++;
- return fgetc(ifile) ;
-}
-
-unsigned get8() {
- register int nextc;
- /*
- * Read one byte from ifile.
- */
- nextc=xget8();
- if ( nextc==EOF ) {
- if (libeof)
- fatal("Tried to read past end of arentry\n");
- else
- fatal("end of file on input");
- }
- return nextc ;
-}
-
-cons_t xgetarb(l,f) int l; FILE *f ; {
- cons_t val ;
- register int shift ;
-
- shift=0 ; val=0 ;
- while ( l-- ) {
- val += ((cons_t)ctrunc(xgetc(f)))<<shift ;
- shift += 8 ;
- }
- return val ;
-}
-
-ext8(b) {
- /*
- * Handle one byte of data.
- */
- ++dataoff;
- xputc(b,dfile);
-}
-
-extword(w) cons_t w ; {
- /* Assemble the word constant w.
- * NOTE: The bytes are written low to high.
- */
- register i ;
- for ( i=wordsize ; i-- ; ) {
- ext8( int_cast w) ;
- w >>= 8 ;
- }
-}
-
-extarb(size,value) int size ; long value ; {
- /* Assemble the 'size' constant value.
- * The bytes are again written low to high.
- */
- register i ;
- for ( i=size ; i-- ; ) {
- ext8( int_cast value ) ;
- value >>=8 ;
- }
-}
-
-extadr(a) cons_t a ; {
- /* Assemble the word constant a.
- * NOTE: The bytes are written low to high.
- */
- register i ;
- for ( i=ptrsize ; i-- ; ) {
- ext8( int_cast a) ;
- a >>= 8 ;
- }
-}
-
-xputa(a,f) cons_t a ; FILE *f ; {
- /* Assemble the pointer constant a.
- * NOTE: The bytes are written low to high.
- */
- register i ;
- for ( i=ptrsize ; i-- ; ) {
- xputc( int_cast a,f) ;
- a >>= 8 ;
- }
-}
-
-cons_t xgeta(f) FILE *f ; {
- /* Read the pointer constant a.
- * NOTE: The bytes were written low to high.
- */
- register i, shift ;
- cons_t val ;
- val = 0 ; shift=0 ;
- for ( i=ptrsize ; i-- ; ) {
- val += ((cons_t)xgetc(f))<<shift ;
- shift += 8 ;
- }
- return val ;
-}
-
-#define MAXBYTE 255
-
-int icount(size) {
- int amount ;
- amount=(dataoff-lastoff)/size ;
- if ( amount>MAXBYTE) fatal("Descriptor overflow");
- return amount ;
-}
-
-setmode(mode) {
-
- if (datamode==mode) { /* in right mode already */
- switch ( datamode ) {
- case DATA_CONST:
- if ( (dataoff-lastoff)/wordsize < MAXBYTE ) return ;
- break ;
- case DATA_BYTES:
- if ( dataoff-lastoff < MAXBYTE ) return ;
- break ;
- case DATA_IPTR:
- case DATA_DPTR:
- if ( (dataoff-lastoff)/ptrsize < MAXBYTE ) return ;
- break ;
- case DATA_ICON:
- case DATA_FCON:
- case DATA_UCON:
- break ;
- default:
- return ;
- }
- setmode(DATA_NUL) ; /* flush current descriptor */
- setmode(mode) ;
- return;
- }
- switch(datamode) { /* terminate current mode */
- case DATA_NUL:
- break; /* nothing to terminate */
- case DATA_CONST:
- lastheader->r_val.rel_i=icount(wordsize) ;
- lastheader->r_typ = RELHEAD;
- datablocks++;
- break;
- case DATA_BYTES:
- lastheader->r_val.rel_i=icount(1) ;
- lastheader->r_typ = RELHEAD;
- datablocks++;
- break;
- case DATA_DPTR:
- case DATA_IPTR:
- lastheader->r_val.rel_i=icount(ptrsize) ;
- lastheader->r_typ = RELHEAD;
- datablocks++;
- break;
- default:
- datablocks++;
- break;
- }
- datamode=mode;
- switch(datamode) {
- case DATA_NUL:
- break;
- case DATA_CONST:
- ext8(HEADCONST);
- lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
- ext8(0);
- lastoff=dataoff;
- break;
- case DATA_BYTES:
- ext8(HEADBYTE);
- lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
- ext8(0);
- lastoff=dataoff;
- break;
- case DATA_IPTR:
- ext8(HEADIPTR);
- lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
- ext8(0);
- lastoff=dataoff;
- break;
- case DATA_DPTR:
- ext8(HEADDPTR);
- lastheader=data_reloc( chp_cast 0,dataoff,RELNULL);
- ext8(0);
- lastoff=dataoff;
- break;
- case DATA_ICON:
- ext8(HEADICON) ;
- ext8( int_cast consiz) ;
- break;
- case DATA_FCON:
- ext8(HEADFCON) ;
- ext8( int_cast consiz) ;
- break;
- case DATA_UCON:
- ext8(HEADUCON) ;
- ext8( int_cast consiz) ;
- break;
- case DATA_REP:
- ext8(HEADREP) ;
- break ;
- default:
- fatal("Unknown mode in setmode") ;
- }
-}
-
-#ifndef CPM
-int tmpfil() {
- register char *fname, *cpname ;
- char *sfname;
- register fildes,pid;
- static char name[80] = TMP_DIR ;
- int count;
- /*
- * This procedure returns a file-descriptor of a temporary
- * file valid for reading and writing.
- * After closing the tmpfil-descriptor the file is lost
- * Calling this routine frees the program from generating uniqe names.
- */
- sfname = fname = "tmp.00000";
- count = 10;
- pid = getpid();
- fname += 4;
- while (pid!=0) {
- *fname++ = (pid&07) + '0';
- pid >>= 3;
- }
- *fname = 0;
- for ( fname=name ; *fname ; fname++ ) ;
- cpname=sfname ;
- while ( *fname++ = *cpname++ ) ;
- do {
- fname = name;
- if ((fildes = creat(fname, 0600)) < 0)
- if ((fildes = creat(fname=sfname, 0600)) < 0)
- return(-1);
- if (close(fildes) < 0)
- ;
- } while((fildes = open(fname, 2)) < 0 && count--);
- if (unlink(fname) < 0)
- ;
- return(fildes);
-}
-#endif
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-#include "../../h/em_mes.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_ptyp.h"
-
-/*
- * read compact code and fill in tables
- */
-
-static int tabval;
-static cons_t argval;
-
-static int oksizes; /* MES EMX,.,. seen */
-
-static enum m_type { CON, ROM, HOLBSS } memtype ;
-static int valtype; /* Transfer of type information between
- valsize ans putval
- */
-
-int table3(i) {
-
- switch(i) {
- case sp_ilb1:
- tabval = get8();
- break;
- case sp_dlb1:
- make_string(get8());
- i= sp_dnam;
- break;
- case sp_dlb2:
- tabval = get16();
- if ( tabval<0 ) {
- error("illegal data label .%d",tabval);
- tabval=0 ;
- }
- make_string(tabval);
- i= sp_dnam;
- break;
- case sp_cst2:
- argval = get16();
- break;
- case sp_ilb2:
- tabval = get16();
- if ( tabval<0 ) {
- error("illegal instruction label %d",tabval);
- tabval=0 ;
- }
- i = sp_ilb1;
- break;
- case sp_cst4:
- i = sp_cst2;
- argval = get32();
- break;
- case sp_dnam:
- case sp_pnam:
- inident();
- break ;
- case sp_scon:
- getstring() ;
- break;
- case sp_doff:
- getarg(sym_ptyp);
- getarg(cst_ptyp);
- break;
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- getarg(cst_ptyp);
- consiz = argval;
- if ( consiz<wordsize ?
- wordsize%consiz!=0 : consiz%wordsize!=0 ) {
- fatal("illegal object size") ;
- }
- getstring();
- break;
- }
- return(i);
-}
-
-int get16() {
- register int l_byte, h_byte;
-
- l_byte = get8();
- h_byte = get8();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-cons_t get32() {
- register cons_t l;
- register int h_byte;
-
- l = get8(); l |= (unsigned)get8()*256 ; l |= get8()*256L*256L ;
- h_byte = get8() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-
-int table1() {
- register i;
-
- i = xget8();
- if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
- tabval = i-sp_fmnem;
- return(sp_fmnem);
- }
- if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
- tabval = i;
- return(sp_fpseu);
- }
- if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
- tabval = i - sp_filb0;
- return(sp_ilb1);
- }
- return(table3(i));
-}
-
-int table2() {
- register i;
-
- i = get8();
- if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
- argval = i - sp_zcst0;
- return(sp_cst2);
- }
- return(table3(i));
-}
-
-int getarg(typset) {
- register t,argtyp;
-
- argtyp = t = table2();
- t -= sp_fspec;
- t = 1 << t;
- if ((typset & t) == 0)
- error("bad argument type %d",argtyp);
- return(argtyp);
-}
-
-cons_t getint() {
- getarg(cst_ptyp);
- return(argval);
-}
-
-glob_t *getlab(status) {
- getarg(sym_ptyp);
- return(glo2lookup(string,status));
-}
-
-char *inproname() {
- getarg(ptyp(sp_pnam));
- return(string);
-}
-
-int needed() {
- register glob_t *g;
- register proc_t *p;
-
- for(;;){
- switch ( table2() ) {
- case sp_dnam :
- if (g = xglolookup(string,SEARCHING)) {
- if ((g->g_status&DEF) != 0)
- continue ;
- } else continue ;
- break ;
- case sp_pnam :
- p = searchproc(string,xprocs,oursize->n_xproc);
- if (p->p_name[0]) {
- if ((p->p_status & DEF) != 0)
- continue ;
- } else continue ;
- break ;
- default :
- error("Unexpected byte after ms_ext") ;
- case sp_cend :
- return FALSE ;
- }
- while ( table2()!=sp_cend ) ;
- return TRUE ;
- }
-}
-
-cons_t valsize() {
- switch(valtype=table2()) { /* valtype is used by putval */
- case sp_cst2:
- return wordsize ;
- case sp_ilb1:
- case sp_dnam:
- case sp_doff:
- case sp_pnam:
- return ptrsize ;
- case sp_scon:
- return strlngth ;
- case sp_fcon:
- case sp_icon:
- case sp_ucon:
- return consiz ;
- case sp_cend:
- return 0 ;
- default:
- fatal("value expected") ;
- /* NOTREACHED */
- }
-}
-
-newline(type) {
- register line_t *n_lnp ;
-
- if ( type>VALLOW ) type=VALLOW ;
- n_lnp = lnp_cast getarea((unsigned)linesize[type]) ;
- n_lnp->l_next = pstate.s_fline ;
- pstate.s_fline = n_lnp ;
- n_lnp->type1 = type ;
- n_lnp->opoff = NO_OFF ;
-}
-
-read_compact() {
-
- /*
- * read module in compact EM1 code
- */
- init_module();
- pass = 1;
- eof_seen = 0;
- do {
- compact_line() ;
- line_num++;
- } while (!eof_seen) ;
- endproc() ; /* Throw away unwanted garbage */
- if ( mod_sizes ) end_module();
- /* mod_sizes is only false for rejected library modules */
-}
-
-int compact_line() {
- register instr_no ;
-
- /*
- * read one "line" of compact code.
- */
- curglosym=0;
- switch (table1()) {
- default:
- fatal("unknown byte at start of \"line\""); /* NOTREACHED */
- case EOF:
- eof_seen++ ;
- while ( pstate.s_prevstat != pst_cast 0 ) {
- error("missing end") ; do_proc() ;
- }
- return ;
- case sp_fmnem:
- if ( pstate.s_curpro == prp_cast 0) {
- error("instruction outside procedure");
- }
- instr_no = tabval;
- if ( (em_flag[instr_no]&EM_PAR)==PAR_NO ) {
- newline(MISSING) ;
- pstate.s_fline->instr_num= instr_no ;
- return ;
- }
- /*
- * This instruction should have an opcode, so read it after
- * this switch.
- */
- break;
- case sp_dnam:
- chkstart() ;
- align(wordsize) ;
- curglosym = glo2lookup(string,DEFINING);
- curglosym->g_val.g_addr = databytes;
- lastglosym = curglosym;
- setline() ; line_num++ ;
- if (table1() != sp_fpseu)
- fatal("no pseudo after global label");
- case sp_fpseu:
- inpseudo(tabval);
- setline() ;
- return ;
- case sp_ilb1:
- newline(LOCSYM) ;
- pstate.s_fline->ad.ad_lp = loclookup(tabval,DEFINING);
- pstate.s_fline->instr_num = sp_ilb1;
- return ;
- }
-
- /*
- * Now process argument
- */
-
- switch(table2()) {
- default:
- fatal("unknown byte at start of argument"); /*NOTREACHED*/
- case sp_cst2:
- if ( (em_flag[instr_no]&EM_PAR)==PAR_B ) {
- /* value indicates a label */
- newline(LOCSYM) ;
- pstate.s_fline->ad.ad_lp=
- loclookup((int)argval,OCCURRING) ;
- } else {
- if ( argval>=VAL1(VALLOW) && argval<=VAL1(VALHIGH)) {
- newline(VALLOW) ;
- pstate.s_fline->type1 = argval+VALMID ;
- } else {
- newline(CONST) ;
- pstate.s_fline->ad.ad_i = argval;
- pstate.s_fline->type1 = CONST;
- }
- }
- break;
- case sp_ilb1:
- newline(LOCSYM) ;
- pstate.s_fline->ad.ad_lp = loclookup(tabval,OCCURRING);
- break;
- case sp_dnam:
- newline(GLOSYM) ;
- pstate.s_fline->ad.ad_gp = glo2lookup(string,OCCURRING);
- break;
- case sp_pnam:
- newline(PROCNAME) ;
- pstate.s_fline->ad.ad_pp=prolookup(string,PRO_OCC);
- break;
- case sp_cend:
- if ( (em_flag[instr_no]&EM_PAR)!=PAR_W ) {
- fatal("missing operand") ;
- }
- newline(MISSING) ;
- break ;
- case sp_doff:
- newline(GLOOFF) ;
- pstate.s_fline->ad.ad_df.df_i = argval ;
- pstate.s_fline->ad.ad_df.df_gp= glo2lookup(string,OCCURRING) ;
- break ;
- }
- pstate.s_fline->instr_num= instr_no ;
- return ;
-}
-
-inpseudo(instr_no) {
- cons_t cst;
- register proc_t *prptr;
- cons_t objsize;
- cons_t par1,par2;
- register char *pars;
-
- /*
- * get operands of pseudo (if needed) and process it.
- */
-
- switch ( ctrunc(instr_no) ) {
- case ps_bss:
- chkstart() ;
- typealign(HOLBSS) ;
- cst = getint(); /* number of bytes */
- extbss(cst);
- break;
- case ps_hol:
- chkstart() ;
- typealign(HOLBSS) ;
- holsize=getint();
- holbase=databytes;
- extbss(holsize);
- break;
- case ps_rom:
- case ps_con:
- chkstart() ;
- typealign( ctrunc(instr_no)==ps_rom ? ROM : CON ) ;
- while( (objsize=valsize())!=0 ) {
- sizealign(objsize) ;
- putval() ;
- databytes+=objsize ;
- }
- break;
- case ps_end:
- prptr= pstate.s_curpro ;
- if ( prptr == prp_cast 0 ) fatal("unexpected END") ;
- proctab[prptr->p_num].pr_off = textbytes;
- if (procflag) {
- printf("%6lu\t%6lo\t%5d\t%-12s\t%s",
- textbytes,textbytes,
- prptr->p_num,prptr->p_name,curfile);
- if (archmode)
- printf("(%.14s)",archhdr.ar_name);
- printf("\n");
- }
- par2 = proctab[prptr->p_num].pr_loc ;
- if ( getarg(cst_ptyp|ptyp(sp_cend))==sp_cend ) {
- if ( par2 == -1 ) {
- fatal("size of local area unspecified") ;
- }
- } else {
- if ( par2 != -1 && argval!=par2 ) {
- fatal("inconsistent local area size") ;
- }
- proctab[prptr->p_num].pr_loc = argval ;
- }
- setline();
- do_proc();
- break;
- case ps_mes:
- switch( int_cast getint() ) {
- case ms_err:
- error("module with error") ; ertrap();
- /* NOTREACHED */
- case ms_emx:
- if ( oksizes ) {
- if ( wordsize!=getint() ) {
- fatal("Inconsistent word size");
- }
- if ( ptrsize!=getint() ) {
- fatal("Inconsistent pointer size");
- }
- } else {
- oksizes++ ;
- wordsize=getint();ptrsize=getint();
- if ( wordsize!=2 && wordsize!=4 ) {
- fatal("Illegal word size");
- }
- if ( ptrsize!=2 && ptrsize!=4 ) {
- fatal("Illegal pointer size");
- }
- setsizes() ;
- }
- ++mod_sizes ;
- break;
- case ms_src:
- break;
- case ms_flt:
- intflags |= 020; break; /*floats used*/
- case ms_ext:
- if ( !needed() ) {
- eof_seen++ ;
- }
- if ( line_num!=1 ) {
- werror("mes ms_ext must be first pseudo") ;
- }
- return ;
- }
- while (table2() != sp_cend)
- ;
- break;
- case ps_exc:
- par1 = getint();
- par2 = getint();
- if (par1 == 0 || par2 == 0)
- break;
- exchange((int)par2,(int)par1) ;
- break;
- case ps_exa:
- getlab(EXTERNING);
- break;
- case ps_ina:
- getlab(INTERNING);
- break;
- case ps_pro:
- chkstart() ;
- initproc();
- pars = inproname();
- if ( getarg(cst_ptyp|ptyp(sp_cend))==sp_cend ) {
- par2 = -1 ;
- } else {
- par2 = argval ;
- }
- prptr = prolookup(pars,PRO_DEF);
- proctab[prptr->p_num].pr_loc = par2;
- pstate.s_curpro=prptr;
- break;
- case ps_inp:
- prptr = prolookup(inproname(),PRO_INT);
- break;
- case ps_exp:
- prptr = prolookup(inproname(),PRO_EXT);
- break;
- default:
- fatal("unknown pseudo");
- }
- if ( !mod_sizes ) fatal("Missing size specification");
- if ( databytes>maxadr ) error("Maximum data area size exceeded") ;
-}
-
-setline() {
-
- /* Get line numbers correct */
-
- if ( pstate.s_fline &&
- ctrunc(pstate.s_fline->instr_num) == sp_fpseu ) {
- /* Already one present */
- pstate.s_fline->ad.ad_ln.ln_extra++ ;
- } else {
- newline(LINES) ;
- pstate.s_fline->instr_num= sp_fpseu ;
- pstate.s_fline->ad.ad_ln.ln_extra= 0 ;
- pstate.s_fline->ad.ad_ln.ln_first= line_num ;
- }
-
-}
-
-cons_t maxval(bits) int bits ; {
- /* find the maximum positive value,
- * fitting in 'bits' bits AND
- * fitting in a 'cons_t' .
- */
-
- cons_t val ;
- val=1 ;
- while ( bits-- ) {
- val<<= 1 ;
- if ( val<0 ) return ~val ;
- }
- return val-1 ;
-}
-
-setsizes() {
- maxadr = maxval(8*ptrsize) ;
- maxint = maxval(8*wordsize-1) ;
- maxunsig = maxval(8*wordsize) ;
- maxdint = maxval(2*8*wordsize-1) ;
- maxdunsig = maxval(2*8*wordsize) ;
-}
-
-char *getdig(str,number) char *str; register unsigned number; {
- register int remain;
-
- remain= number%10;
- number /= 10;
- if ( number ) str= getdig(str,number) ;
- *str++ = '0'+remain ;
- return str ;
-}
-
-make_string(n) unsigned n ; {
- string[0] = '.';
- *getdig(&string[1],n)= 0;
-}
-
-
-getstring() {
- register char *p;
- register n;
-
- getarg(cst_ptyp);
- if ( argval < 0 || argval >= MAXSTRING-1 )
- fatal("string/identifier too long");
- strlngth = n = argval;
- p = string;
- while (--n >= 0)
- *p++ = get8();
- *p = 0 ;
-}
-
-inident() {
- getstring();
- string[IDLENGTH] = '\0';
-}
-
-exchange(p1,p2) {
- int size, line ;
- int l_of_p1, l_of_p2, l_of_before ;
- register line_t *t_lnp,*a_lnp, *b_lnp ;
-
- /* Since the lines are linked backwards it is easy
- * to count the number of lines backwards.
- * Each instr counts for 1, each pseudo for ln_extra + 1.
- * The line numbers in error messages etc. are INCORRECT
- * If exc's are used.
- */
-
- line= line_num ; size=0 ;
- newline(LINES) ; a_lnp=pstate.s_fline ;
- a_lnp->instr_num= sp_fpseu ;
- a_lnp->ad.ad_ln.ln_first= line ;
- a_lnp->ad.ad_ln.ln_extra= -1 ;
- for ( ; a_lnp ; a_lnp= a_lnp->l_next ) {
- line-- ;
- switch ( ctrunc(a_lnp->instr_num) ) {
- case sp_fpseu :
- line= a_lnp->ad.ad_ln.ln_first ;
- size += a_lnp->ad.ad_ln.ln_extra ;
- break ;
- case sp_ilb1 :
- a_lnp->ad.ad_lp->l_min -= p2 ;
- break ;
- }
- size++ ;
- if ( size>=p1 ) break ;
- }
- if ( ( size-= p1 )>0 ) {
- if ( ctrunc(a_lnp->instr_num) !=sp_fpseu ) {
- fatal("EXC inconsistency") ;
- }
- doinsert(a_lnp,line,a_lnp->ad.ad_ln.ln_extra-size) ;
- a_lnp->ad.ad_ln.ln_first += size ;
- a_lnp->ad.ad_ln.ln_extra = size-1 ;
- size=0 ;
- b_lnp=a_lnp->l_next ;
- } else {
- doinsert(a_lnp,line,-1) ;
- b_lnp= a_lnp ;
- }
- while ( b_lnp ) {
- b_lnp= b_lnp->l_next ;
- line-- ;
- switch ( ctrunc(b_lnp->instr_num) ) {
- case sp_fpseu :
- size += b_lnp->ad.ad_ln.ln_extra ;
- line = b_lnp->ad.ad_ln.ln_first ;
- break ;
- case sp_ilb1 :
- b_lnp->ad.ad_lp->l_min += p1 ;
- break ;
- }
- size++ ;
- if ( size>=p2 ) break ;
- }
- if ( ( size-= p2 )>0 ) {
- if ( ctrunc(b_lnp->instr_num) !=sp_fpseu ) {
- fatal("EXC inconsistency") ;
- }
- doinsert(b_lnp,line,b_lnp->ad.ad_ln.ln_extra-size) ;
- b_lnp->ad.ad_ln.ln_first += size ;
- b_lnp->ad.ad_ln.ln_extra = size-1 ;
- } else {
- doinsert(b_lnp,line,-1) ;
- }
- if ( !b_lnp ) { /* if a_lnp==0, so is b_lnp */
- fatal("Cannot perform exchange") ;
- }
- t_lnp = b_lnp->l_next ;
- b_lnp->l_next = pstate.s_fline ;
- pstate.s_fline= a_lnp->l_next ;
- a_lnp->l_next=t_lnp ;
-}
-
-doinsert(lnp,first,extra) line_t *lnp ; {
- /* Beware : s_fline will be clobbered and restored */
- register line_t *t_lnp ;
-
- t_lnp= pstate.s_fline;
- pstate.s_fline= lnp->l_next ;
- newline(LINES) ;
- pstate.s_fline->instr_num= sp_fpseu ;
- pstate.s_fline->ad.ad_ln.ln_first= first ;
- pstate.s_fline->ad.ad_ln.ln_extra= extra ;
- lnp->l_next= pstate.s_fline ;
- pstate.s_fline= t_lnp; /* restore */
-}
-
-putval() {
- switch(valtype){
- case sp_cst2:
- extconst(argval);
- return ;
- case sp_ilb1:
- extloc(loclookup(tabval,OCCURRING));
- return ;
- case sp_dnam:
- extglob(glo2lookup(string,OCCURRING),(cons_t)0);
- return ;
- case sp_doff:
- extglob(glo2lookup(string,OCCURRING),argval);
- return ;
- case sp_pnam:
- extpro(prolookup(string,PRO_OCC));
- return ;
- case sp_scon:
- extstring() ;
- return ;
- case sp_fcon:
- extxcon(DATA_FCON) ;
- return ;
- case sp_icon:
- extvcon(DATA_ICON) ;
- return ;
- case sp_ucon:
- extvcon(DATA_UCON) ;
- return ;
- default:
- fatal("putval notreached") ;
- /* NOTREACHED */
- }
-}
-
-chkstart() {
- static int absout = 0 ;
-
- if ( absout ) return ;
- if ( !oksizes ) fatal("missing size specification") ;
- setmode(DATA_CONST) ;
- extconst((cons_t)0) ;
- setmode(DATA_REP) ;
- extadr( (cons_t) (ABSSIZE/wordsize-1) ) ;
- absout++ ;
- databytes = ABSSIZE ;
- memtype= HOLBSS ;
-}
-
-typealign(new) enum m_type new ; {
- if ( memtype==new ) return ;
- align(wordsize);
- memtype=new ;
-}
-
-sizealign(size) cons_t size ; {
- align( size>wordsize ? wordsize : (int)size ) ;
-}
-
-align(size) int size ; {
- register unsigned gapsize ;
-
- for ( gapsize= databytes%size ; gapsize ; gapsize-- ) {
- setmode(DATA_BYTES) ;
- ext8(0) ;
- databytes++ ;
- }
-}
-
-extconst(n) cons_t n ; {
- setmode(DATA_CONST);
- extword(n);
-}
-
-extbss(n) cons_t n ; {
- cons_t objsize,amount ;
-
- if ( n<=0 ) {
- if ( n<0 ) werror("negative bss/hol size") ;
- if ( table2()==sp_cend || table2()==sp_cend) {
- werror("Unexpected end-of-line") ;
- }
- return ;
- }
- setmode(DATA_NUL) ; /* flush descriptor */
- objsize= valsize();
- if ( objsize==0 ) {
- werror("Unexpected end-of-line");
- return;
- }
- if ( n%objsize != 0 ) error("BSS/HOL incompatible sizes");
- putval();
- amount= n/objsize ;
- if ( amount>1 ) {
- setmode(DATA_REP);
- extadr(amount-1) ;
- }
- databytes +=n ;
- getarg(sp_cst2);
- if ( argval<0 || argval>1 ) error("illegal last argument") ;
-}
-
-extloc(lbp) register locl_t *lbp; {
-
- /*
- * assemble a pointer constant from a local label.
- * For example con *1
- */
- setmode(DATA_IPTR);
- data_reloc( chp_cast lbp,dataoff,RELLOC);
- extadr((cons_t)0);
-}
-
-extglob(agbp,off) glob_t *agbp; cons_t off; {
- register glob_t *gbp;
-
- /*
- * generate a word of data that is defined by a global symbol.
- * Various relocation has to be prepared here in some cases
- */
- gbp=agbp;
- setmode(DATA_DPTR);
- if ( gbp->g_status&DEF ) {
- extadr(gbp->g_val.g_addr+off);
- } else {
- data_reloc( chp_cast gbp,dataoff,RELGLO);
- extadr(off);
- }
-}
-
-extpro(aprp) proc_t *aprp; {
- /*
- * generate a addres that is defined by a procedure descriptor.
- */
- consiz= ptrsize ; setmode(DATA_UCON);
- extarb((int)ptrsize,(long)(aprp->p_num));
-}
-
-extstring() {
- register char *s;
- register n ;
-
- /*
- * generate data for a string.
- */
- for(n=strlngth,s=string ; n--; ) {
- setmode(DATA_BYTES) ;
- ext8(*s++);
- }
- return ;
-}
-
-extxcon(header) {
- register char *s ;
- register n;
-
- /*
- * generate data for a floating constant initialized by a string.
- */
-
- setmode(header);
- s = string ;
- for (n=strlngth ; n-- ;) {
- if ( *s==0 ) error("Zero byte in initializer") ;
- ext8(*s++);
- }
- ext8(0);
- return ;
-}
-
-extvcon(header) {
- extern long atol() ;
- /*
- * generate data for a constant initialized by a string.
- */
-
- setmode(header);
- if ( consiz>4 ) {
- error("Size of initializer exceeds loader capability") ;
- }
- extarb((int)consiz,atol(string)) ;
- return ;
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-/* Core management for the EM assembler.
- two routines:
- getarea(size)
- returns a pointer to a free area of 'size' bytes.
- freearea(ptr,size)
- free's the area of 'size' bytes pointed to by ptr
-
- Free blocks are linked together and kept sorted.
- Adjacent free blocks are collapsed.
- Free blocks with a size smaller then the administration cannot
- exist.
- The algorithm is first fit.
-*/
-
-#include "ass00.h"
-
-#ifdef MEMUSE
-static unsigned m_used = 0 ;
-static unsigned m_free = 0 ;
-#endif
-
-struct freeblock {
- struct freeblock *f_next ;
- unsigned f_size ;
-} ;
-
-static struct freeblock freexx[2] = {
- { freexx, 0 },
- { freexx+1, 0 }
-} ;
-
-#define freehead freexx[1]
-
-#define CHUNK 2048 /* Smallest chunk to be gotten from UNIX */
-
-area_t getarea(size) unsigned size ; {
- register struct freeblock *c_ptr,*l_ptr ;
- register char *ptr ;
- unsigned rqsize ;
- char *malloc() ;
-
-#ifdef MEMUSE
- m_used += size ;
- m_free -= size ;
-#endif
- for(;;) {
- for ( l_ptr= &freehead, c_ptr= freehead.f_next ;
- c_ptr!= &freehead ; c_ptr = c_ptr->f_next ) {
- if ( size==c_ptr->f_size ) {
- l_ptr->f_next= c_ptr->f_next ;
- return (area_t) c_ptr ;
- }
- if ( size+sizeof freehead <= c_ptr->f_size ) {
- c_ptr->f_size -= size ;
- return (area_t) ((char *) c_ptr + c_ptr->f_size) ;
- }
- l_ptr = c_ptr ;
- }
- rqsize = size<CHUNK ? CHUNK : size ;
- for(;;){
- ptr = malloc( rqsize ) ;
- if ( ptr ) break ; /* request succesfull */
- rqsize /= 2 ;
- rqsize -= rqsize%sizeof (short) ;
- if ( rqsize < sizeof freehead ) {
- fatal("Out of memory") ;
- }
- }
- freearea((area_t)ptr,rqsize) ;
-#ifdef MEMUSE
- m_used += rqsize ;
-#endif
- }
- /* NOTREACHED */
-}
-
-freearea(ptr,size) register area_t ptr ; unsigned size ; {
- register struct freeblock *c_ptr, *l_ptr ;
-
-#ifdef MEMUSE
- m_free += size ;
- m_used -= size ;
-#endif
- for ( l_ptr= &freehead, c_ptr=freehead.f_next ;
- c_ptr!= &freehead ; c_ptr= c_ptr->f_next ) {
- if ( (area_t)c_ptr>ptr ) break ;
- l_ptr= c_ptr ;
- }
- /* now insert between l_ptr and c_ptr */
- /* Beware they may both point to freehead */
-
-#ifdef MEMUSE
- if ( ((char *)l_ptr)+l_ptr->f_size> (char *)ptr && l_ptr<=ptr )
- fatal("Double freed") ;
- if ( ((char *)ptr)+size > (char *)c_ptr && ptr<=c_ptr )
- fatal("Frreed double") ;
-#endif
- /* Is the block before this one adjacent ? */
- if ( ((char *)l_ptr) + l_ptr->f_size == (char *) ptr ) {
- l_ptr->f_size += size ; /* yes */
- } else {
- /* No, create an entry */
- ((struct freeblock *)ptr)->f_next = c_ptr ;
- ((struct freeblock *)ptr)->f_size = size ;
- l_ptr->f_next = (struct freeblock *)ptr ;
- l_ptr = (struct freeblock *)ptr ;
- }
- /* Are the two entries adjacent ? */
- if ( (char *)l_ptr + l_ptr->f_size == (char *) c_ptr ) {
- /* the two entries are adjacent */
- l_ptr->f_next = c_ptr->f_next ;
- l_ptr->f_size += c_ptr->f_size ;
- }
-}
-
-#ifdef MEMUSE
-memuse() {
- printf("Free %7u, Used %7u, Total %7u\n",m_free,m_used,m_free+m_used);
-}
-#endif
+++ /dev/null
-#include "ass00.h"
-#include "assex.h"
-/*
- * global data
- */
-
-int wordsize ;
-int ptrsize ;
-cons_t maxadr ;
-cons_t maxint;
-cons_t maxdint;
-cons_t maxunsig;
-cons_t maxdunsig;
-
-/*
- The structure containing used for procedure environment stacking
-*/
-stat_t pstate ;
-
-/*
- * pointers to not yet allocated storage
- */
-glob_t *mglobs; /* pointer to module symbols */
-glob_t *xglobs; /* pointer to extern symbols */
-proc_t *mprocs; /* pointer to local procs */
-proc_t *xprocs; /* pointer to external procs */
-ptab_t *proctab; /* pointer to proctab[] */
-
-/*
- * some array and structures of known size
- */
-FILE *ifile; /* input file buffer */
-FILE *tfile; /* code file buffer */
-FILE *dfile; /* data file buffer */
-FILE *rtfile; /* code file buffer */
-FILE *rdfile; /* data file buffer */
-char string[MAXSTRING];
-
-/*
- * some other pointers
- */
-glob_t *lastglosym; /* last global symbol */
-glob_t *curglosym; /* current global symbol */
-relc_t *f_data = (relc_t *)0 ; /* first data reloc pointer */
-relc_t *l_data = (relc_t *)0 ; /* last data reloc pointer */
-relc_t *f_text = (relc_t *)0 ; /* first text reloc pointer */
-relc_t *l_text = (relc_t *)0 ; /* last text reloc pointer */
-
-/*
- * some indices
- */
-int strlngth; /* index in string[] */
-FOFFSET inpoff; /* offset in current input file */
-FOFFSET libeof; /* ceiling for above number */
-
-/*
- * some other counters
- */
-int procnum; /* generic for unique proc-descr. */
-cons_t prog_size; /* length of current proc */
-int max_bytes;
-int pass;
-int line_num; /* line number for error messages */
-int nerrors; /* number of nonfatal errors */
-cons_t consiz; /* size of U,I or F value */
-cons_t textbytes; /* size of code file */
-cons_t databytes; /* highwater mark in data */
-FOFFSET dataoff; /* size of data file */
-FOFFSET textoff; /* size of text file */
-FOFFSET lastoff; /* previous size before last block */
-int datamode; /* what kind of data */
-int datablocks; /* number of datablocks written out */
-relc_t *lastheader; /* pointer into datareloc */
-cons_t holbase;
-cons_t holsize;
-int unresolved; /* # of unresolved references */
-int sourcelines; /* number of lines in source program*/
-int intflags = 1; /* flags for interpreter */
-/*
- * some flags
- */
-int archmode; /* reading library ? */
-int procflag; /* print "namelist" of procedures */
-#ifdef DUMP
-int c_flag; /* print unused opcodes */
-char opcnt1[256]; /* count primary opcodes */
-char opcnt2[256]; /* count secondary opcodes */
-char opcnt3[256]; /* count long opcodes */
-#endif
-int d_flag = 0; /* don't dump */
-int r_flag = 0; /* don't dump relocation tables */
-#ifdef JOHAN
-int jflag;
-#endif
-int wflag = 0; /* don't issue warning messages */
-int eof_seen;
-int mod_sizes; /* Size info in current module ok? */
-
-#define BASE (sizeof (struct lines) - sizeof (addr_u))
-
-char linesize[VALLOW+1] = {
- BASE, /* MISSING */
- BASE + sizeof (cons_t), /* CONST */
- BASE + sizeof prp_cast, /* PROCNAME */
- BASE + sizeof gbp_cast, /* GLOSYM */
- BASE + sizeof lbp_cast, /* LOCSYM */
- BASE + sizeof (struct sad_df), /* GLOOFF */
- BASE + sizeof (struct sad_ln), /* LINES */
- BASE /* VALLOW */
-} ;
-
-/*
- * miscellaneous
- */
-char *progname; /* argv[0] */
-char *curfile = 0; /* name of current file */
-char *eout = "e.out";
-arch_t archhdr;
-size_t sizes[NDEFAULT] = {
-/* mlab, glab,mproc,xproc, proc */
- { 151, 29, 31, 73, 130 },
- { 307, 127, 151, 401, 460 },
- { 601, 251, 151, 401, 600 }
-};
-size_t *oursize = &sizes[1] ; /* point to selected sizes */
+++ /dev/null
-/*
- * global data
- */
-
-extern int wordsize;
-extern int ptrsize;
-extern cons_t maxadr;
-extern cons_t maxint;
-extern cons_t maxdint;
-extern cons_t maxunsig;
-extern cons_t maxdunsig;
-
-/*
- * tables loaded from em_libraries
- */
-extern char em_flag[];
-
-/*
- The structure containing used for procedure environment stacking
- */
-extern stat_t pstate ;
-
-/*
- * pointers to not yet allocated storage
- */
-extern glob_t *mglobs;
-extern glob_t *xglobs;
-extern proc_t *mprocs;
-extern proc_t *xprocs;
-extern ptab_t *proctab;
-
-extern FILE *ifile;
-extern FILE *tfile;
-extern FILE *dfile;
-extern FILE *rtfile;
-extern FILE *rdfile;
-extern char string[];
-
-/*
- * some other pointers
- */
-extern glob_t *lastglosym;
-extern glob_t *curglosym;
-extern size_t *oursize;
-extern relc_t *f_data;
-extern relc_t *l_data;
-extern relc_t *f_text;
-extern relc_t *l_text;
-
-/*
- * some indices
- */
-extern int strlngth;
-extern FOFFSET inpoff;
-extern FOFFSET libeof;
-
-/*
- * some other counters
- */
-extern int procnum;
-extern cons_t prog_size;
-extern int max_bytes;
-extern int pass;
-extern int line_num;
-extern int nerrors;
-extern cons_t textbytes;
-extern cons_t databytes;
-extern FOFFSET dataoff;
-extern FOFFSET textoff;
-extern FOFFSET lastoff;
-extern int datamode;
-extern int datablocks;
-extern relc_t *lastheader;
-extern cons_t holbase;
-extern cons_t holsize;
-extern int unresolved;
-extern int sourcelines;
-extern int intflags;
-/*
- * some flags
- */
-extern int archmode;
-extern int procflag;
-#ifdef DUMP
-extern int c_flag;
-extern char opcnt1[];
-extern char opcnt2[];
-extern char opcnt3[];
-#endif
-extern int d_flag;
-extern int r_flag;
-#ifdef JOHAN
-extern int jflag;
-#endif
-extern int wflag;
-extern int eof_seen;
-extern int mod_sizes;
-/*
- * miscellaneous
- */
-extern cons_t consiz;
-extern char *progname;
-extern char *curfile;
-extern char *eout;
-extern arch_t archhdr;
-extern size_t sizes[];
-
-extern char linesize[];
-
-/*
- * from asstb.c
- */
-
-extern char *opindex[] ;
-extern char opchoice[] ;
-extern int maxinsl ;
-
-/*
- * types of value returning routines
- */
-#ifndef CPM
-extern int tmpfil();
-extern FILE *frewind();
-#endif
-extern int xgetc();
-extern unsigned get8();
-extern int get16();
-extern cons_t get32();
-extern cons_t xgeta();
-extern cons_t parval();
-extern cons_t valsize();
-extern cons_t xgetarb();
-extern char *findnop();
-extern char *findfit();
-extern glob_t *glolookup();
-extern glob_t *glo2lookup();
-extern glob_t *xglolookup();
-extern locl_t *loclookup();
-extern proc_t *prolookup();
-extern proc_t *enterproc();
-extern proc_t *searchproc();
-extern relc_t *text_reloc();
-extern relc_t *data_reloc();
-extern area_t getarea();
-
-/*
- * all used library routines
- */
-extern char *malloc();
-extern int open();
-extern int creat();
-extern int getpid();
-extern int unlink();
-extern int close();
-extern int strcmp();
-extern char *strcpy();
-
-#define void int
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ass00.h"
-#include "assex.h"
-
-#define COPYFINAL 1
-#define COPYTEMP 0
-
-/*
- * collection of routines to deal with relocation business
- */
-
-void dataprocess();
-void textprocess();
-relc_t *
-text_reloc(glosym,off,typ) glob_t *glosym; FOFFSET off ; int typ ; {
-
- /*
- * prepare the relocation that has to be done at text-offset off
- * according to global symbol glosym.
- * NOTE: The pointer glosym will point into mglobs[], while at
- * the time copyout() is called all the symbols here
- * will have disappeared.
- * The procedure upd_reloc() will change this pointer
- * into the one in xglobs[] later.
- */
-
- register relc_t *nxtextreloc ;
-
- nxtextreloc= rlp_cast getarea(sizeof *nxtextreloc) ;
- if ( !f_text ) {
- f_text= nxtextreloc ;
- } else {
- l_text->r_next= nxtextreloc ;
- }
- nxtextreloc->r_next= rlp_cast 0 ;
- l_text= nxtextreloc ;
- nxtextreloc->r_off = off;
- nxtextreloc->r_val.rel_gp = glosym;
- nxtextreloc->r_typ = typ; /* flags of instruction */
- return(nxtextreloc);
-}
-
-relc_t *
-data_reloc(arg,off,typ) char *arg ; FOFFSET off ; int typ ; {
-
- /*
- * Same as above.
- */
-
- register relc_t *nxdatareloc ;
-
- nxdatareloc= rlp_cast getarea(sizeof *nxdatareloc) ;
- if ( !f_data ) {
- f_data= nxdatareloc ;
- } else {
- l_data->r_next= nxdatareloc ;
- }
- nxdatareloc->r_next= rlp_cast 0 ;
- l_data= nxdatareloc ;
- nxdatareloc->r_off = off;
- nxdatareloc->r_val.rel_lp = lbp_cast arg;
- nxdatareloc->r_typ = typ;
- return(nxdatareloc);
-}
-
-copyout() {
- register i;
- int remtext ;
-
- /*
- * Make the e.out file that looks as follows:
- *
- * __________________________
- * | MAGIC | \
- * | FLAGS | \
- * | UNRESOLVED | \
- * | VERSION | | 8*(2-byte word) header
- * | WORDSIZE | | for interpreter selection
- * | PTRSIZE | /
- * | <UNUSED> | /
- * | <UNUSED> | /
- * | NTEXT | \
- * | NDATA | \
- * | NPROC | \
- * | ENTRY-POINT | | 8*(wordsize-word) header
- * | NLINES | | for interpreter proper
- * | <UNUSED> | /
- * | <UNUSED> | /
- * | <UNUSED> | /
- * |________________________|
- * | |
- * | TEXT | zero filled
- * | | if not word multiple
- * |________________________|
- * | |
- * | DATA |
- * | |
- * |________________________|
- * | |
- * | PROCTABLE |
- * | |
- * |________________________|
- *
- *
- */
-
- remtext = textbytes%wordsize ;
- if ( remtext != 0 ) remtext = wordsize-remtext ;
-
- if ((ifile = fopen(eout,"w")) == NULL )
- fatal("can't create e.out");
-#ifdef CPM
- fclose(tfile); tfile=fopen("TFILE.$$$, "r");
- fclose(dfile); dfile=fopen("DFILE.$$$, "r");
-#else
- tfile=frewind(tfile);
- dfile=frewind(dfile);
-#endif
- xput16(as_magic,ifile);
- xput16(intflags,ifile);
- xput16(unresolved,ifile);
- xput16(VERSION,ifile);
- xput16(wordsize,ifile);
- xput16(ptrsize,ifile);
- xput16(0,ifile);
- xput16(0,ifile);
- xputa(textbytes+remtext ,ifile);
- xputa((cons_t)datablocks,ifile);
- xputa((cons_t)procnum,ifile);
- xputa((cons_t)searchproc(MAIN,xprocs,oursize->n_xproc)->p_num,
- ifile);
- xputa((cons_t)sourcelines,ifile);
- xputa((cons_t)databytes,ifile);
- xputa((cons_t)0,ifile);
- xputa((cons_t)0,ifile);
-
- textprocess(tfile,ifile);
- while ( remtext-- ) xputc(0,ifile) ;
-
- dataprocess(dfile,ifile);
- for (i=0;i<procnum;i++) {
- xputarb(ptrsize,proctab[i].pr_loc,ifile);
- xputarb(ptrsize,proctab[i].pr_off,ifile);
- }
- if ( fclose(ifile)==EOF ) ;
-}
-
-dataprocess(f1,f2) FILE *f1,*f2; {
- relc_t datareloc;
- FOFFSET i;
- register ieof ;
-
-#ifdef CPM
- fclose(rdfile); rdfile=fopen("RDFILE.$$$, "r");
-#else
- rdfile=frewind(rdfile) ;
-#endif
- ieof=getblk(rdfile,(char *)(&datareloc.r_off),
- sizeof datareloc - sizeof datareloc.r_next) ;
- for (i=0 ; i<dataoff && !ieof ; i++) {
- if (i==datareloc.r_off) {
- switch(datareloc.r_typ) {
- case RELADR:
- xputa(xgeta(f1)+datareloc.r_val.rel_i,f2) ;
- i += ptrsize-1 ;
- break ;
- case RELGLO:
- if (datareloc.r_val.rel_gp->g_status&DEF) {
- xputa(xgeta(f1)+
- datareloc.r_val.rel_gp->g_val.g_addr,
- f2);
- i+= ptrsize-1 ;
- break ;
- }
- if ( unresolved == 0 )
- fatal("Definition botch") ;
- case RELHEAD:
- xputc((int)(xgetc(f1)+datareloc.r_val.rel_i),
- f2);
- break;
- default:
- fatal("Bad r_typ in dataprocess");
- }
- ieof=getblk(rdfile,(char *)(&datareloc.r_off),
- sizeof datareloc - sizeof datareloc.r_next) ;
- } else
- xputc(xgetc(f1),f2);
- }
- for ( ; i<dataoff ; i++ ) xputc(xgetc(f1),f2) ;
- if ( !ieof && !getblk(rdfile,(char *)&datareloc,1) )
- fatal("data relocation botch") ;
-}
-
-textprocess(f1,f2) FILE *f1,*f2; {
- relc_t textreloc;
- cons_t n;
- FOFFSET i;
- FILE *otfile ;
- int insl ; register int ieof ;
- char *op_curr ;
- register FOFFSET keep ;
-
-#ifdef CPM
- fclose(rtfile); rtfile=fopen("RTFILE.$$$, "r");
-#else
- rtfile=frewind(rtfile) ;
-#endif
- keep = textoff ; textoff=0 ; otfile=tfile ; tfile=f2 ;
- /* This redirects the output of genop */
- ieof=getblk(rtfile,(char *)(&textreloc.r_off),
- sizeof textreloc - sizeof textreloc.r_next) ;
- for(i=0;i<keep && !ieof ;i++) {
- if( i == textreloc.r_off ) {
- if (textreloc.r_typ&RELMNS) {
- n=textreloc.r_val.rel_i;
- } else {
- if (textreloc.r_val.rel_gp->g_status&DEF) {
- n=textreloc.r_val.rel_gp->g_val.g_addr;
- } else {
- if ( unresolved==0 )
- fatal("Definition botch") ;
- xputc(xgetc(f1),f2) ;
- ieof=getblk(rtfile,(char *)(&textreloc.r_off),
- sizeof textreloc-sizeof textreloc.r_next);
- continue ;
- }
- }
- op_curr = &opchoice[textreloc.r_typ& ~RELMNS] ;
- insl = oplength(*op_curr) ;
- genop(op_curr, n+xgetarb(insl,f1), PAR_G);
- i += insl-1 ;
- ieof=getblk(rtfile,(char *)(&textreloc.r_off),
- sizeof textreloc - sizeof textreloc.r_next) ;
- } else {
- xputc(xgetc(f1),f2) ;
- }
- }
- for ( ; i<keep ; i++ ) xputc(xgetc(f1),f2) ;
- if ( !ieof && !getblk(rtfile,(char *)&textreloc,1) )
- fatal("text relocation botch") ;
- textoff = keep ;
- tfile = otfile ;
-}
-
-upd_reloc() {
- register relc_t *p;
- register glob_t *gbp;
-
- /*
- * Change reloc-tables such that for every pointer into mglobs
- * either the corresponding pointer into xglobs or its value
- * is substituted.
- *
- * Use is made of the known order of mglobs and xglobs
- * see also getcore()
- */
-
- while ( p= f_text ) {
- gbp= p->r_val.rel_gp ;
- if( gbp->g_status&DEF ) {
- p->r_typ |= RELMNS;
- p->r_val.rel_i = gbp->g_val.g_addr;
- } else
- p->r_val.rel_gp = gbp->g_val.g_gp;
- putblk(rtfile,(char *)(&(p->r_off)),sizeof *p - sizeof p) ;
- f_text= p->r_next ; freearea( (area_t) p , sizeof *p ) ;
- }
-
- while( p= f_data ) {
- if (p->r_typ == RELGLO) {
- gbp= p->r_val.rel_gp ;
- if(gbp->g_status&DEF) {
- p->r_typ = RELADR;
- p->r_val.rel_i = gbp->g_val.g_addr;
- } else
- p->r_val.rel_gp = gbp->g_val.g_gp;
- }
- putblk(rdfile,(char *)(&(p->r_off)),sizeof *p - sizeof p) ;
- f_data= p->r_next ; freearea( (area_t) p , sizeof *p ) ;
- }
- l_data= rlp_cast 0 ;
-}
+++ /dev/null
-/* Contents of flags used when describing interpreter opcodes */
-
-#define OPTYPE 07 /* type field in flag */
-
-#define OPMINI 0 /* m MINI */
-#define OPSHORT 1 /* s SHORT */
-#define OPNO 2 /* - No operand */
-#define OP8 3 /* 1 1-byte signed operand */
-#define OP16 4 /* 2 2-byte signed operand */
-#define OP32 5 /* 4 4-byte signed operand */
-#define OP64 6 /* 8 8-byte signed operand */
-
-#define OPESC 010 /* e escaped opcode */
-#define OPWORD 020 /* w operand is word multiple */
-#define OPNZ 040 /* o operand starts at 1 ( or wordsize if w-flag) */
-
-#define OPRANGE 0300 /* Range of operands: Positive, negative, both */
-
-#define OP_BOTH 0000 /* the default */
-#define OP_POS 0100 /* p Positive (>=0) operands only */
-#define OP_NEG 0200 /* n Negative (<0) operands only */
-
-struct opform {
- char i_opcode ; /* the opcode number */
- char i_flag ; /* the flag byte */
- char i_low ; /* the interpreter first opcode */
- char i_num ; /* the number of shorts/minis (optional) */
-};
-
-/* Escape indicators */
-
-#define ESC 254 /* To escape group */
-#define ESC_L 255 /* To 32 and 64 bit operands */
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#include "ip_spec.h"
-#include <stdio.h>
-#include "../../h/em_spec.h"
-#include "../../h/em_flag.h"
-
-/* This program reads the human readable interpreter specification
- and produces a efficient machine representation that can be
- translated by a C-compiler.
-*/
-
-#define NOTAB 600 /* The max no of interpreter specs */
-#define ESCAP 256
-
-struct opform intable[NOTAB] ;
-struct opform *lastform = intable-1 ;
-
-int nerror = 0 ;
-int atend = 0 ;
-int line = 1 ;
-int maxinsl= 0 ;
-
-extern char em_mnem[][4] ;
-char esca[] = "escape" ;
-#define ename(no) ((no)==ESCAP?esca:em_mnem[(no)])
-
-extern char em_flag[] ;
-
-main(argc,argv) char **argv ; {
- if ( argc>1 ) {
- if ( freopen(argv[1],"r",stdin)==NULL) {
- fatal("Cannot open %s",argv[1]) ;
- }
- }
- if ( argc>2 ) {
- if ( freopen(argv[2],"w",stdout)==NULL) {
- fatal("Cannot create %s",argv[2]) ;
- }
- }
- if ( argc>3 ) {
- fatal("%s [ file [ file ] ]",argv[0]) ;
- }
- atend=0 ;
- readin();
- atend=1 ;
- checkall();
- if ( nerror==0 ) {
- writeout();
- }
- return nerror ;
-}
-
-readin() {
- register struct opform *nextform ;
- char *ident();
- char *firstid ;
- register maxl ;
-
- maxl = 0 ;
- for ( nextform=intable ;
- !feof(stdin) && nextform<&intable[NOTAB] ; ) {
- firstid=ident() ;
- if ( *firstid=='\n' || feof(stdin) ) continue ;
- lastform=nextform ;
- nextform->i_opcode = getmnem(firstid) ;
- nextform->i_flag = decflag(ident()) ;
- switch ( nextform->i_flag&OPTYPE ) {
- case OPMINI:
- case OPSHORT:
- nextform->i_num = atoi(ident()) ;
- break ;
- }
- nextform->i_low = atoi(ident()) ;
- if ( *ident()!='\n' ) {
- int c ;
- error("End of line expected");
- while ( (c=readchar())!='\n' && c!=EOF ) ;
- }
- if ( oplength(nextform)>maxl ) maxl=oplength(nextform) ;
- nextform++ ;
- }
- if ( !feof(stdin) ) fatal("Internal table too small") ;
- maxinsl = maxl ;
-}
-
-char *ident() {
- /* skip spaces and tabs, anything up to space,tab or eof is
- a identifier.
- Anything from # to end-of-line is an end-of-line.
- End-of-line is an identifier all by itself.
- */
-
- static char array[200] ;
- register int c ;
- register char *cc ;
-
- do {
- c=readchar() ;
- } while ( c==' ' || c=='\t' ) ;
- for ( cc=array ; cc<&array[(sizeof array) - 1] ; cc++ ) {
- if ( c=='#' ) {
- do {
- c=readchar();
- } while ( c!='\n' && c!=EOF ) ;
- }
- *cc = c ;
- if ( c=='\n' && cc==array ) break ;
- c=readchar() ;
- if ( c=='\n' ) {
- pushback(c) ;
- break ;
- }
- if ( c==' ' || c=='\t' || c==EOF ) break ;
- }
- *++cc=0 ;
- return array ;
-}
-
-int getmnem(str) char *str ; {
- char (*ptr)[4] ;
-
- for ( ptr = em_mnem ; *ptr<= &em_mnem[sp_lmnem-sp_fmnem][0] ; ptr++ ) {
- if ( strcmp(*ptr,str)==0 ) return (ptr-em_mnem) ;
- }
- error("Illegal mnemonic") ;
- return 0 ;
-}
-
-error(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- if ( !atend ) fprintf(stderr,"line %d: ",line) ;
- fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
- fprintf(stderr,"\n");
- nerror++ ;
-}
-
-mess(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- if ( !atend ) fprintf(stderr,"line %d: ",line) ;
- fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
- fprintf(stderr,"\n");
-}
-
-fatal(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
- error(str,a1,a2,a3,a4,a5,a6) ;
- exit(1) ;
-}
-
-#define ILLGL -1
-
-check(val) int val ; {
- if ( val!=ILLGL ) error("Illegal flag combination") ;
-}
-
-int decflag(str) char *str ; {
- int type ;
- int escape ;
- int range ;
- int wordm ;
- int notzero ;
-
- type=escape=range=wordm=notzero= ILLGL ;
- while ( *str ) switch ( *str++ ) {
- case 'm' :
- check(type) ; type=OPMINI ; break ;
- case 's' :
- check(type) ; type=OPSHORT ; break ;
- case '-' :
- check(type) ; type=OPNO ; break ;
- case '1' :
- check(type) ; type=OP8 ; break ;
- case '2' :
- check(type) ; type=OP16 ; break ;
- case '4' :
- check(type) ; type=OP32 ; break ;
- case '8' :
- check(type) ; type=OP64 ; break ;
- case 'e' :
- check(escape) ; escape=0 ; break ;
- case 'N' :
- check(range) ; range= 2 ; break ;
- case 'P' :
- check(range) ; range= 1 ; break ;
- case 'w' :
- check(wordm) ; wordm=0 ; break ;
- case 'o' :
- check(notzero) ; notzero=0 ; break ;
- default :
- error("Unknown flag") ;
- }
- if ( type==ILLGL ) error("Type must be specified") ;
- switch ( type ) {
- case OP64 :
- case OP32 :
- if ( escape!=ILLGL ) error("Conflicting escapes") ;
- escape=ILLGL ;
- case OP16 :
- case OP8 :
- case OPSHORT :
- case OPNO :
- if ( notzero!=ILLGL ) mess("Improbable OPNZ") ;
- if ( type==OPNO && range!=ILLGL ) {
- mess("No operand in range") ;
- }
- }
- if ( escape!=ILLGL ) type|=OPESC ;
- if ( wordm!=ILLGL ) type|=OPWORD ;
- switch ( range) {
- case ILLGL : type|=OP_BOTH ; break ;
- case 1 : type|=OP_POS ; break ;
- case 2 : type|=OP_NEG ; break ;
- }
- if ( notzero!=ILLGL ) type|=OPNZ ;
- return type ;
-}
-
-writeout() {
- register struct opform *next ;
- int elem[sp_lmnem-sp_fmnem+1+1] ;
- /* for each op points to first of descr. */
- register int i,currop ;
- int nch ;
- int compare() ;
-
- qsort(intable,(lastform-intable)+1,sizeof intable[0],compare) ;
-
- printf("int\tmaxinsl\t= %d ;\n",maxinsl) ;
- currop= -1 ; nch=0 ;
- printf("char opchoice[] = {\n") ;
- for (next=intable ; next<=lastform ; next++ ) {
- if ( (next->i_opcode&0377)!=currop ) {
- for ( currop++ ;
- currop<(next->i_opcode&0377) ; currop++ ) {
- elem[currop]= nch ;
- error("Missing opcode %s",em_mnem[currop]) ;
- }
- elem[currop]= nch ;
- }
- printf("%d, %d,",next->i_flag&0377,next->i_low&0377) ;
- nch+=2 ;
- switch ( next->i_flag&OPTYPE ) {
- case OPMINI :
- case OPSHORT :
- printf("%d,",next->i_num&0377) ; nch++ ;
- }
- printf("\n") ;
- }
- for ( currop++ ; currop<=sp_lmnem-sp_fmnem ; currop++ ) {
- elem[currop]= nch ;
- error("Missing opcode %s",em_mnem[currop]) ;
- }
- elem[sp_lmnem-sp_fmnem+1]=nch ;
- printf("0 } ;\n\nchar *opindex[] = {\n");
- for ( i=0 ; i<=sp_lmnem-sp_fmnem+1 ; i++ ) {
- printf(" &opchoice[%d],\n",elem[i]) ;
- }
- printf("} ;\n") ;
-}
-
-int compare(a,b) struct opform *a,*b ; {
- if ( a->i_opcode!=b->i_opcode ) {
- return (a->i_opcode&0377)-(b->i_opcode&0377) ;
- }
- return oplength(a)-oplength(b) ;
-}
-
-int oplength(a) struct opform *a ; {
- int cnt ;
-
- cnt=1 ;
- if ( a->i_flag&OPESC ) cnt++ ;
- switch( a->i_flag&OPTYPE ) {
- case OPNO :
- case OPMINI : break ;
- case OP8 :
- case OPSHORT : cnt++ ; break ;
- case OP16 : cnt+=2 ; break ;
- case OP32 : cnt+=5 ; break ;
- case OP64 : cnt+=9 ; break ;
- }
- return cnt ;
-}
-
-/* ----------- checking --------------*/
-
-int ecodes[256],codes[256],lcodes[256] ;
-
-#define NMNEM (sp_lmnem-sp_fmnem+1)
-#define MUST 1
-#define MAY 2
-#define FORB 3
-
-char negc[NMNEM], zc[NMNEM], posc[NMNEM] ;
-
-checkall() {
- register i,flag ;
- register struct opform *next ;
- int opc,low ;
-
- for ( i=0 ; i<NMNEM ; i++ ) negc[i]=zc[i]=posc[i]=0 ;
- for ( i=0 ; i<256 ; i++ ) lcodes[i]= codes[i]= ecodes[i]= -1 ;
- codes[254]=codes[255]=ESCAP;
-
- atend=0 ; line=0 ;
- for ( next=intable ; next<=lastform ; next++ ) {
- line++ ;
- flag = next->i_flag&0377 ;
- opc = next->i_opcode&0377 ;
- low = next->i_low&0377 ;
- chkc(flag,low,opc) ;
- switch(flag&OPTYPE) {
- case OPNO : zc[opc]++ ; break ;
- case OPMINI :
- case OPSHORT :
- for ( i=1 ; i<((next->i_num)&0377) ; i++ ) {
- chkc(flag,low+i,opc) ;
- }
- if ( !(em_flag[opc]&PAR_G) &&
- (flag&OPRANGE)==OP_BOTH) {
- mess("Mini's and shorties should have P or N");
- }
- break ;
- case OP8 :
- error("OP8 is removed") ;
- break ;
- case OP16 :
- if ( flag&OP_NEG )
- negc[opc]++ ;
- else if ( flag&OP_POS )
- posc[opc]++ ;
- break ;
- case OP32 :
- case OP64 :
- break ;
- default :
- error("Illegal type") ;
- break ;
- }
- }
- atend=1 ;
- for ( i=0 ; i<256 ; i++ ) if ( codes[i]== -1 ) {
- mess("interpreter opcode %d not used",i) ;
- }
- for ( opc=0 ; opc<NMNEM ; opc++ ) {
- switch(em_flag[opc]&EM_PAR) {
- case PAR_NO :
- ckop(opc,MUST,FORB,FORB) ;
- break ;
- case PAR_C:
- case PAR_D:
- case PAR_F:
- case PAR_B:
- ckop(opc,FORB,MAY,MAY) ;
- break ;
- case PAR_N:
- case PAR_G:
- case PAR_S:
- case PAR_Z:
- case PAR_O:
- case PAR_P:
- ckop(opc,FORB,MAY,FORB) ;
- break ;
- case PAR_R:
- ckop(opc,FORB,MAY,FORB) ;
- break ;
- case PAR_L:
- ckop(opc,FORB,MUST,MUST) ;
- break ;
- case PAR_W:
- ckop(opc,MUST,MAY,FORB) ;
- break ;
- default :
- error("Unknown instruction type of %s",ename(opc)) ;
- break ;
- }
- }
-}
-
-chkc(flag,icode,emc) {
- if ( flag&OPESC ) {
- if ( ecodes[icode]!=-1 ) {
- mess("Escaped opcode %d used by %s and %s",
- icode,ename(emc),ename(ecodes[icode])) ;
- }
- ecodes[icode]=emc;
- } else switch ( flag&OPTYPE ) {
- default:
- if ( codes[icode]!=-1 ) {
- mess("Opcode %d used by %s and %s",
- icode,ename(emc),ename(codes[icode])) ;
- }
- codes[icode]=emc;
- break ;
- case OP32:
- case OP64:
- if ( lcodes[icode]!=-1 ) {
- mess("Long opcode %d used by %s and %s",
- icode,ename(emc),ename(codes[icode])) ;
- }
- lcodes[icode]=emc;
- break ;
- }
-}
-
-ckop(emc,zf,pf,nf) {
- if ( zc[emc]>1 ) mess("More then one OPNO for %s",ename(emc)) ;
- if ( posc[emc]>1 ) mess("More then one OP16(pos) for %s",ename(emc)) ;
- if ( negc[emc]>1 ) mess("More then one OP16(neg) for %s",ename(emc)) ;
- switch(zf) {
- case MUST:
- if ( zc[emc]==0 ) mess("No OPNO for %s",ename(emc)) ;
- break ;
- case FORB:
- if ( zc[emc]==1 ) mess("Forbidden OPNO for %s",ename(emc)) ;
- break ;
- }
- switch(pf) {
- case MUST:
- if ( posc[emc]==0 ) mess("No OP16(pos) for %s",ename(emc)) ;
- break ;
- case FORB:
- if ( posc[emc]==1 )
- mess("Forbidden OP16(pos) for %s",ename(emc)) ;
- break ;
- }
- switch(nf) {
- case MUST:
- if ( negc[emc]==0 ) mess("No OP16(neg) for %s",ename(emc)) ;
- break ;
- case FORB:
- if ( negc[emc]==1 )
- mess("Forbidden OP16(neg) for %s",ename(emc)) ;
- break ;
- }
-}
-
-static int pushchar ;
-static int pushf ;
-
-int readchar() {
- int c ;
-
- if ( pushf ) {
- pushf=0 ;
- c = pushchar ;
- } else {
- if ( feof(stdin) ) return EOF ;
- c=getc(stdin) ;
- }
- if ( c=='\n' ) line++ ;
- return c ;
-}
-
-pushback(c) {
- if ( pushf ) {
- fatal("Double pushback") ;
- }
- pushf++ ;
- pushchar=c ;
- if ( c=='\n' ) line-- ;
-}
+++ /dev/null
-# $Header$
-
-PREFLAGS=-I../../h
-CFLAGS=$(PREFLAGS)
-LDFLAGS=-i
-LINTOPTS=-hbxac $(PREFLAGS)
-LIBS=../../lib/em_data.a
-# LEXLIB is system dependent, try -ll or -lln first
-LEXLIB=-lln
-
-cgg: bootgram.o
- cc $(LDFLAGS) bootgram.o $(LIBS) $(LEXLIB) -o cgg
-
-bootgram.c: bootgram.y
- @echo expect 1 shift/reduce conflict
- yacc bootgram.y
- mv y.tab.c bootgram.c
-
-install: cgg
- cp cgg ../../lib/cgg
-
-cmp: cgg
- cmp cgg ../../lib/cgg
-
-lint: bootgram.c
- lint $(LINTOPTS) bootgram.c
-clean:
- rm -f bootgram.o bootgram.c bootlex.c cgg
-bootgram.o: bootlex.c
-bootgram.o: ../../h/cg_pattern.h
+++ /dev/null
-%{
-
-#ifndef NORCSID
-static char rcsid[]="$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifdef vax | vax2 | vax4
-#define BIG
-#endif
-
-#ifdef BIG
-#define BORS(x,y) x
-#else
-#define BORS(x,y) y
-#endif
-/* Tunable constants */
-
-#define MAXALLREG 5 /* Maximum number of allocates per rule */
-#define MAXREGS BORS(36,32) /* Total number of registers */
-#define MAXREGVARS 8 /* Maximum regvars per type */
-#define MAXPROPS 16 /* Total number of register properties */
-#define MAXTOKENS BORS(75,32) /* Different kind of tokens */
-#define MAXSETS BORS(100,80) /* Number of tokenexpressions definable */
-#define MAXEMPATLEN 25 /* Maximum length of EM-pattern/replacement */
-#define TOKENSIZE 5 /* Maximum number of fields in token struct */
-#define MAXINSTANCE BORS(175,120) /* Maximum number of different tokeninstances */
-#define MAXSTRINGS BORS(600,400)/* Maximum number of different codestrings */
-#define MAXPATTERN BORS(7000,6000) /* Maximum number of bytes in pattern[] */
-#define MAXNODES BORS(450,350) /* Maximum number of expression nodes */
-#define MAXMEMBERS 2 /* Maximum number of subregisters per reg */
-#define NMOVES BORS(50,30) /* Maximum number of move definitions */
-#define MAXC1 20 /* Maximum of coercions type 1 */
-#define MAXC2 20 /* Maximum of coercions type 2 */
-#define MAXC3 20 /* Maximum of coercions type 3 */
-#define MAXSPLIT 4 /* Maximum degree of split */
-#define MAXNSTR 40 /* Maximum consecutive strings in coderule */
-
-/* Derived constants */
-
-#define SETSIZE ((MAXREGS+1+MAXTOKENS+15)>>4)
-#define PROPSETSIZE ((MAXPROPS+15)>>4)
-
-#define BMASK 0377
-#define BSHIFT 8
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXPATLEN 7 /* Maximum length of tokenpatterns */
-
-typedef char byte;
-typedef char * string;
-
-#include <stdio.h>
-#include <assert.h>
-#include <ctype.h>
-#include <em_spec.h>
-#include <em_flag.h>
-#include <em_reg.h>
-#include <cg_pattern.h>
-
-typedef struct list1str {
- struct list1str *l1next;
- string l1name;
-} *list1;
-typedef struct list2str {
- struct list2str *l2next;
- list1 l2list;
-} *list2;
-typedef struct list3str {
- struct list3str *l3next;
- list2 l3list;
-} *list3;
-
-typedef struct reginfo {
- string rname;
- string rrepr;
- int rsize;
- int rmembers[MAXMEMBERS];
- int rregvar;
- short rprop[PROPSETSIZE];
-} *reginfo;
-
-typedef struct tokeninfo {
- string t_name;
- list2 t_struct;
- struct {
- int t_type;
- string t_sname;
- } t_fields[TOKENSIZE-1];
- int t_size;
- cost_t t_cost;
- int t_format;
-} token_t,*token_p;
-
-typedef struct ident {
- struct ident *i_next;
- string i_name;
- int i_type;
-# define IREG 1
-# define IPRP 2
-# define ITOK 3
-# define IEXP 4
- union {
- int i_regno;
- int i_prpno;
- int i_tokno;
- int i_expno;
- } i_i;
-} ident_t,*ident_p;
-
-#define ITABSIZE 32
-ident_p identtab[ITABSIZE];
-
-#define LOOKUP 0
-#define HALFWAY 1
-#define ENTER 2
-#define JUSTLOOKING 3
-
-
-typedef struct expr {
- int expr_typ;
-# define TYPINT 1
-# define TYPREG 2
-# define TYPSTR 3
-# define TYPBOOL 4
- int expr_index;
-} expr_t,*expr_p;
-
-unsigned cc1=1,cc2=1,cc3=1,cc4=1;
-
-node_t nodes[MAXNODES];
-node_p lastnode=nodes+1;
-
-string codestrings[MAXSTRINGS];
-int ncodestrings;
-
-int strar[MAXNSTR];
-int nstr;
-
-int pathash[256];
-
-reginfo machregs[MAXREGS];
-char stregclass[MAXREGS];
-int nmachregs=1;
-int nregclasses=1;
-int maxmembers;
-struct {
- ident_p propname;
- set_t propset;
-} machprops[MAXPROPS];
-int nprops=0;
-token_t machtokens[MAXTOKENS];
-int nmachtokens=1;
-set_t machsets[MAXSETS];
-int nmachsets=0;
-int patmnem[MAXEMPATLEN];
-int empatlen;
-int maxempatlen;
-int empatexpr;
-int maxrule=1;
-int pattokexp[MAXPATLEN];
-int tokpatlen;
-int lookident=0; /* lexical analyzer flag */
-list3 structpool=0;
-int nallreg;
-int allreg[MAXALLREG];
-int maxallreg;
-int lino=0;
-int nerrors=0;
-int curtokexp;
-expr_t arexp[TOKENSIZE];
-int narexp;
-inst_t arinstance[MAXINSTANCE];
-int narinstance=1;
-move_t machmoves[NMOVES];
-int nmoves=0;
-byte pattern[MAXPATTERN];
-int npatbytes=0;
-int prevind;
-int rulecount; /* Temporary index for ... construct */
-int ncoderules=0;
-int codebytes=0;
-FILE *cfile;
-FILE *hfile;
-int maxtokensize=0;
-int dealflag;
-int emrepllen;
-int replmnem[MAXEMPATLEN];
-int tokrepllen;
-int replinst[MAXPATLEN];
-int replexpr[MAXPATLEN];
-c1_t c1coercs[MAXC1];
-c2_t c2coercs[MAXC2];
-c3_t c3coercs[MAXC3];
-int nc1=0,nc2=0,nc3=0;
-int maxsplit=0;
-int wsize= -1;
-int psize= -1;
-int bsize= -1;
-char *fmt=0;
-
-int cchandled;
-int ccspoiled;
-int ccregexpr;
-int ccinstanceno;
-int cocopropno;
-int cocosetno;
-int allexpno;
-
-int rvused; /* regvars used */
-int nregvar[4]; /* # of register variables of all kinds */
-int rvnumbers[4][MAXREGVARS]; /* The register numbers */
-
-#define chktabsiz(size,maxsize,which) if(size>=maxsize) tabovf(which)
-
-#define MUST1BEINT(e) int exp1=e.expr_index;tstint(e)
-#define MUST2BEINT(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstint(e1);tstint(e2)
-#define MUST1BEBOOL(e) int exp1=e.expr_index;tstbool(e)
-#define MUST2BEBOOL(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstbool(e1);tstbool(e2)
-
-%}
-
-%union {
- int yy_int;
- int *yy_intp;
- string yy_string;
- list1 yy_list1;
- list2 yy_list2;
- expr_t yy_expr;
- cost_t yy_cost;
- set_t yy_set;
- ident_p yy_ident;
- char yy_char;
- inst_t yy_instance;
-}
-
-%type <yy_list1> list1,structlistel
-%type <yy_list2> structlist,structdecl
-%type <yy_expr> expr optexpr
-%type <yy_cost> optcost cost optcommacost
-%type <yy_int> optboolexpr optnocoerc mnem emargno tokargno optprop
-%type <yy_int> optcommabool optstack subreg tokenexpressionno optregvar
-%type <yy_int> tokeninstanceno code stackreplacement optslashnumber
-%type <yy_set> tokenexpression
-%type <yy_instance> tokeninstance
-%type <yy_string> optformat
-%token <yy_string> IDENT TYPENAME
-%token <yy_ident> RIDENT,PIDENT,TIDENT,EIDENT
-%token <yy_string> LSTRING,STRING
-%token <yy_int> NUMBER
-%token <yy_intp> CIDENT
-%token REGISTERHEAD TOKENHEAD EXPRESSIONHEAD CODEHEAD MOVEHEAD TESTHEAD STACKHEAD
-%token REGVAR INREG LOOP POINTER FLOAT
-%token TIMEFAC SIZEFAC FORMAT RETURN
-%token MOVE ERASE ALLOCATE ELLIPS COST REMOVE STACK
-%token SEP SAMESIGN SFIT UFIT ROM DEFINED TOSTRING LOWW HIGHW
-%token NOCC SETCC SAMECC TEST NOCOERC
-%token <yy_char> LCASELETTER
-%start machinespec
-
-%left OR2
-%left AND2
-%left CMPEQ,CMPNE
-%left CMPLT,CMPLE,CMPGT,CMPGE
-%left RSHIFT,LSHIFT
-%left '+','-'
-%left '*','/','%'
-%nonassoc NOT,COMP,UMINUS
-%nonassoc '$'
-%%
-machinespec
- : rcsid constants registersection tokensection
- { inbetween(); }
- expressionsection codesection movesection testsection stacksection
- ;
-
-rcsid
- : /* empty */
- | STRING
- { strlookup($1); }
- ;
-
-constants
- : /* empty */
- | constants CIDENT '=' NUMBER
- { *$2 = $4; }
- | constants SIZEFAC '=' NUMBER optslashnumber
- { cc1 = $4; cc2 = $5; }
- | constants TIMEFAC '=' NUMBER optslashnumber
- { cc3 = $4; cc4 = $5; }
- | constants FORMAT '=' STRING
- { fmt = $4; }
- ;
-optslashnumber
- : /* empty */
- { $$ = 1; }
- | '/' NUMBER
- { $$ = $2; }
- ;
-
-registersection
- : REGISTERHEAD registerdefs
- ;
-registerdefs
- : /* empty */
- | registerdefs registerdef
- ;
-
-registerdef
- : IDENT '=' '(' STRING ',' NUMBER list1 ')' optregvar list1 '.'
- { register ident_p ip;
- register list1 l;
- register reginfo r;
- int i;
-
- r=(reginfo) myalloc(sizeof(struct reginfo));
- r->rname = $1;
- r->rrepr = $4;
- r->rsize = $6;
- if($9>=0 && $7!=0)
- yyerror("No subregisters allowed in regvar");
- for (i=0;i<MAXMEMBERS;i++)
- r->rmembers[i] = 0;
- i=0;
- for (l=$7;l!=0;l=l->l1next) {
- ip=ilookup(l->l1name,LOOKUP);
- if (ip->i_type != IREG)
- yyerror("Bad member of set");
- chktabsiz(i,MAXMEMBERS,"Member of register");
- r->rmembers[i++] = ip->i_i.i_regno;
- }
- maxmembers=max(maxmembers,i);
- r->rregvar=$9;
- if ($9>=0) {
- rvused=1;
- chktabsiz(nregvar[$9],MAXREGVARS,"Regvar");
- rvnumbers[$9][nregvar[$9]++] = nmachregs;
- }
- for(i=0;i<PROPSETSIZE;i++)
- r->rprop[i] = 0;
- ip=ilookup($1,ENTER);
- ip->i_type=IREG;
- ip->i_i.i_regno=nmachregs;
- for (l = $10; l!= 0; l=l->l1next) {
- ip = ilookup(l->l1name,HALFWAY);
- if (ip->i_type) {
- if (ip->i_type != IPRP)
- yyerror("Multiple defined symbol");
- else if(machprops[ip->i_i.i_prpno].propset.set_size != r->rsize)
- yyerror("property has more than 1 size");
- } else {
- chktabsiz(nprops,MAXPROPS,"Property");
- ip->i_type = IPRP;
- ip->i_i.i_prpno = nprops;
- machprops[nprops].propname = ip;
- machprops[nprops++].propset.set_size = r->rsize;
- }
- r->rprop[ip->i_i.i_prpno>>4] |= (1<<(ip->i_i.i_prpno&017));
- }
- chktabsiz(nmachregs,MAXREGS,"Register table");
- machregs[nmachregs++] = r;
- }
- | error '.'
- ;
-
-optregvar
- : /* nothing */
- { $$ = -1; }
- | REGVAR
- { $$ = reg_any; }
- | REGVAR '(' LOOP ')'
- { $$ = reg_loop; }
- | REGVAR '(' POINTER ')'
- { $$ = reg_pointer; }
- | REGVAR '(' FLOAT ')'
- { $$ = reg_float; }
- ;
-
-tokensection
- : TOKENHEAD tkdefs
- ;
-tkdefs
- : /* empty */
- | tkdefs tkdef
- ;
-tkdef
- : IDENT '=' structdecl NUMBER optcost optformat
- { register token_p tp;
- register ident_p ip;
-
- chktabsiz(nmachtokens,MAXTOKENS,"Token table");
- tp = &machtokens[nmachtokens];
- tp->t_name = $1;
- tp->t_struct = $3;
- tp->t_size = $4;
- tp->t_cost = $5;
- ip = ilookup($1,ENTER);
- ip->i_type = ITOK;
- ip->i_i.i_tokno = nmachtokens++;
- maxtokensize=max(maxtokensize,structsize($3));
- setfields(tp,$6);
- }
- | error
- ;
-structdecl
- : '{' structlist '}'
- { $$ = lookstruct($2); }
- ;
-structlist
- : /* empty */
- { $$=0; }
- | structlistel structlist
- { $$=(list2) myalloc(sizeof(struct list2str));
- $$->l2next = $2;
- $$->l2list = $1;
- }
- ;
-structlistel
- : TYPENAME list1 ';'
- { $$=(list1) myalloc(sizeof(struct list1str));
- $$->l1next = $2;
- $$->l1name = $1;
- }
- ;
-
-optcost : /* empty */
- { $$.c_size = $$.c_time = 0; }
- | COST '=' '(' expr ',' expr ')'
- { MUST2BEINT($4,$6);
- $$.c_size = exp1;
- $$.c_time = exp2;
- }
- ;
-optformat
- : /* empty */
- { $$ = 0; }
- | STRING
- ;
-
-expressionsection
- : /* empty */
- | EXPRESSIONHEAD tokenexpressions
- ;
-tokenexpressions
- : tokenexpressionline
- | tokenexpressionline tokenexpressions
- ;
-tokenexpressionline
- : IDENT '=' tokenexpression
- {
- { register ident_p ip;
-
- chktabsiz(nmachsets,MAXSETS,"Expression table");
- machsets[nmachsets] = $3;
- ip=ilookup($1,ENTER);
- ip->i_type = IEXP;
- ip->i_i.i_expno = nmachsets++;
- }
- }
- | error
- ;
-tokenexpression
- : PIDENT
- { $$ = machprops[$1->i_i.i_prpno].propset; }
- | TIDENT
- { register i;
-
- for(i=0;i<SETSIZE;i++) $$.set_val[i]=0;
- $$.set_val[($1->i_i.i_tokno+nmachregs+1)>>4] |=
- 01<<(($1->i_i.i_tokno+nmachregs+1)&017);
- $$.set_size = machtokens[$1->i_i.i_tokno].t_size;
- }
- | EIDENT
- { $$=machsets[$1->i_i.i_expno]; }
- | tokenexpression '*' tokenexpression
- { register i;
-
- if (($$.set_size=$1.set_size)==0)
- $$.set_size = $3.set_size;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] & $3.set_val[i];
- }
- | tokenexpression '+' tokenexpression
- { register i;
-
- if ($1.set_size == -1)
- $$.set_size = $3.set_size;
- else if ($3.set_size == -1)
- $$.set_size = $1.set_size;
- else if ($1.set_size == $3.set_size)
- $$.set_size = $1.set_size;
- else
- $$.set_size = 0;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] | $3.set_val[i];
- }
- | tokenexpression '-' tokenexpression
- { register i;
-
- if ($1.set_size == -1)
- $$.set_size = $3.set_size;
- else if ($3.set_size == -1)
- $$.set_size = $1.set_size;
- else if ($1.set_size == $3.set_size)
- $$.set_size = $1.set_size;
- else
- $$.set_size = 0;
- for (i=0;i<SETSIZE;i++)
- $$.set_val[i] = $1.set_val[i] & ~ $3.set_val[i];
- }
- | '(' tokenexpression ')'
- { $$ = $2; }
- ;
-
-codesection
- : CODEHEAD coderules
- ;
-coderules
- : coderule
- | coderules coderule
- ;
-coderule
- : { nallreg=emrepllen=tokrepllen=0; }
- empattern SEP stackpattern SEP code SEP stackreplacement SEP
- emreplacement SEP cost
- { int i;
-
- if (emrepllen) {
- outbyte(DO_EMREPLACE+(emrepllen<<5));
- for (i=0;i<emrepllen;i++) {
- out(replmnem[i]);
- out(replexpr[i]);
- }
- }
- if ($8==0) {
- outbyte(DO_TOKREPLACE+(tokrepllen<<5));
- for(i=0;i<tokrepllen;i++)
- out(replinst[i]);
- } else {
- static int warncount=0;
- if (!warncount++)
- fprintf(stderr,
- "WARNING: convert to stacksection, will disappear soon");
- outbyte(DO_TOKREPLACE);
- }
- if ($12.c_size!=0 || $12.c_time!=0) {
- outbyte(DO_COST);
- out($12.c_size);
- out($12.c_time);
- }
- outbyte(empatlen==0? DO_RETURN : DO_NEXTEM);
- fprintf(cfile,"\n");
- ncoderules++;
- maxallreg=max(maxallreg,nallreg);
- if (empatlen==0) { /* coercion */
- if (tokrepllen<1 && $8==0)
- yyerror("No replacement in coercion");
- if (tokpatlen>1)
- yyerror("Token pattern too long");
- if ($8!=0) { /* stacking */
- c1_p cp;
- chktabsiz(nc1,MAXC1,"Coerc table 1");
- cp = &c1coercs[nc1++];
- cp->c1_texpno = pattokexp[1];
- cp->c1_prop = -1;
- cp->c1_codep = $6;
- } else if (tokrepllen>1) { /* splitting */
- c2_p cp;
- chktabsiz(nc2,MAXC2,"Coerc table 2");
- cp= &c2coercs[nc2++];
- cp->c2_texpno = pattokexp[1];
- cp->c2_nsplit = tokrepllen;
- maxsplit=max(maxsplit,tokrepllen);
- for (i=0;i<tokrepllen;i++)
- cp->c2_repl[i] = replinst[i];
- cp->c2_codep = $6;
- if (nallreg>0)
- yyerror("No allocates allowed here");
- } else { /* one to one coercion */
- c3_p cp;
- chktabsiz(nc3,MAXC3,"Coerc table 3");
- cp= &c3coercs[nc3++];
- if (tokpatlen)
- cp->c3_texpno = pattokexp[1];
- else
- cp->c3_texpno = 0;
- if (nallreg>1)
- yyerror("Too many allocates in coercion");
- cp->c3_prop = nallreg==0 ? 0 : allreg[0];
- cp->c3_repl = replinst[0];
- cp->c3_codep = $6;
- }
- }
- }
- | error
- ;
-empattern
- : /* empty */
- { empatlen=0; }
- | mnemlist optboolexpr
- { register i;
-
- empatexpr = $2;
- patbyte(0);
- patshort(prevind);
- prevind = npatbytes - 3;
- maxempatlen = max(empatlen,maxempatlen);
- pat(empatlen);
- for(i=1;i<=empatlen;i++)
- patbyte(patmnem[i]);
- pat(empatexpr);
- rulecount = npatbytes;
- patbyte(1); /* number of different rules with this pattern */
- pat(codebytes); /* first rule */
- }
- | ELLIPS
- { pattern[rulecount]++;
- maxrule= max(maxrule,pattern[rulecount]);
- pat(codebytes);
- }
- ;
-
-mnemlist
- : mnem
- { empatlen = 1; patmnem[empatlen] = $1; }
- | mnemlist mnem
- { chktabsiz(empatlen+1,MAXEMPATLEN,"EM pattern");
- patmnem[++empatlen] = $2;
- }
- ;
-mnem : IDENT
- { if(strlen($1)!=3 || ($$=mlookup($1))==0)
- yyerror("not an EM-mnemonic");
- }
- ;
-
-stackpattern
- : optnocoerc tokenexpressionlist optstack
- { register i;
-
- if (tokpatlen != 0) {
- outbyte(($1 ? ( $3 ? DO_XXMATCH: DO_XMATCH ) : DO_MATCH)+(tokpatlen<<5));
- for(i=1;i<=tokpatlen;i++) {
- out(pattokexp[i]);
- }
- }
- if ($3 && tokpatlen==0 && empatlen==0) {
- outbyte(DO_COERC);
- }
- if ($3 && !$1 && empatlen!=0) {
- outbyte(DO_REMOVE);
- out(allexpno);
- }
- }
- ;
-
-optnocoerc
- : /* empty */
- { $$ = 0; }
- | NOCOERC ':'
- { $$ = 1; }
- ;
-
-tokenexpressionlist
- : /* empty */
- { tokpatlen = 0; }
- | tokenexpressionlist tokenexpressionno
- { chktabsiz(tokpatlen+1,MAXPATLEN,"Token pattern");
- pattokexp[++tokpatlen] = $2;
- if (machsets[$2].set_size==0)
- yyerror("Various sized set in tokenpattern");
- }
- ;
-
-tokenexpressionno
- : tokenexpression
- { $$ = exprlookup($1); }
- ;
-
-optstack
- : /* empty */
- { $$ = 0; }
- | STACK
- { $$ = 1; }
- ;
-
-code :
- { $$ = codebytes; cchandled=ccspoiled=0; }
- initcode restcode
- { if (cchandled==0 && ccspoiled!=0) {
- outbyte(DO_ERASE);
- out(ccregexpr);
- }
- }
- ;
-
-initcode
- : /* empty */
- | initcode remove
- | initcode allocate
- ;
-remove
- : REMOVE '(' tokenexpressionno
- { curtokexp = $3; }
- optcommabool ')'
- { outbyte(DO_REMOVE+ ($5!=0 ? 32 : 0));
- out($3);
- if ($5!=0) out($5);
- }
- | REMOVE '(' expr ')'
- { if ($3.expr_typ != TYPREG)
- yyerror("Expression must be register");
- outbyte(DO_RREMOVE);
- out($3.expr_index);
- }
- ;
-optcommabool
- : /* empty */
- { $$ = 0; }
- | ',' expr
- { MUST1BEBOOL($2);
- $$ = exp1;
- }
- ;
-
-restcode: /* empty */
- | restcode LSTRING expr
- { outbyte(DO_LOUTPUT);
- out(stringno($2));
- free($2);
- out($3.expr_index);
- ccspoiled++;
- }
- | restcode stringlist
- { int i;
- for(i=0;nstr>0;i++,nstr--) {
- if (i%8==0) outbyte(DO_ROUTPUT+(nstr>7 ? 7 : nstr-1)*32);
- out(strar[i]);
- }
- ccspoiled++;
- }
- | restcode RETURN
- { outbyte(DO_PRETURN); }
- | restcode move
- | restcode erase
- | restcode NOCC
- { outbyte(DO_ERASE);
- out(ccregexpr);
- cchandled++;
- }
- | restcode SAMECC
- { cchandled++; }
- | restcode SETCC '(' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out(ccinstanceno);
- out($4);
- cchandled++;
- }
- | restcode TEST '(' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out($4);
- out(ccinstanceno);
- ccspoiled=0;
- }
- ;
-
-stringlist
- : STRING
- { nstr=1;
- strar[0]=stringno($1);
- free($1);
- }
- | stringlist STRING
- { chktabsiz(nstr,MAXNSTR,"Consecutiv strings");
- strar[nstr++] = stringno($2);
- free($2);
- }
- ;
-
-move
- : MOVE '(' tokeninstanceno ',' tokeninstanceno ')'
- { outbyte(DO_MOVE);
- out($3);
- out($5);
- }
- ;
-
-erase
- : ERASE '(' expr ')'
- { outbyte(DO_ERASE);
- out($3.expr_index);
- if($3.expr_typ != TYPREG)
- yyerror("Bad argument of erase");
- }
- ;
-
-allocate
- : ALLOCATE { dealflag=0; } '(' alloclist ')'
- { if (dealflag)
- outbyte(DO_REALLOCATE);
- }
- ;
-
-
-alloclist
- : allocel
- | alloclist optcomma allocel
- ;
-
-allocel
- : tokeninstanceno /* deallocate */
- { outbyte(DO_DEALLOCATE);
- out($1);
- dealflag++;
- }
- | PIDENT
- { allreg[nallreg++] = $1->i_i.i_prpno;
- outbyte(DO_ALLOCATE);
- out($1->i_i.i_prpno);
- }
- | PIDENT '=' tokeninstanceno
- { allreg[nallreg++] = $1->i_i.i_prpno;
- outbyte(DO_ALLOCATE+32);
- out($1->i_i.i_prpno);
- out($3);
- }
- ;
-
-stackreplacement
- : /* empty */
- { $$=0; }
- | STACK
- { $$=1; }
- | '{' STACK '}'
- { $$=1; }
- | stackrepllist
- { $$=0; }
- ;
-stackrepllist
- : tokeninstanceno
- { tokrepllen=1; replinst[0] = $1; }
- | stackrepllist tokeninstanceno
- { chktabsiz(tokrepllen+1,MAXPATLEN,"Stack replacement");
- replinst[tokrepllen++] = $2;
- }
- ;
-
-emreplacement
- : /* empty, normal case */
- | emrepllist
- ;
-emrepllist
- : mnem optexpr
- { emrepllen=1;
- replmnem[0]=$1;
- replexpr[0]=$2.expr_index;
- }
- | emrepllist mnem optexpr
- { chktabsiz(emrepllen+1,MAXEMPATLEN,"EM replacement");
- replmnem[emrepllen]=$2;
- replexpr[emrepllen]=$3.expr_index;
- emrepllen++;
- }
- ;
-
-cost : /* empty */
- { $$.c_size = $$.c_time = 0;
- }
- | '(' expr ',' expr ')'
- { MUST2BEINT($2,$4);
- $$.c_size = exp1;
- $$.c_time = exp2;
- }
- | cost '+' '%' '[' tokargno ']'
- { $$.c_size = lookup(1,EX_PLUS,$1.c_size,
- lookup(0,EX_COST,$5,0));
- $$.c_time = lookup(1,EX_PLUS,$1.c_time,
- lookup(0,EX_COST,$5,1));
- }
- ;
-
-movesection
- : MOVEHEAD movedefs
- ;
-
-movedefs
- : movedef
- | movedefs movedef
- ;
-
-movedef
- : '(' tokenexpressionno
- { curtokexp = $2; }
- optboolexpr ',' tokenexpressionno
- { curtokexp = $6;
- pattokexp[1] = $2;
- pattokexp[2] = $6;
- tokpatlen=2;
- }
- optboolexpr ',' code optcommacost ')'
- { register move_p mp;
-
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nmoves,NMOVES,"Move definition table");
- mp = &machmoves[nmoves++];
- mp->m_set1 = $2;
- mp->m_expr1= $4;
- mp->m_set2 = $6;
- mp->m_expr2= $8;
- mp->m_cindex=$10;
- mp->m_cost = $11;
- }
- | error
- ;
-
-testsection
- : /* empty */
- | TESTHEAD testdefs
- ;
-
-testdefs: testdef
- | testdefs testdef
- ;
-
-testdef : '(' tokenexpressionno
- { curtokexp = $2;
- pattokexp[1] = $2;
- pattokexp[2] = cocosetno;
- tokpatlen=2;
- }
- optboolexpr ',' code optcommacost ')'
- { register move_p mp;
-
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nmoves,NMOVES,"Move definition table(tests)");
- mp = &machmoves[nmoves++];
- mp->m_set1 = $2;
- mp->m_expr1 = $4;
- mp->m_set2 = cocosetno;
- mp->m_expr2 = 0;
- mp->m_cindex = $6;
- mp->m_cost = $7;
- }
- ;
-
-stacksection
- : STACKHEAD stackdefs
- | /* empty */
- ;
-stackdefs
- : stackdef
- | stackdefs stackdef
- ;
-stackdef
- : '(' tokenexpressionno
- { curtokexp = $2;
- pattokexp[1] = $2;
- tokpatlen=1;
- }
- optboolexpr ',' optprop ',' code optcommacost ')'
- { register c1_p cp;
-
- outbyte(DO_TOKREPLACE);
- outbyte(DO_RETURN);
- fprintf(cfile,"\n");
- chktabsiz(nc1,MAXC1,"Stacking table");
- cp = &c1coercs[nc1++];
- cp->c1_texpno = $2;
- cp->c1_expr = $4;
- cp->c1_prop = $6;
- cp->c1_codep = $8;
- cp->c1_cost = $9;
- }
- ;
-
-optprop
- : /* empty */
- { $$ = -1; }
- | PIDENT
- { $$ = $1->i_i.i_prpno; }
- ;
-
-optcommacost
- : /* empty */
- { $$.c_size = 0; $$.c_time = 0;}
- | ',' cost
- { $$ = $2; }
- ;
-
-list1 : /* empty */
- { $$ = 0; }
- | optcomma IDENT list1
- { $$=(list1) myalloc(sizeof(struct list1str));
- $$->l1next = $3;
- $$->l1name = $2;
- }
- ;
-optcomma: /* nothing */
- | ','
- ;
-emargno : NUMBER
- { if ($1<1 || $1>empatlen)
- yyerror("Number after $ out of range");
- $$ = $1;
- }
- ;
-tokargno
- : NUMBER
- { if ($1<1 || $1>tokpatlen)
- yyerror("Number within %[] out of range");
- $$ = $1;
- }
- ;
-expr : '$' emargno
- { $$.expr_index = lookup(0,EX_ARG,$2,0); $$.expr_typ = argtyp(patmnem[$2]);
- }
- | NUMBER
- { $$.expr_index = lookup(0,EX_CON,(int)($1&0177777),(int)($1>>16));
- $$.expr_typ = TYPINT;
- }
- | STRING
- { $$.expr_index = lookup(0,EX_STRING,strlookup($1),0);
- $$.expr_typ = TYPSTR;
- }
- | RIDENT
- { $$.expr_index = lookup(0,EX_REG,$1->i_i.i_regno,0);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' tokargno '.' IDENT ']'
- { $$.expr_index = lookup(0,EX_TOKFIELD,$3,
- findstructel(pattokexp[$3],$5,&$$.expr_typ));
- }
- | '%' '[' tokargno subreg ']'
- { chkregexp(pattokexp[$3]);
- $$.expr_index = lookup(0,EX_SUBREG,$3,$4);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' LCASELETTER subreg ']'
- { if ($3 >= 'a'+nallreg)
- yyerror("Bad letter in %[x] construct");
- $$.expr_index = lookup(0,EX_ALLREG,$3-'a'+1,$4);
- $$.expr_typ = TYPREG;
- }
- | '%' '[' IDENT ']'
- { $$.expr_index = lookup(0,EX_TOKFIELD,0,
- findstructel(curtokexp,$3,&$$.expr_typ));
- }
- | TOSTRING '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_TOSTRING,exp1,0);
- $$.expr_typ = TYPSTR;
- }
- | DEFINED '(' expr ')'
- { $$.expr_index = lookup(0,EX_DEFINED,$3.expr_index,0);
- $$.expr_typ = TYPBOOL;
- }
- | SAMESIGN '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(1,EX_SAMESIGN,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | SFIT '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(0,EX_SFIT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | UFIT '(' expr ',' expr ')'
- { MUST2BEINT($3,$5);
- $$.expr_index = lookup(0,EX_UFIT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | ROM '(' emargno ',' NUMBER ')'
- { if ($5<1 || $5>3)
- yyerror("Second argument of rom must be >=1 and <=3");
- $$.expr_index = lookup(0,EX_ROM,$3-1,$5-1);
- $$.expr_typ = TYPINT;
- }
- | LOWW '(' emargno ')'
- {
- $$.expr_index = lookup(0,EX_LOWW,$3-1,0);
- $$.expr_typ = TYPINT;
- }
- | HIGHW '(' emargno ')'
- {
- $$.expr_index = lookup(0,EX_HIGHW,$3-1,0);
- $$.expr_typ = TYPINT;
- }
- | '(' expr ')'
- { $$ = $2; }
- | expr CMPEQ expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_NCPEQ,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(1,EX_SCPEQ,$1.expr_index,$3.expr_index);
- break;
- case TYPREG:
- $$.expr_index = lookup(1,EX_RCPEQ,$1.expr_index,$3.expr_index);
- break;
- }
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPNE expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_NCPNE,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(1,EX_SCPNE,$1.expr_index,$3.expr_index);
- break;
- case TYPREG:
- $$.expr_index = lookup(1,EX_RCPNE,$1.expr_index,$3.expr_index);
- break;
- }
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPGT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPGT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPGE expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPGE,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPLT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPLT,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr CMPLE expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_NCPLE,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr OR2 expr
- { MUST2BEBOOL($1,$3);
- $$.expr_index = lookup(0,EX_OR2,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr AND2 expr
- { MUST2BEBOOL($1,$3);
- $$.expr_index = lookup(0,EX_AND2,exp1,exp2);
- $$.expr_typ = TYPBOOL;
- }
- | expr '+' expr
- { switch(commontype($1,$3)) {
- case TYPINT:
- $$.expr_index = lookup(1,EX_PLUS,$1.expr_index,$3.expr_index);
- break;
- case TYPSTR:
- $$.expr_index = lookup(0,EX_CAT,$1.expr_index,$3.expr_index);
- break;
- default:
- yyerror("Bad types");
- }
- $$.expr_typ = $1.expr_typ;
- }
- | expr '-' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_MINUS,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '*' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(1,EX_TIMES,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '/' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_DIVIDE,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr '%' expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_MOD,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr LSHIFT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_LSHIFT,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | expr RSHIFT expr
- { MUST2BEINT($1,$3);
- $$.expr_index = lookup(0,EX_RSHIFT,exp1,exp2);
- $$.expr_typ = TYPINT;
- }
- | NOT expr
- { MUST1BEBOOL($2);
- $$.expr_index = lookup(0,EX_NOT,exp1,0);
- $$.expr_typ = TYPBOOL;
- }
- | COMP expr
- { MUST1BEINT($2);
- $$.expr_index = lookup(0,EX_COMP,exp1,0);
- $$.expr_typ = TYPINT;
- }
- | INREG '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_INREG,exp1,0);
- $$.expr_typ = TYPINT;
- }
- | REGVAR '(' expr ')'
- { MUST1BEINT($3);
- $$.expr_index = lookup(0,EX_REGVAR,exp1,0);
- $$.expr_typ = TYPREG;
- }
-/*
- | '-' expr %prec UMINUS
- { MUST1BEINT($2);
- $$.expr_index = lookup(0,EX_UMINUS,exp1,0);
- $$.expr_typ = TYPINT;
- }
-*/
- ;
-
-subreg : /* empty */
- { $$=0; }
- | '.' NUMBER
- { $$=$2; }
- ;
-
-optboolexpr
- : /* empty */
- { $$ = 0; }
- | expr
- { MUST1BEBOOL($1);
- $$=exp1;
- }
- ;
-optexpr
- : /* empty */
- { $$.expr_typ=0;
- $$.expr_index=0;
- }
- | expr
- ;
-
-tokeninstanceno
- : tokeninstance
- { $$ = instno($1); }
- ;
-
-tokeninstance
- : '%' '[' tokargno subreg ']'
- { register i;
-
- if ($4!=0)
- chkregexp(pattokexp[$3]);
- $$.in_which = IN_COPY;
- $$.in_info[0] = $3;
- $$.in_info[1] = $4;
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '%' '[' tokargno '.' IDENT ']'
- { int typ;
- register i;
- $$.in_which = IN_COPY;
- $$.in_info[0] = $3;
- $$.in_info[1] = findstructel(pattokexp[$3],$5,&typ);
- if (typ != TYPREG)
- yyerror("Must be register");
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | RIDENT
- { register i;
- $$.in_which = IN_RIDENT;
- $$.in_info[0] = $1->i_i.i_regno;
- for (i=1;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | REGVAR '(' expr ')'
- { register i;
- MUST1BEINT($3);
- $$.in_which = IN_REGVAR;
- $$.in_info[0] = exp1;
- for (i=1;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '%' '[' LCASELETTER subreg ']'
- { register i;
- if ($3 >= 'a'+nallreg)
- yyerror("Bad letter in %[x] construct");
- $$.in_which = IN_ALLOC;
- $$.in_info[0] = $3-'a';
- $$.in_info[1] = $4;
- for (i=2;i<TOKENSIZE;i++)
- $$.in_info[i] = 0;
- }
- | '{' TIDENT attlist '}'
- { register i;
- $$.in_which = IN_DESCR;
- $$.in_info[0] = $2->i_i.i_tokno;
- for(i=0;i<narexp;i++) {
- if (arexp[i].expr_typ !=
- machtokens[$2->i_i.i_tokno].t_fields[i].t_type)
- yyerror("Attribute %d has wrong type",i+1);
- $$.in_info[i+1] = arexp[i].expr_index;
- }
- for (i=narexp+1;i<TOKENSIZE;i++) {
- if (machtokens[$2->i_i.i_tokno].t_fields[i-1].t_type!=0)
- yyerror("Too few attributes");
- $$.in_info[i] = 0;
- }
- }
- ;
-
-attlist
- : /* empty */
- { narexp = 0; }
- | attlist ',' expr
- { arexp[narexp++] = $3; }
- ;
-
-%%
-
-char * myalloc(n) {
- register char *p;
-
- p= (char*) malloc(n);
- if (p==0) {
- yyerror("Out of core");
- exit(1);
- }
- return(p);
-}
-
-tstint(e) expr_t e; {
-
- if(e.expr_typ != TYPINT)
- yyerror("Must be integer expression");
-}
-
-tstbool(e) expr_t e; {
-
- if(e.expr_typ != TYPBOOL)
- yyerror("Must be boolean expression");
-}
-
-structsize(s) register list2 s; {
- register list1 l;
- register sum;
-
- sum = 0;
- while ( s != 0 ) {
- l = s->l2list->l1next;
- while ( l != 0 ) {
- sum++;
- l = l->l1next;
- }
- s = s->l2next;
- }
- return(sum);
-}
-
-list2 lookstruct(ll) list2 ll; {
- list3 l3;
- list2 l21,l22;
- list1 l11,l12;
-
- for (l3=structpool;l3 != 0;l3=l3->l3next) {
- for (l21=l3->l3list,l22=ll;l21!=0 && l22!=0;
- l21=l21->l2next,l22=l22->l2next) {
- for(l11=l21->l2list,l12=l22->l2list;
- l11!=0 && l12!=0 && strcmp(l11->l1name,l12->l1name)==0;
- l11=l11->l1next,l12=l12->l1next)
- ;
- if (l11!=0 || l12!=0)
- goto contin;
- }
- if(l21==0 && l22==0)
- return(l3->l3list);
- contin:;
- }
- l3 = (list3) myalloc(sizeof(struct list3str));
- l3->l3next=structpool;
- l3->l3list=ll;
- structpool=l3;
- return(ll);
-}
-
-instno(inst) inst_t inst; {
- register i,j;
-
- for(i=1;i<narinstance;i++) {
- if (arinstance[i].in_which != inst.in_which)
- continue;
- for(j=0;j<TOKENSIZE;j++)
- if(arinstance[i].in_info[j] != inst.in_info[j])
- goto cont;
- return(i);
- cont:;
- }
- chktabsiz(narinstance,MAXINSTANCE,"Instance table");
- arinstance[narinstance] = inst;
- return(narinstance++);
-}
-
-string scopy(s) string s; {
- register string t;
-
- t = (char *) myalloc(strlen(s)+1);
- strcpy(t,s);
- return(t);
-}
-
-strlookup(s) string s; {
- register i;
-
- for(i=0;i<ncodestrings;i++)
- if(strcmp(s,codestrings[i])==0)
- return(i);
- chktabsiz(ncodestrings,MAXSTRINGS,"string table");
- codestrings[ncodestrings] = scopy(s);
- return(ncodestrings++);
-}
-
-stringno(s) register string s; {
- char buf[256];
- register char *p=buf;
-
- while(*s != 0) switch(*s) {
- default:
- *p++ = *s++;
- continue;
- case '$':
- s++;
- switch(*s) {
- default:
- yyerror("Bad character after $ in codestring");
- case '$':
- *p++ = *s++;
- continue;
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- *p++ = argtyp(patmnem[*s-'0']) == TYPINT ?
- PR_EMINT : PR_EMSTR;
- *p++ = *s++ -'0';
- continue;
- }
- case '%':
- s++;
- if (*s != '[') {
- if(*s == '%') {
- *p++ = *s++;
- continue;
- } else
- yyerror("Bad character following %% in codestring");
- } else
- s++;
- if(isdigit(*s)) {
- int num;
- num = *s++ - '0';
- if (num<1 || num>tokpatlen)
- yyerror("Number within %[] out of range");
- if (*s == ']') {
- s++;
- *p++ = PR_TOK;
- *p++ = num;
- } else if (*s++ != '.')
- yyerror("Bad character following %%[digit in codestring");
- else {
- char field[256];
- register char *f=field;
- int type,offset;
-
- while( *s != ']' && *s != 0)
- *f++ = *s++;
- *f++ = 0;
- if (*s != ']')
- yyerror("Unterminated %[] construction in codestring");
- else
- s++;
- if (isdigit(field[0])) {
- chkregexp(pattokexp[num]);
- *p++ = PR_SUBREG;
- *p++ = num;
- *p++ = atoi(field);
- } else {
- offset = findstructel(pattokexp[num],field,&type);
- *p++ = PR_TOKFLD;
- *p++ = num;
- *p++ = offset;
- }
- }
- } else if (*s >= 'a' && *s < 'a'+nallreg) {
- int reg,subreg;
- reg = *s++ -'a'+1;
- if(*s == ']')
- subreg = 255;
- else {
- if (*s != '.')
- yyerror("Bad character following %%[x in codestring");
- s++;
- if(!isdigit(*s))
- yyerror("Bad character following %%[x. in codestring");
- subreg = *s - '0';
- s++;
- if(*s != ']')
- yyerror("Bad character following %%[x.y in codestring");
- }
- s++;
- *p++ = PR_ALLREG;
- *p++ = reg;
- *p++ = subreg;
- } else
- yyerror("Bad character following %%[ in codestring");
- }
- *p++ = 0;
- return(strlookup(buf));
-}
-
-tabovf(tablename) string tablename; {
- char buf[256];
-
- sprintf(buf,"%s overflow",tablename);
- yyerror(buf);
- exit(-1);
-}
-
-main(argc,argv) char *argv[]; {
-
- if (argc!=1) {
- fprintf(stderr,"%s is a filter, don't use arguments\n",argv[0]);
- exit(-1);
- }
- inithash();
- initio();
- inittables();
- yyparse();
- if (nerrors==0) {
- compueq();
- hashpatterns();
- finishio();
- verbose();
- }
- debug();
- exit(nerrors);
-}
-
-lookup(comm,operator,lnode,rnode) {
- register node_p p;
-
- for (p=nodes+1;p<lastnode;p++) {
- if (p->ex_operator != operator)
- continue;
- if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
- comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
- continue;
- return(p-nodes);
- }
- if (lastnode >= &nodes[MAXNODES])
- yyerror("node table overflow");
- lastnode++;
- p->ex_operator = operator;
- p->ex_lnode = lnode;
- p->ex_rnode = rnode;
- return(p-nodes);
-}
-
-compueq() {
- register i,j;
-
- for (i=1;i<nmachregs;i++) {
- for (j=1;j<i;j++)
- if (eqregclass(i,j)) {
- stregclass[i] = stregclass[j];
- break;
- }
- if (j==i)
- stregclass[i] = nregclasses++;
- }
-}
-
-eqregclass(r1,r2) {
- register reginfo rp1,rp2;
- register i;
- short regbits[(MAXREGS+15)>>4];
- int member;
-
- rp1 = machregs[r1]; rp2 = machregs[r2];
- for (i=0;i<((nprops+15)>>4);i++)
- if (rp1->rprop[i] != rp2->rprop[i])
- return(0);
- for (i=0;i<((MAXREGS+15)>>4);i++)
- regbits[i] = 0;
- for (i=0;i<maxmembers;i++) {
- if (member = rp1->rmembers[i])
- regbits[member>>4] |= (1<<(member&017));
- }
- for (i=0;i<maxmembers;i++) {
- member = rp2->rmembers[i];
- if (regbits[member>>4]&(1<<(member&017)))
- return(0);
- }
- return(1);
-}
-
-unsigned hash(name) register string name; {
- register unsigned sum;
- register i;
-
- for (sum=i=0;*name;i+=3)
- sum ^= (*name++)<<(i&07);
- return(sum);
-}
-
-ident_p ilookup(name,enterf) string name; int enterf; {
- register ident_p p,*pp;
-
- pp = &identtab[hash(name)%ITABSIZE];
- while (*pp != 0) {
- if (strcmp((*pp)->i_name,name)==0)
- if (enterf != ENTER)
- return(*pp);
- else
- yyerror("Multiply defined symbol");
- pp = &(*pp)->i_next;
- }
- if (enterf == LOOKUP)
- yyerror("Undefined symbol");
- if (enterf == JUSTLOOKING)
- return(0);
- p = *pp = (ident_p) myalloc(sizeof(ident_t));
- p->i_name = name;
- p->i_next = 0;
- p->i_type = 0;
- return(p);
-}
-
-initio() {
-
- if ((cfile=fopen("tables.c","w"))==NULL) {
- fprintf(stderr,"Can't create tables.c\n");
- exit(-1);
- }
- if ((hfile=fopen("tables.h","w"))==NULL) {
- fprintf(stderr,"Can't create tables.h\n");
- exit(-1);
- }
- fprintf(cfile,"#include \"param.h\"\n");
- fprintf(cfile,"#include \"tables.h\"\n");
- fprintf(cfile,"#include \"types.h\"\n");
- fprintf(cfile,"#include <cg_pattern.h>\n");
- fprintf(cfile,"#include \"data.h\"\n");
- fprintf(cfile,"\nbyte coderules[] = {\n");
- patbyte(0);
-}
-
-exprlookup(sett) set_t sett; {
- register i,j,ok;
-
- for(i=0;i<nmachsets;i++) {
- ok= (sett.set_size == machsets[i].set_size);
- for(j=0;j<SETSIZE;j++) {
- if (sett.set_val[j] == machsets[i].set_val[j])
- continue;
- ok=0;
- break;
- }
- if (ok)
- return(i);
- }
- chktabsiz(nmachsets,MAXSETS,"Expression table");
- machsets[nmachsets] = sett;
- return(nmachsets++);
-}
-
-inittables() {
- register reginfo r;
- register i;
- inst_t inst;
- set_t sett;
-
- nodes[0].ex_operator=EX_CON;
- nodes[0].ex_lnode=0;
- nodes[0].ex_rnode=0;
- cocopropno=nprops++;
- r=(reginfo)myalloc(sizeof(struct reginfo));
- r->rname = "cc reg";
- r->rrepr = "CC";
- r->rsize = -1;
- r->rregvar= -1;
- for(i=0;i<MAXMEMBERS;i++)
- r->rmembers[i] = 0;
- for(i=0;i<PROPSETSIZE;i++)
- r->rprop[i] = 0;
- r->rprop[cocopropno>>4] |= (1<<(cocopropno&017));
- chktabsiz(nmachregs,MAXREGS,"Register table");
- machregs[nmachregs++] = r;
- inst.in_which = IN_RIDENT;
- inst.in_info[0] = nmachregs-1;
- for(i=1;i<TOKENSIZE;i++)
- inst.in_info[i]=0;
- ccinstanceno=instno(inst);
- ccregexpr=lookup(0,EX_REG,nmachregs-1,0);
- sett.set_size=0;
- for (i=0;i<SETSIZE;i++)
- sett.set_val[i]=0;
- sett.set_val[nmachregs>>4] |= (01<<(nmachregs&017));
- cocosetno=exprlookup(sett);
-}
-
-outregs() {
- register i,j,k;
- static short rset[(MAXREGS+15)>>4];
- int t,ready;
-
- fprintf(cfile,"char stregclass[] = {\n");
- for (i=0;i<nmachregs;i++)
- fprintf(cfile,"\t%d,\n",stregclass[i]);
- fprintf(cfile,"};\n\nstruct reginfo machregs[] = {\n{0},\n");
- for (i=1;i<nmachregs;i++) {
- fprintf(cfile,"{%d,%d",strlookup(machregs[i]->rrepr),
- machregs[i]->rsize);
- if (maxmembers!=0) {
- fprintf(cfile,",{");
- for(j=0;j<maxmembers;j++)
- fprintf(cfile,"%d,",machregs[i]->rmembers[j]);
- /* now compute and print set of registers
- * that clashes with this register.
- * A register clashes with al its children (and theirs)
- * and with all their parents.
- */
- for (j=0;j<((MAXREGS+15)>>4);j++)
- rset[j]=0;
- rset[i>>4] |= (1<<(i&017));
- do {
- ready=1;
- for (j=1;j<nmachregs;j++)
- if (rset[j>>4]&(1<<(j&017)))
- for (k=0;k<maxmembers;k++)
- if ((t=machregs[j]->rmembers[k])!=0) {
- if ((rset[t>>4]&(1<<(t&017)))==0)
- ready=0;
- rset[t>>4] |= (1<<(t&017));
- }
- } while (!ready);
- do {
- ready=1;
- for (j=1;j<nmachregs;j++)
- for (k=0;k<maxmembers;k++)
- if ((t=machregs[j]->rmembers[k])!=0)
- if (rset[t>>4]&(1<<(t&017))) {
- if (rset[j>>4]&(1<<(j&017))==0)
- ready=0;
- rset[j>>4] |= (1<<(j&017));
- }
- } while (!ready);
- fprintf(cfile,"},{");
- for (j=0;j<((nmachregs+15)>>4);j++)
- fprintf(cfile,"%d,",rset[j]);
- fprintf(cfile,"}");
- }
- if (machregs[i]->rregvar>=0)
- fprintf(cfile,",1");
- fprintf(cfile,"},\n");
- }
- fprintf(cfile,"};\n\n");
-}
-
-finishio() {
- register i;
- register node_p np;
- int j;
- int setsize;
- register move_p mp;
-
- fprintf(cfile,"};\n\n");
- if (wsize>0)
- fprintf(hfile,"#define EM_WSIZE %d\n",wsize);
- else
- yyerror("Wordsize undefined");
- if (psize>0)
- fprintf(hfile,"#define EM_PSIZE %d\n",psize);
- else
- yyerror("Pointersize undefined");
- if (bsize>=0)
- fprintf(hfile,"#define EM_BSIZE %d\n",bsize);
- else
- fprintf(hfile,"extern int EM_BSIZE;\n");
- if (fmt!=0)
- fprintf(hfile,"#define WRD_FMT \"%s\"\n",fmt);
- fprintf(hfile,"#define MAXALLREG %d\n",maxallreg);
- setsize = (nmachregs+1 + nmachtokens + 15)>>4;
- fprintf(hfile,"#define SETSIZE %d\n",setsize);
- fprintf(hfile,"#define NPROPS %d\n",nprops);
- fprintf(hfile,"#define NREGS %d\n",nmachregs);
- fprintf(hfile,"#define REGSETSIZE %d\n",(nmachregs+15)>>4);
- fprintf(hfile,"#define TOKENSIZE %d\n",maxtokensize);
- fprintf(hfile,"#define MAXMEMBERS %d\n",maxmembers);
- fprintf(hfile,"#define LONGESTPATTERN %d\n",maxempatlen);
- fprintf(hfile,"#define MAXRULE %d\n",maxrule);
- fprintf(hfile,"#define NMOVES %d\n",nmoves);
- fprintf(hfile,"#define NC1 %d\n",nc1);
- if (nc2) {
- assert(maxsplit!=0);
- fprintf(hfile,"#define NC2 %d\n",nc2);
- fprintf(hfile,"#define MAXSPLIT %d\n",maxsplit);
- }
- fprintf(hfile,"#define NC3 %d\n",nc3);
- outregs();
- fprintf(cfile,"tkdef_t tokens[] = {\n");
- for(i=0;i<nmachtokens;i++) {
- fprintf(cfile,"{%d,{%d,%d},{",machtokens[i].t_size,
- machtokens[i].t_cost.c_size,
- machtokens[i].t_cost.c_time);
- for(j=0;j<maxtokensize;j++)
- fprintf(cfile,"%d,",machtokens[i].t_fields[j].t_type);
- fprintf(cfile,"},%d},\n",machtokens[i].t_format);
- }
- fprintf(cfile,"};\n\nnode_t enodes[] = {\n");
- for(np=nodes;np<lastnode;np++)
- fprintf(cfile,"{%d,%d,%d},\n",np->ex_operator,np->ex_lnode,
- np->ex_rnode);
- fprintf(cfile,"};\n\nstring codestrings[] = {\n");
- for(i=0;i<ncodestrings;i++) {
- register char *p;
- p=codestrings[i];
- fprintf(cfile,"\t\"");
- while (*p) {
- fprintf(cfile, !isascii(*p) || iscntrl(*p) ? "\\%03o" : "%c", (*p)&BMASK);
- p++;
- }
- fprintf(cfile,"\",\n");
- }
- fprintf(cfile,"};\n\nset_t machsets[] = {\n");
- for(i=0;i<nmachsets;i++) {
- fprintf(cfile,"{%d,{",machsets[i].set_size);
- for(j=0;j<setsize;j++)
- fprintf(cfile,"0%o,",machsets[i].set_val[j]);
- fprintf(cfile,"}},\n");
- }
- fprintf(cfile,"};\n\ninst_t tokeninstances[] = {\n");
- for(i=0;i<narinstance;i++) {
- fprintf(cfile,"{ %d, {",arinstance[i].in_which);
- for(j=0;j<=maxtokensize;j++)
- fprintf(cfile,"%d,",arinstance[i].in_info[j]);
- fprintf(cfile,"}},\n");
- }
- fprintf(cfile,"};\n\nmove_t moves[] = {\n");
- for (i=0;i<nmoves;i++) {
- mp = &machmoves[i];
- fprintf(cfile,"{%d,%d,%d,%d,%d,{%d,%d}},\n",
- mp->m_set1, mp->m_expr1,
- mp->m_set2, mp->m_expr2,
- mp->m_cindex,
- mp->m_cost.c_size,mp->m_cost.c_time);
- }
- fprintf(cfile,"};\n\nbyte pattern[] = {\n");
- for (i=0;i<npatbytes;i++) {
- fprintf(cfile,"%3d,",pattern[i]&BMASK);
- if ((i%10)==9)
- fprintf(cfile,"\n");
- }
- fprintf(cfile,"\n};\n\nint pathash[256] = {\n");
- for(i=0;i<256;i++) {
- fprintf(cfile,"%6d,",pathash[i]);
- if((i&07)==07)
- fprintf(cfile,"\n");
- }
- fprintf(cfile,"};\n\nc1_t c1coercs[] = {\n");
- for (i=0;i<nc1;i++)
- fprintf(cfile,"{%d,%d,%d,%d,{%d,%d}},\n",
- c1coercs[i].c1_texpno,
- c1coercs[i].c1_expr,
- c1coercs[i].c1_prop,
- c1coercs[i].c1_codep,
- c1coercs[i].c1_cost.c_size,
- c1coercs[i].c1_cost.c_time);
- if (nc2)
- fprintf(cfile,"};\n\nc2_t c2coercs[] = {\n");
- for (i=0;i<nc2;i++) {
- fprintf(cfile,"{%d,%d,{",
- c2coercs[i].c2_texpno,
- c2coercs[i].c2_nsplit);
- for (j=0;j<maxsplit;j++)
- fprintf(cfile,"%d,",c2coercs[i].c2_repl[j]);
- fprintf(cfile,"},%d},\n",c2coercs[i].c2_codep);
- }
- fprintf(cfile,"};\n\nc3_t c3coercs[] = {\n");
- for (i=0;i<nc3;i++)
- fprintf(cfile,"{%d,%d,%d,%d},\n",
- c3coercs[i].c3_texpno,
- c3coercs[i].c3_prop,
- c3coercs[i].c3_repl,
- c3coercs[i].c3_codep);
- fprintf(cfile,"};\n\n");
- for (i=0;i<nprops;i++) {
- fprintf(cfile,"struct reginfo *rlist%02d[] = {\n",i);
- for (j=2;j<=nmachregs;j++) {
- if (machregs[j-1]->rregvar<0 &&
- (machprops[i].propset.set_val[j>>4]&(1<<(j&017))))
- fprintf(cfile,"\t&machregs[%d],\n",j-1);
- }
- fprintf(cfile,"\t0\n};\n");
- }
- fprintf(cfile,"struct reginfo **reglist[] = {\n");
- for (i=0;i<nprops;i++) {
- fprintf(cfile,"\trlist%02d,\n",i);
- }
- fprintf(cfile,"};\n");
- fprintf(cfile,"unsigned cc1 = %u;\n",cc1);
- fprintf(cfile,"unsigned cc2 = %u;\n",cc2);
- fprintf(cfile,"unsigned cc3 = %u;\n",cc3);
- fprintf(cfile,"unsigned cc4 = %u;\n",cc4);
- if (rvused)
- outregvar();
-}
-
-outregvar() {
- register i,j;
-
- fprintf(hfile,"#define REGVARS\n");
- fprintf(cfile,"#include \"regvar.h\"\n");
- fprintf(cfile,"int nregvar[4] = { ");
- for (i=0;i<4;i++) fprintf(cfile,"%d, ",nregvar[i]);
- fprintf(cfile,"};\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"struct regassigned ratar%d[%d];\n",
- i,nregvar[i]);
- for (i=0;i<4;i++) if (nregvar[i]>0) {
- fprintf(cfile,"int rvtar%d[] = {",i);
- for (j=0;j<nregvar[i];j++)
- fprintf(cfile,"%d,",rvnumbers[i][j]);
- fprintf(cfile,"};\n");
- }
- fprintf(cfile,"\nint *rvnumbers[] = {\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"\trvtar%d,\n",i);
- else
- fprintf(cfile,"\t0,\n");
- fprintf(cfile,"};\n\nstruct regassigned *regassigned[] = {\n");
- for (i=0;i<4;i++)
- if (nregvar[i]>0)
- fprintf(cfile,"\tratar%d,\n",i);
- else
- fprintf(cfile,"\t0,\n");
- fprintf(cfile,"};\n");
-}
-
-verbose() {
-
- fprintf(stderr,"Codebytes %d\n",codebytes);
- fprintf(stderr,"Registers %d(%d)\n",nmachregs,MAXREGS);
- fprintf(stderr,"Properties %d(%d)\n",nprops,MAXPROPS);
- fprintf(stderr,"Tokens %d(%d)\n",nmachtokens,MAXTOKENS);
- fprintf(stderr,"Sets %d(%d)\n",nmachsets,MAXSETS);
- fprintf(stderr,"Tokeninstances %d(%d)\n",narinstance,MAXINSTANCE);
- fprintf(stderr,"Strings %d(%d)\n",ncodestrings,MAXSTRINGS);
- fprintf(stderr,"Enodes %d(%d)\n",lastnode-nodes,MAXNODES);
- fprintf(stderr,"Patbytes %d(%d)\n",npatbytes,MAXPATTERN);
-}
-
-inbetween() {
- register ident_p ip;
- register i,j;
- register move_p mp;
-
- lookident=1; /* for lexical analysis */
-
- chktabsiz(nmachsets+1,MAXSETS,"Expressiontable");
- for (i=0;i<SETSIZE;i++)
- machsets[nmachsets].set_val[i] = 0xFFFF;
- machsets[nmachsets].set_val[0] &= ~1;
- machsets[nmachsets].set_size = 0;
- ip=ilookup("SCRATCH",ENTER);
- ip->i_type=IEXP;
- ip->i_i.i_expno = nmachsets++;
-
- for (i=0;i<SETSIZE;i++)
- machsets[nmachsets].set_val[i] = 0xFFFF;
- machsets[nmachsets].set_size = 0;
- ip=ilookup("ALL",ENTER);
- ip->i_type=IEXP;
- allexpno = ip->i_i.i_expno = nmachsets++;
- mp = &machmoves[nmoves++];
- mp->m_set1 = cocosetno;
- mp->m_expr1 = 0;
- mp->m_set2 = nmachsets-1;
- mp->m_expr2 = 0;
- mp->m_cindex = 0;
- mp->m_cost.c_size = 0;
- mp->m_cost.c_time = 0;
-
- /*
- * Create sets of registers per property
- */
-
- for (i=0;i<nprops;i++) {
- short *sp = machprops[i].propset.set_val;
-
- sp[0] |= 1;
- for (j=2;j<=nmachregs;j++)
- if (machregs[j-1]->rprop[i>>4]&(1<<(i&017)))
- sp[j>>4] |= (1<<(j&017));
- }
-}
-
-formconversion(p,tp) register char *p; register token_p tp; {
- char buf[256];
- register char *q=buf;
- char field[256];
- register char *f;
- int i;
-
- if (p==0)
- return(0);
- while (*p) switch(*p) {
- default: *q++ = *p++; continue;
- case '%':
- p++;
- if(*p == '%') {
- *q++ = *p++;
- continue;
- }
- if (*p == '[')
- p++;
- else
- yyerror("Bad character after % in format");
- f=field;
- while (*p != 0 && *p != ']')
- *f++ = *p++;
- *f++ = 0;
- if (*p == ']')
- p++;
- else
- yyerror("Unterminated %[] construct in format");
- for (i=0;i<TOKENSIZE-1;i++)
- if (strcmp(field,tp->t_fields[i].t_sname)==0)
- break;
- if (i==TOKENSIZE-1)
- yyerror("Unknown field in %[] construct in format");
- *q++ = i+1;
- }
- *q++ = 0;
- return(strlookup(buf));
-}
-
-setfields(tp,format) register token_p tp; string format; {
- register i;
- list2 ll;
- register list1 l;
- int type;
-
- for(i=0;i<TOKENSIZE-1;i++)
- tp->t_fields[i].t_type = 0;
- i=0;
- for(ll=tp->t_struct;ll!=0;ll=ll->l2next) {
- l=ll->l2list;
- if(strcmp(l->l1name,"REGISTER")==0)
- type = TYPREG;
- else if (strcmp(l->l1name,"INT")==0)
- type = TYPINT;
- else type = TYPSTR;
- for(l=l->l1next;l!=0;l=l->l1next) {
- tp->t_fields[i].t_type = type;
- tp->t_fields[i].t_sname = l->l1name;
- i++;
- }
- }
- if (format != 0)
- tp->t_format = formconversion(format,tp);
- else
- tp->t_format = -1;
-}
-
-chkregexp(number) {
- register i;
-
- for(i=nmachregs+1;i<nmachregs+1+nmachtokens;i++)
- if(machsets[number].set_val[i>>4]&(01<<(i&017)))
- yyerror("No tokens allowed in this set");
-}
-
-findstructel(number,name,t) string name; int *t; {
- register i;
- register token_p tp;
- register list2 structdecl;
- int offset;
-
- for(i=1;i<=nmachregs;i++)
- if (machsets[number].set_val[i>>4]&(01<<(i&017)))
- yyerror("No registers allowed in this set");
- structdecl = 0;
- for (i=nmachregs+1;i<nmachregs+1+nmachtokens;i++) {
- if (machsets[number].set_val[i>>4]&(01<<(i&017))) {
- if (structdecl == 0) {
- structdecl = machtokens[i-(nmachregs+1)].t_struct;
- tp = &machtokens[i-(nmachregs+1)];
- } else if(structdecl != machtokens[i-(nmachregs+1)].t_struct)
- yyerror("Multiple structs in this set");
- }
- }
- if (structdecl == 0) {
- yyerror("No structs in this set");
- return(0);
- }
- for(offset=0;offset<TOKENSIZE-1;offset++)
- if(tp->t_fields[offset].t_type != 0 &&
- strcmp(tp->t_fields[offset].t_sname,name)==0) {
- *t = tp->t_fields[offset].t_type;
- return(offset+1);
- }
- yyerror("No such field in this struct");
- return(0);
-}
-
-extern char em_flag[];
-
-argtyp(mn) {
-
- switch(em_flag[mn-sp_fmnem]&EM_PAR) {
- case PAR_W:
- case PAR_S:
- case PAR_Z:
- case PAR_O:
- case PAR_N:
- case PAR_L:
- case PAR_F:
- case PAR_R:
- case PAR_C:
- return(TYPINT);
- default:
- return(TYPSTR);
- }
-}
-
-commontype(e1,e2) expr_t e1,e2; {
-
- if(e1.expr_typ != e2.expr_typ)
- yyerror("Type incompatibility");
- return(e1.expr_typ);
-}
-
-extern char em_mnem[][4];
-
-#define HASHSIZE (2*(sp_lmnem-sp_fmnem))
-
-struct hashmnem {
- char h_name[3];
- byte h_value;
-} hashmnem[HASHSIZE];
-
-inithash() {
- register i;
-
- for(i=0;i<=sp_lmnem-sp_fmnem;i++)
- enter(em_mnem[i],i+sp_fmnem);
-}
-
-enter(name,value) char *name; {
- register unsigned h;
-
- h=hash(name)%HASHSIZE;
- while (hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- strncpy(hashmnem[h].h_name,name,3);
- hashmnem[h].h_value = value;
-}
-
-int mlookup(name) char *name; {
- register unsigned h;
-
- h = hash(name)%HASHSIZE;
- while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
- hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- return(hashmnem[h].h_value&BMASK); /* 0 if not found */
-}
-
-hashpatterns() {
- short index;
- register byte *bp,*tp;
- register short i;
- unsigned short hashvalue;
- int patlen;
-
- index = prevind;
- while (index != 0) {
- bp = &pattern[index];
- tp = &bp[PO_MATCH];
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<BSHIFT;
- }
- patlen = i;
- hashvalue = 0;
- switch(patlen) {
- default: /* 3 or more */
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 2:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 1:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- }
- assert(hashvalue!= ILLHASH);
- i=index;
- index = (bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<BSHIFT);
- bp[PO_HASH] = hashvalue>>BSHIFT;
- hashvalue &= BMASK;
- bp[PO_NEXT] = pathash[hashvalue]&BMASK;
- bp[PO_NEXT+1] = pathash[hashvalue]>>BSHIFT;
- pathash[hashvalue] = i;
- }
-}
-
-debug() {
- register i,j;
-
- for(i=0;i<ITABSIZE;i++) {
- register ident_p ip;
- for(ip=identtab[i];ip!=0;ip=ip->i_next)
- printf("%-14s %1d %3d\n",ip->i_name,
- ip->i_type,ip->i_i.i_regno);
- }
-
- for(i=2;i<nmachregs;i++) {
- register reginfo rp;
-
- rp=machregs[i];
- printf("%s = (\"%s\", %d",rp->rname,rp->rrepr,rp->rsize);
- for(j=0;j<MAXMEMBERS;j++)
- if(rp->rmembers[j] != 0)
- printf(", %s",machregs[rp->rmembers[j]]->rname);
- printf(")");
- for(j=0;j<nprops;j++)
- if(rp->rprop[j>>4]&(1<<(j&017)))
- printf(", %s",machprops[j].propname->i_name);
- printf(".\n");
- }
-}
-
-out(n) {
-
- assert(n>=0);
- if (n<128)
- outbyte(n);
- else {
- outbyte(n/256+128);
- outbyte(n%256);
- }
-}
-
-outbyte(n) {
-
- fprintf(cfile,"%d, ",n&BMASK);
- codebytes++;
-}
-
-pat(n) {
-
- assert(n>=0);
- if (n<128)
- patbyte(n);
- else {
- patbyte(n/256+128);
- patbyte(n%256);
- }
-}
-
-patshort(n) {
-
- patbyte(n&BMASK);
- patbyte(n>>BSHIFT);
-}
-
-patbyte(n) {
-
- chktabsiz(npatbytes,MAXPATTERN,"Pattern table");
- pattern[npatbytes++] = n;
-}
-
-max(a,b) {
-
- if (a>b)
- return(a);
- return(b);
-}
-
-#include "bootlex.c"
+++ /dev/null
-%{
-
-#ifndef NORCSID
-static char rcsid2[]="$Header$";
-#endif
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#undef input
-#undef output
-#undef unput
-
-#define MAXBACKUP 50
-%}
-%%
-"/*" { char c;
- c = input();
- do {
- while (c!='*')
- c = input();
- c = input();
- } while (c!='/');
- }
-"REGISTERS:" return(REGISTERHEAD);
-"TOKENS:" return(TOKENHEAD);
-"TOKENEXPRESSIONS:" return(EXPRESSIONHEAD);
-"CODE:" return(CODEHEAD);
-"MOVES:" return(MOVEHEAD);
-"TESTS:" return(TESTHEAD);
-"STACKS:" return(STACKHEAD);
-"SIZEFACTOR" return(SIZEFAC);
-"TIMEFACTOR" return(TIMEFAC);
-"FORMAT" return(FORMAT);
-
-"cost" return(COST);
-"remove" return(REMOVE);
-"|" return(SEP);
-"samesign" return(SAMESIGN);
-"inreg" return(INREG);
-"sfit" return(SFIT);
-"ufit" return(UFIT);
-"defined" return(DEFINED);
-"rom" return(ROM);
-"loww" return(LOWW);
-"highw" return(HIGHW);
-"move" return(MOVE);
-"erase" return(ERASE);
-"allocate" return(ALLOCATE);
-"tostring" return(TOSTRING);
-"nocc" return(NOCC);
-"setcc" return(SETCC);
-"samecc" return(SAMECC);
-"test" return(TEST);
-"STACK" return(STACK);
-"nocoercions" return(NOCOERC);
-
-"&&" return(AND2);
-"||" return(OR2);
-"==" return(CMPEQ);
-"!=" return(CMPNE);
-"<=" return(CMPLE);
-"<" return(CMPLT);
-">" return(CMPGT);
-">=" return(CMPGE);
-">>" return(RSHIFT);
-"<<" return(LSHIFT);
-"!" return(NOT);
-"~" return(COMP);
-"..." return(ELLIPS);
-
-EM_WSIZE { yylval.yy_intp = &wsize; return(CIDENT); }
-EM_PSIZE { yylval.yy_intp = &psize; return(CIDENT); }
-EM_BSIZE { yylval.yy_intp = &bsize; return(CIDENT); }
-REGISTER { yylval.yy_string = "REGISTER"; return(TYPENAME); }
-INT { yylval.yy_string = "INT"; return(TYPENAME); }
-STRING { yylval.yy_string = "STRING"; return(TYPENAME); }
-
-regvar return(REGVAR);
-loop return(LOOP);
-pointer return(POINTER);
-float return(FLOAT);
-return return(RETURN);
-
-[_A-Za-z][_A-Za-z0-9]+ {register ident_p ip;
- if(!lookident || (ip=ilookup(yytext,JUSTLOOKING))==0) {
- yylval.yy_string = scopy(yytext);return(IDENT);
- } else {
- yylval.yy_ident = ip;
- switch(ip->i_type) {
- default:assert(0);
- case IREG:return(RIDENT);
- case IPRP:return(PIDENT);
- case ITOK:return(TIDENT);
- case IEXP:return(EIDENT);
- }
- }
- }
-[a-z] {yylval.yy_char = yytext[0]; return(LCASELETTER);}
-[0-9]* {yylval.yy_int = atoi(yytext);return(NUMBER);}
-(\"|"%)") { char *p; int c,tipe;
- p=yytext;
- for (;;) {
- c = input();
- switch(c) {
- default: *p++=c;break;
- case '\\':
- *p++=c; *p++=input(); break;
- case '\n':
- yyerror("Unterminated string");
- break;
- case '"':
- tipe=STRING; goto endstr;
- case '%':
- c=input();
- if (c == '(') {
- tipe=LSTRING;goto endstr;
- } else {
- *p++ = '%'; unput(c); break;
- }
- }
- }
- endstr:
- *p++ = 0;
- yylval.yy_string = scopy(yytext);
- return(tipe);
- }
-[ \t]* |
-\n ;
-. return(yytext[0]);
-%%
-
-char linebuf[256];
-char prevbuf[256];
-int linep;
-int linepos; /* corrected for tabs */
-char charstack[MAXBACKUP];
-int nbackup=0;
-
-output(c) {
-
- assert(0);
-}
-
-input() {
-
- if(nbackup)
- return(charstack[--nbackup]);
- if(linebuf[linep]==0) {
- strcpy(prevbuf,linebuf);
- if(fgets(linebuf,256,stdin)==NULL)
- return(0);
- lino++;
- linepos=linep=0;
- }
- if (linebuf[linep] == '\t')
- linepos = (linepos+8) & ~07;
- else linepos++;
- return(linebuf[linep++]);
-}
-
-unput(c) {
-
- chktabsiz(nbackup,MAXBACKUP,"Lexical backup table");
- charstack[nbackup++] = c;
-}
-
-yyerror(s,a1,a2,a3,a4) string s; {
-
- fprintf(stderr,"%d\t%s%d\t%s\t%*c ",lino-1,prevbuf,lino,linebuf,
- linepos-1,'^');
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- nerrors++;
-}
+++ /dev/null
-# $Header$
-
-d=../..
-h=$d/h
-l=$d/lib
-
-DEC_PATH=decode
-ENC_PATH=encode
-DATA_PATH=$l/em_data.a
-
-CFLAGS=-O -I$h
-
-all: $(DEC_PATH) $(ENC_PATH)
-
-$(DEC_PATH): decode.o $(DATA_PATH)
- cc -n -o $(DEC_PATH) decode.o $(DATA_PATH)
-
-$(ENC_PATH): encode.o $(DATA_PATH)
- cc -n -o $(ENC_PATH) encode.o $(DATA_PATH)
-
-encode.o: $h/em_spec.h $h/em_pseu.h $h/em_flag.h $h/em_ptyp.h $h/em_mes.h
-
-decode.o: $h/em_spec.h $h/em_pseu.h $h/em_flag.h $h/em_ptyp.h $h/em_mes.h
-
-clean:
- rm -f $(DEC_PATH) $(ENC_PATH) *.o *.old
-install : all
- cp $(DEC_PATH) $l/em_$(DEC_PATH)
- cp $(ENC_PATH) $l/em_$(ENC_PATH)
-
-cmp : all
- cmp $(DEC_PATH) $l/$(DEC_PATH)
- cmp $(ENC_PATH) $l/$(ENC_PATH)
-
-opr:
- make pr ^ opr
-pr:
- @pr -n Makefile decode.c encode.c
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-/*
- * Decode compact EM assembly language
- *
- * Author: Johan Stevenson, Vrije Universiteit, Amsterdam
- */
-
-#include <stdio.h>
-#include <assert.h>
-#include <ctype.h>
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_flag.h>
-#include <em_ptyp.h>
-#include <em_mes.h>
-
-#define get8() ((unsigned)getchar())
-
-#define check(x) if (!(x)) fail_check()
-
-#define MAXSTR 256
-
-/*
- * global variables
- */
-
-int opcode;
-int offtyp;
-long argval;
-int dlbval;
-char string[MAXSTR];
-int strsiz;
-
-int wsize;
-int psize;
-int lineno;
-int argnum;
-int errors;
-char *progname;
-char *filename;
-
-long wordmask[] = { /* allowed bits in a word */
- 0x00000000,
- 0x000000FF,
- 0x0000FFFF,
- 0x00000000,
- 0xFFFFFFFF
-};
-
-long sizemask[] = { /* allowed bits in multiples of 'wsize' */
- 0x00000000,
- 0x7FFFFFFF,
- 0x7FFFFFFE,
- 0x00000000,
- 0x7FFFFFFC
-};
-
-/*
- * external tables
- */
-
-extern char em_flag[];
-extern short em_ptyp[];
-extern char em_mnem[][4];
-extern char em_pseu[][4];
-
-/*
- * routines
- */
-
-int get16();
-long get32();
-
-main(argc,argv) char **argv; {
-
- progname = argv[0];
- if (argc >= 2) {
- filename = argv[1];
- if (freopen(argv[1],"r",stdin) == NULL)
- fatal("can't open %s",argv[1]);
- }
- if (argc >= 3)
- if (freopen(argv[2],"w",stdout) == NULL)
- fatal("can't create %s",argv[2]);
- if (get16() != sp_magic)
- fatal("bad magic word");
- /* In System III the array is called _ctype[] without the trailing '_' */
- (_ctype_+1)['_'] = (_ctype_+1)['a'];
- while (nextline())
- ;
- return(errors ? -1 : 0);
-}
-
-/* ----- copy ----- */
-
-int nextline() {
- register t;
-
- lineno++;
- argnum = 1;
- switch (t = table1()) {
- case EOF:
- return(0);
- case sp_fmnem:
- instr();
- break;
- case sp_fpseu:
- pseudo();
- break;
- case sp_ilb1:
- case sp_ilb2:
- argnum = 0;
- putarg(sp_cst2);
- break;
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- argnum = 0;
- putarg(t);
- break;
- default:
- error("unknown opcode %d",t);
- }
- putchar('\n');
- return(1);
-}
-
-instr() {
- register i,j,t;
- register long l;
-
- i = opcode - sp_fmnem;
- printf(" %s",em_mnem[i]);
- j = em_flag[i] & EM_PAR;
- if (j == PAR_NO)
- return;
- t = em_ptyp[j];
- t = getarg(t);
- /*
- * range checking
- */
- switch (j) {
- case PAR_N:
- check(argval >= 0);
- break;
- case PAR_G:
- if (t != sp_cst2 && t != sp_cst4)
- break;
- check(argval >= 0);
- /* fall through */
- case PAR_L:
- l = argval >= 0 ? argval : -argval;
- check((l & ~wordmask[psize]) == 0);
- break;
- case PAR_W:
- if (t == sp_cend)
- break;
- check((argval & ~wordmask[wsize]) == 0);
- /* fall through */
- case PAR_S:
- check(argval != 0);
- /* fall through */
- case PAR_Z:
- check((argval & ~sizemask[wsize]) == 0);
- break;
- case PAR_O:
- check(argval != 0);
- check((argval & ~sizemask[wsize])==0 || (wsize % argval)==0);
- break;
- case PAR_B:
- t = sp_ilb2;
- break;
- case PAR_R:
- check(argval >= 0 && argval <= 2);
- break;
- }
- putarg(t);
-}
-
-pseudo() {
- register i,t;
-
- i = opcode;
- printf(" %s",em_pseu[i - sp_fpseu]);
- switch (i) {
- case ps_bss:
- case ps_hol:
- putarg(getarg(cst_ptyp));
- putarg(getarg(val_ptyp));
- putarg(getarg(ptyp(sp_cst2)));
- check(argval==0 || argval==1);
- break;
- case ps_rom:
- case ps_con:
- putarg(getarg(val_ptyp));
- while ((t = getarg(any_ptyp)) != sp_cend)
- putarg(t);
- break;
- case ps_mes:
- putarg(getarg(ptyp(sp_cst2)));
- if (argval == ms_emx) {
- putarg(getarg(ptyp(sp_cst2)));
- check(argval > 0 && argval <= 4);
- wsize = (int) argval;
- putarg(getarg(ptyp(sp_cst2)));
- check(argval > 0 && argval <= 4);
- psize = (int) argval;
- }
- while ((t = getarg(any_ptyp)) != sp_cend)
- putarg(t);
- break;
- case ps_exa:
- case ps_ina:
- putarg(getarg(sym_ptyp));
- break;
- case ps_exp:
- case ps_inp:
- putarg(getarg(ptyp(sp_pnam)));
- break;
- case ps_exc:
- putarg(getarg(ptyp(sp_cst2)));
- putarg(getarg(ptyp(sp_cst2)));
- break;
- case ps_pro:
- putarg(getarg(ptyp(sp_pnam)));
- putarg(getarg(cst_ptyp|ptyp(sp_cend)));
- break;
- case ps_end:
- putarg(getarg(cst_ptyp|ptyp(sp_cend)));
- break;
- default:
- error("bad pseudo %d",i);
- }
-}
-
-/* ----- input ----- */
-
-int getarg(typset) {
- register t,argtyp;
-
- argtyp = t = table2();
- if (t == EOF)
- fatal("unexpected EOF");
- t -= sp_fspec;
- assert(t >= 0 && t < 16);
- t = 1 << t;
- if ((typset & t) == 0)
- error("bad argument type %d",argtyp);
- return(argtyp);
-}
-
-int table1() {
- register i;
-
- i = get8();
- if (i < sp_fmnem+sp_nmnem && i >= sp_fmnem) {
- opcode = i;
- return(sp_fmnem);
- }
- if (i < sp_fpseu+sp_npseu && i >= sp_fpseu) {
- opcode = i;
- return(sp_fpseu);
- }
- if (i < sp_filb0+sp_nilb0 && i >= sp_filb0) {
- argval = i - sp_filb0;
- return(sp_ilb2);
- }
- return(table3(i));
-}
-
-int table2() {
- register i;
-
- i = get8();
- if (i < sp_fcst0+sp_ncst0 && i >= sp_fcst0) {
- argval = i - sp_zcst0;
- return(sp_cst2);
- }
- return(table3(i));
-}
-
-int table3(i) {
- long consiz;
-
- switch(i) {
- case sp_ilb1:
- argval = get8();
- break;
- case sp_dlb1:
- dlbval = get8();
- break;
- case sp_dlb2:
- dlbval = get16();
- if ( dlbval<0 ) {
- error("illegal data label .%d",dlbval);
- dlbval=0 ;
- }
- break;
- case sp_cst2:
- argval = get16();
- break;
- case sp_ilb2:
- argval = get16();
- if ( argval<0 ) {
- error("illegal instruction label %D",argval);
- argval=0 ;
- }
- break;
- case sp_cst4:
- argval = get32();
- break;
- case sp_dnam:
- case sp_pnam:
- getstring(1);
- break;
- case sp_scon:
- getstring(0);
- break;
- case sp_doff:
- offtyp = getarg(sym_ptyp);
- getarg(cst_ptyp);
- break;
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- getarg(cst_ptyp);
- consiz = (long) argval;
- getstring(0);
- argval = consiz;
- break;
- }
- return(i);
-}
-
-int get16() {
- register int l_byte, h_byte;
-
- l_byte = get8();
- h_byte = get8();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-long get32() {
- register long l;
- register int h_byte;
-
- l = get8(); l |= (unsigned)get8()*256 ; l |= get8()*256L*256L ;
- h_byte = get8() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-
-getstring(ident) {
- register char *p;
- register n;
-
- getarg(cst_ptyp);
- if (argval < 0 || argval > MAXSTR)
- fatal("string/identifier too long");
- strsiz = n = argval;
- p = string;
- while (--n >= 0)
- *p++ = get8();
- if (ident) {
- if (!isascii(string[0]) || !isalpha(string[0])) {
- identerror();
- return;
- }
- for (n=strsiz,p=string+1;--n>0;p++)
- if (!isascii(*p) || !isalnum(*p)) {
- identerror();
- return;
- }
- }
-}
-
-/* ----- output ----- */
-
-putarg(t) {
-
- if (argnum != 0)
- putchar(argnum == 1 ? ' ' : ',');
- argnum++;
- puttyp(t);
-}
-
-puttyp(t) {
-
- switch (t) {
- case sp_ilb1:
- case sp_ilb2:
- printf("*%d",(int) argval);
- break;
- case sp_dlb1:
- case sp_dlb2:
- printf(".%d",dlbval);
- break;
- case sp_dnam:
- putstr(0,0);
- break;
- case sp_cst2:
- case sp_cst4:
- printf("%D",argval);
- break;
- case sp_doff:
- puttyp(offtyp);
- if (argval >= 0) putchar('+');
- printf("%D",argval);
- break;
- case sp_pnam:
- putstr('$',0);
- break;
- case sp_scon:
- putstr('\'','\'');
- break;
- case sp_icon:
- putstr(0,'I');
- printf("%D",argval);
- break;
- case sp_ucon:
- putstr(0,'U');
- printf("%D",argval);
- break;
- case sp_fcon:
- putstr(0,'F');
- printf("%D",argval);
- break;
- case sp_cend:
- putchar('?');
- break;
- }
-}
-
-putstr(c,c2) register c; {
- register char *p;
-
- if (c)
- putchar(c);
- p = string;
- while (--strsiz >= 0) {
- c = *p++ & 0377;
- if (c >= 040 && c < 0177) {
- if (c == '\'' || c == '\\')
- putchar('\\');
- putchar(c);
- } else
- printf("\\%03o",c);
- }
- if (c2)
- putchar(c2);
-}
-
-/* ----- error handling ----- */
-
-fail_check() {
- error("argument range error");
-}
-
-identerror() {
- error("'%s' is not a correct identifier",string);
-}
-
-/* VARARGS */
-error(s,a1,a2,a3,a4) char *s; {
- fprintf(stderr,
- "%s: line %d: ",
- filename ? filename : progname,
- lineno);
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- errors++;
-}
-
-/* VARARGS */
-fatal(s,a1,a2,a3,a4) char *s; {
- error(s,a1,a2,a3,a4);
- exit(-1);
-}
+++ /dev/null
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- */
-
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-/*
- * Encode to compact EM assembly language
- *
- * Author: Johan Stevenson, Vrije Universiteit, Amsterdam
- */
-
-#include <stdio.h>
-#include <ctype.h>
-#include <assert.h>
-#include <setjmp.h>
-#include <em_spec.h>
-#include <em_pseu.h>
-#include <em_flag.h>
-#include <em_ptyp.h>
-#include <em_mes.h>
-
-#define put8(x) putchar(x)
-
-#define check(x) if (!(x)) fail_check()
-
-#define fit16i(x) ((x) >= 0xFFFF8000 && (x) <= 0x00007FFF)
-#define fit8u(x) ((x) >= 0 && (x) <= 0xFF)
-
-#define MAXSTR 256
-#define HSIZE 256
-#define EMPTY (EOF-1)
-
-/*
- * global variables
- */
-
-int opcode;
-int offtyp;
-long argval;
-int dlbval;
-char string[MAXSTR];
-int strsiz;
-
-int wsize;
-int psize;
-int lineno;
-int argnum;
-int errors;
-char *progname;
-char *filename = "INPUT";
-
-long wordmask[] = { /* allowed bits in a word */
- 0x00000000,
- 0x000000FF,
- 0x0000FFFF,
- 0x00000000,
- 0xFFFFFFFF
-};
-
-long sizemask[] = { /* allowed bits in multiples of 'wsize' */
- 0x00000000,
- 0x7FFFFFFF,
- 0x7FFFFFFE,
- 0x00000000,
- 0x7FFFFFFC
-};
-
-int peekc = EMPTY;
-int hashtab[HSIZE];
-jmp_buf recover;
-
-/*
- * external tables
- */
-
-extern char em_flag[];
-extern short em_ptyp[];
-extern char em_mnem[][4];
-extern char em_pseu[][4];
-
-int main(argc,argv) char **argv; {
-
- progname = argv[0];
- if (argc >= 2) {
- filename = argv[1];
- if (freopen(filename,"r",stdin) == NULL)
- fatal("can't open %s",filename);
- }
- if (argc >= 3)
- if (freopen(argv[2],"w",stdout) == NULL)
- fatal("can't create %s",argv[2]);
- init();
- put16(sp_magic);
- setjmp(recover);
- while (nextline())
- ;
- return(errors ? -1 : 0);
-}
-
-/* ----- copy ----- */
-
-int nextline() {
- register c,i;
-
- lineno++;
- argnum = 1;
- c = nextchar();
- if (c == EOF)
- return(0);
- if (isspace(c) && c != '\n') {
- c = nospace();
- if (isalpha(c)) {
- inmnem(c);
- if (opcode <= sp_lmnem)
- instr();
- else
- pseudo();
- } else
- peekc = c;
- } else if (c == '#') {
- line_line();
- } else {
- peekc = c;
- i = gettyp(sym_ptyp | ptyp(sp_cst2) | ptyp(sp_cend));
- switch (i) {
- case sp_cst2:
- i = (int) argval;
- if (i >= 0 && i < sp_nilb0)
- put8(i + sp_filb0);
- else
- putarg(sp_ilb2);
- break;
- case sp_dlb2:
- case sp_dnam:
- putarg(i);
- break;
- case sp_cend:
- break;
- }
- }
- if (nospace() != '\n')
- syntax("end of line expected");
- return(1);
-}
-
-instr() {
- register i,j,t;
- register long l;
-
- i = opcode;
- put8(i);
- i -= sp_fmnem;
- j = em_flag[i] & EM_PAR;
- if (j == PAR_NO)
- return;
- t = em_ptyp[j];
- if (j == PAR_B)
- t = ptyp(sp_ilb2);
- t = getarg(t);
- /*
- * range checking
- */
- switch (j) {
- case PAR_N:
- check(argval >= 0);
- break;
- case PAR_G:
- if (t != sp_cst2 && t != sp_cst4)
- break;
- check(argval >= 0);
- /* fall through */
- case PAR_L:
- l = argval >= 0 ? argval : -argval;
- check((l & ~wordmask[psize]) == 0);
- break;
- case PAR_W:
- if (t == sp_cend)
- break;
- check((argval & ~wordmask[wsize]) == 0);
- /* fall through */
- case PAR_S:
- check(argval != 0);
- /* fall through */
- case PAR_Z:
- check((argval & ~sizemask[wsize]) == 0);
- break;
- case PAR_O:
- check(argval != 0);
- check((argval & ~sizemask[wsize])==0 || (wsize % argval)==0);
- break;
- case PAR_B:
- t = sp_cst2;
- break;
- case PAR_R:
- check(argval >= 0 && argval <= 2);
- break;
- }
- putarg(t);
-}
-
-pseudo() {
- register i,t;
-
- i = opcode;
- put8(i);
- switch (i) {
- case ps_bss:
- case ps_hol:
- putarg(getarg(cst_ptyp));
- putarg(getarg(val_ptyp));
- putarg(getarg(ptyp(sp_cst2)));
- check(argval==0 || argval==1);
- break;
- case ps_rom:
- case ps_con:
- putarg(getarg(val_ptyp));
- do
- putarg(t = getarg(any_ptyp));
- while (t != sp_cend);
- break;
- case ps_mes:
- putarg(getarg(ptyp(sp_cst2)));
- if (argval == ms_emx) {
- putarg(getarg(ptyp(sp_cst2)));
- check(argval > 0 && argval <= 4);
- wsize = (int) argval;
- putarg(getarg(ptyp(sp_cst2)));
- check(argval > 0 && argval <= 4);
- psize = (int) argval;
- }
- do
- putarg(t = getarg(any_ptyp));
- while (t != sp_cend);
- break;
- case ps_exa:
- case ps_ina:
- putarg(getarg(sym_ptyp));
- break;
- case ps_exp:
- case ps_inp:
- putarg(getarg(ptyp(sp_pnam)));
- break;
- case ps_exc:
- putarg(getarg(ptyp(sp_cst2)));
- putarg(getarg(ptyp(sp_cst2)));
- break;
- case ps_pro:
- putarg(getarg(ptyp(sp_pnam)));
- putarg(getarg(cst_ptyp|ptyp(sp_cend)));
- break;
- case ps_end:
- putarg(getarg(cst_ptyp|ptyp(sp_cend)));
- break;
- default:
- syntax("bad pseudo %d",i);
- }
-}
-
-/* ----- input ----- */
-
-int getarg(typset) {
- register c;
-
- if (argnum != 1) {
- c = nospace();
- if (c != ',') {
- if (c != '\n')
- syntax("comma expected");
- peekc = c;
- }
- }
- argnum++;
- return(gettyp(typset));
-}
-
-int gettyp(typset) {
- register c,t,sp;
-
- c = nospace();
- if (c == '\n') {
- peekc = c;
- sp = sp_cend;
- } else if (isdigit(c) || c == '+' || c == '-' || c == '(') {
- sp = inexpr1(c);
- if (sp == sp_cst4 && fit16i(argval))
- sp = sp_cst2;
- } else if (isalpha(c)) {
- inname(c);
- sp = offsetted(sp_dnam);
- } else if (c == '.') {
- in15u();
- dlbval = (int) argval;
- sp = offsetted(sp_dlb2);
- } else if (c == '*') {
- in15u();
- sp = sp_ilb2;
- } else if (c == '$') {
- inname(nextchar());
- sp = sp_pnam;
- } else if (c == '"' || c == '\'') {
- sp = instring(c);
- } else if (c == '?') {
- sp = sp_cend;
- } else
- syntax("operand expected");
- t = sp - sp_fspec;
- assert(t >= 0 && t < 16);
- t = 1 << t;
- if ((typset & t) == 0)
- error("bad argument type %d",sp);
- return(sp);
-}
-
-int offsetted(sp) {
- register c;
-
- c = nospace();
- if (c == '+' || c == '-') {
- gettyp(cst_ptyp);
- if (c == '-')
- argval = -argval;
- offtyp = sp;
- return(sp_doff);
- }
- peekc = c;
- return(sp);
-}
-
-inname(c) register c; {
- register char *p;
-
- if (isalpha(c) == 0)
- syntax("letter expected");
- p = string;
- do {
- if (p < &string[MAXSTR-1])
- *p++ = c;
- c = nextchar();
- } while (isalnum(c));
- peekc = c;
- *p = '\0';
- strsiz = p - string;
-}
-
-int inmnem(c) register c; {
- register unsigned h;
- register i;
-
- inname(c);
- h = hash(string);
- for (;;) {
- h++;
- h %= HSIZE;
- i = hashtab[h];
- if (i == 0)
- syntax("bad mnemonic");
- if (i <= sp_lmnem) {
- assert(i >= sp_fmnem);
- if (strcmp(string,em_mnem[i - sp_fmnem]) != 0)
- continue;
- return(opcode = i);
- }
- assert(i <= sp_lpseu && i >= sp_fpseu);
- if (strcmp(string,em_pseu[i - sp_fpseu]) != 0)
- continue;
- return(opcode = i);
- }
-}
-
-int inexpr1(c) register c; {
- long left;
-
- if ((c = inexpr2(c)) != sp_cst4)
- return(c);
- for (;;) {
- c = nospace();
- if (c != '+' && c != '-') {
- peekc = c;
- break;
- }
- left = argval;
- if (inexpr2(nospace()) != sp_cst4)
- syntax("term expected");
- if (c == '+')
- argval += left;
- else
- argval = left - argval;
- }
- return(sp_cst4);
-}
-
-int inexpr2(c) register c; {
- long left;
-
- if ((c = inexpr3(c)) != sp_cst4)
- return(c);
- for (;;) {
- c = nospace();
- if (c != '*' && c != '/' && c != '%') {
- peekc = c;
- break;
- }
- left = argval;
- if (inexpr3(nospace()) != sp_cst4)
- syntax("factor expected");
- if (c == '*')
- argval *= left;
- else if (c == '/')
- argval = left / argval;
- else
- argval = left % argval;
- }
- return(sp_cst4);
-}
-
-inexpr3(c) register c; {
-
- if (c == '(') {
- if (inexpr1(nospace()) != sp_cst4)
- syntax("expression expected");
- if (nospace() != ')')
- syntax("')' expected");
- return(sp_cst4);
- }
- return(innumber(c));
-}
-
-int innumber(c) register c; {
- register char *p;
- register n;
- int expsign;
- static char numstr[MAXSTR];
- long atol();
-
- p = numstr;
- expsign = 0;
- if (c == '+' || c == '-') {
- if (c == '-')
- *p++ = c;
- c = nextchar();
- }
- if (isdigit(c) == 0)
- syntax("digit expected");
- n = sp_cst4;
- for (;;) {
- if (p >= &numstr[MAXSTR-1])
- fatal("number too long");
- *p++ = c;
- c = nextchar();
- if (c == '.' || c == 'e' || c == 'E') {
- expsign = c != '.';
- n = sp_fcon;
- continue;
- }
- if (expsign) {
- expsign = 0;
- if (c == '+' || c == '-')
- continue;
- }
- if (isdigit(c) == 0)
- break;
- }
- peekc = c;
- *p = '\0';
- c = nospace();
- if (n == sp_fcon && c != 'F')
- syntax("'F' expected");
- if (c == 'I' || c == 'U' || c == 'F')
- return(incon(numstr,c));
- peekc = c;
- argval = atol(numstr);
- return(sp_cst4);
-}
-
-in15u() {
-
- if (innumber(nextchar()) != sp_cst4)
- syntax("integer expected");
- check((argval & ~077777) == 0);
-}
-
-int incon(p,c) register char *p; {
- register char *q;
-
- q = string;
- while (*q++ = *p++)
- ;
- strsiz = q - string - 1;
- gettyp(cst_ptyp);
- return(c == 'I' ? sp_icon : (c == 'U' ? sp_ucon : sp_fcon));
-}
-
-int instring(termc) {
- register char *p;
- register c;
-
- p = string;
- for (;;) {
- c = nextchar();
- if (c == '\n' || c == EOF) {
- peekc = c;
- syntax("non-terminated string");
- }
- if (c == termc) {
- if (termc == '"')
- *p++ = '\0';
- break;
- }
- if (c == '\\')
- c = inescape();
- if (p >= &string[MAXSTR-1])
- fatal("string too long");
- *p++ = c;
- }
- strsiz = p - string;
- return(sp_scon);
-}
-
-int inescape() {
- register c,j,r;
-
- c = nextchar();
- if (c >= '0' && c <= '7') {
- r = c - '0';
- for (j = 0; j < 2; j++) {
- c = nextchar();
- if (c < '0' || c > '7') {
- peekc = c;
- return(r);
- }
- r <<= 3;
- r += (c - '0');
- }
- return(r);
- }
- switch (c) {
- case 'b': return('\b');
- case 'f': return('\f');
- case 'n': return('\n');
- case 'r': return('\r');
- case 't': return('\t');
- }
- return(c);
-}
-
-int nospace() {
- register c;
-
- do
- c = nextchar();
- while (isspace(c) && c != '\n');
- if (c == ';')
- do
- c = nextchar();
- while (c != '\n' && c != EOF);
- return(c);
-}
-
-int nextchar() {
- register c;
-
- if (peekc != EMPTY) {
- c = peekc;
- peekc = EMPTY;
- return(c);
- }
- c = getchar();
- if (isascii(c) == 0 && c != EOF)
- fatal("non-ascii char");
- return(c);
-}
-
-line_line() {
- register char *p,*q;
- static char filebuff[MAXSTR+1];
-
- gettyp(ptyp(sp_cst2));
- lineno = (int) (argval-1);
- gettyp(ptyp(sp_scon));
- p = string;
- q = filebuff;
- while (--strsiz >= 0)
- *q++ = *p++;
- *q = '\0';
- filename = filebuff;
-}
-
-init() {
- register i;
-
- for (i = sp_fmnem; i <= sp_lmnem; i++)
- pre_hash(i,em_mnem[i - sp_fmnem]);
- for (i = sp_fpseu; i <= sp_lpseu; i++)
- pre_hash(i,em_pseu[i - sp_fpseu]);
- /* treat '_' as letter */
- /* In System III the array is called _ctype[] without the trailing '_' */
- (_ctype_+1)['_'] = (_ctype_+1)['a'];
-}
-
-pre_hash(i,s) char *s; {
- register unsigned h;
-
- assert(i != 0);
- h = hash(s);
- for (;;) {
- h++;
- h %= HSIZE;
- if (hashtab[h] == 0) {
- hashtab[h] = i;
- return;
- }
- }
-}
-
-int hash(s) register char *s; {
- register h;
-
- h = 0;
- while (*s) {
- h <<= 1;
- h += *s++;
- }
- return(h);
-}
-
-/* ----- output ----- */
-
-putarg(sp) register sp; {
- register i;
-
- switch (sp) {
- case sp_ilb2:
- i = (int) argval;
- if (fit8u(i)) {
- put8(sp_ilb1);
- put8(i);
- break;
- }
- put8(sp);
- put16(i);
- break;
- case sp_dlb2:
- i = dlbval;
- if (fit8u(i)) {
- put8(sp_dlb1);
- put8(i);
- break;
- }
- put8(sp);
- put16(i);
- break;
- case sp_cst2:
- case sp_cst4:
- if (fit16i(argval) == 0) {
- put8(sp_cst4);
- put32(argval);
- break;
- }
- i = (int) argval;
- if (i >= -sp_zcst0 && i < sp_ncst0 - sp_zcst0) {
- put8(i + sp_zcst0 + sp_fcst0);
- break;
- }
- put8(sp_cst2);
- put16(i);
- break;
- case sp_doff:
- put8(sp);
- putarg(offtyp);
- putarg(sp_cst4);
- break;
- case sp_dnam:
- case sp_pnam:
- case sp_scon:
- put8(sp);
- putstr();
- break;
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- put8(sp);
- putarg(sp_cst4);
- putstr();
- break;
- case sp_cend:
- put8(sp);
- break;
- }
-}
-
-putstr() {
- register char *p;
- long consiz;
-
- consiz = argval;
- argval = strsiz;
- putarg(sp_cst4);
- argval = consiz;
- p = string;
- while (--strsiz >= 0)
- put8(*p++);
-}
-
-put16(w) int w; {
-
- put8(w);
- put8(w >> 8);
-}
-
-put32(f) long f; {
-
- put16((int) f);
- put16((int)(f >> 16));
-}
-
-/* ----- error handling ----- */
-
-fail_check() {
- error("argument range error");
-}
-
-/* VARARGS */
-error(s,a1,a2,a3,a4) char *s; {
- fprintf(stderr,"%s: line %d: ", filename, lineno);
- fprintf(stderr,s,a1,a2,a3,a4);
- fprintf(stderr,"\n");
- errors++;
-}
-
-/* VARARGS */
-fatal(s,a1,a2,a3,a4) char *s; {
- error(s,a1,a2,a3,a4);
- exit(-1);
-}
-
-/* VARARGS */
-syntax(s,a1,a2,a3,a4) char *s; {
- register c;
-
- error(s,a1,a2,a3,a4);
- do
- c = nextchar();
- while (c != '\n' && c != EOF);
- longjmp(recover);
-}
+++ /dev/null
-# $Header$
-
-CFILES=main.c getline.c lookup.c var.c process.c backward.c util.c\
- alloc.c putline.c cleanup.c peephole.c flow.c reg.c
-OFILES=main.o getline.o lookup.o var.o process.o backward.o util.o\
- alloc.o putline.o cleanup.o peephole.o flow.o reg.o
-KFILES=main.k getline.k lookup.k var.k process.k backward.k util.k\
- alloc.k putline.k cleanup.k peephole.k flow.k reg.k
-LIBS=../../lib/em_data.a
-CFLAGS=-O -DNDEBUG
-LDFLAGS=-i
-LINT=lint
-OPR=wide|opr
-XREF=xref -c -w80
-PROPTS=
-# LEXLIB is implementation dependent, try -ll or -lln first
-LEXLIB=-ll
-
-.DEFAULT:
- co -q $<
-
-opt: $(OFILES) pattern.o $(LIBS)
- cc $(LDFLAGS) $(CFLAGS) $(OFILES) pattern.o $(LIBS) -o opt
-
-test: opt testopt
- testopt
-
-cmp : opt
- cmp opt ../../lib/em_opt
-
-install:opt
- size opt ../../lib/em_opt
- cp opt ../../lib/em_opt
-
-pattern.c: patterns mktab
- /lib/cpp patterns | mktab > pattern.c
-
-mktab: mktab.o $(LIBS)
- cc $(CFLAGS) mktab.o $(LIBS) $(LEXLIB) -o mktab
-
-depend: makedepend
- makedepend
-
-lint: $(CFILES) pattern.c
- $(LINT) $(CFILES) pattern.c>lint 2>&1
-
-printall:
- -pr $(PROPTS) Makefile -n *.h `ls $(CFILES)` mktab.y scan.l patterns|$(OPR)
- touch print
-
-print: Makefile *.h $(CFILES) mktab.y scan.l patterns
- -pr $(PROPTS) -n $? | $(OPR)
-
-opr:
- make pr ^ $(OPR)
-
-pr:
- @pr $(PROPTS) -n Makefile *.h $(CFILES) mktab.y scan.l patterns
-
-xref:
- $(XREF) *.h $(CFILES) | pr $(PROPTS) -h "XREF EMOPT"|$(OPR)&
-
-sizes: opt
- -nm opt | sort -n| /usr/plain/bin/map
-
-clean:
- rm -f *.o opt mktab mktab.c scan.c pattern.c
-
-kfiles: $(KFILES)
-
-.SUFFIXES: .k
-.c.k: ; cem -c $*.c
-
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-alloc.o: alloc.h
-alloc.o: assert.h
-alloc.o: line.h
-alloc.o: lookup.h
-alloc.o: param.h
-alloc.o: proinf.h
-alloc.o: types.h
-backward.o: ../../h/em_mnem.h
-backward.o: ../../h/em_pseu.h
-backward.o: ../../h/em_spec.h
-backward.o: alloc.h
-backward.o: assert.h
-backward.o: ext.h
-backward.o: line.h
-backward.o: lookup.h
-backward.o: param.h
-backward.o: proinf.h
-backward.o: types.h
-cleanup.o: ../../h/em_mes.h
-cleanup.o: ../../h/em_pseu.h
-cleanup.o: ../../h/em_spec.h
-cleanup.o: assert.h
-cleanup.o: ext.h
-cleanup.o: lookup.h
-cleanup.o: param.h
-cleanup.o: types.h
-flow.o: ../../h/em_flag.h
-flow.o: ../../h/em_mnem.h
-flow.o: ../../h/em_spec.h
-flow.o: alloc.h
-flow.o: ext.h
-flow.o: line.h
-flow.o: optim.h
-flow.o: param.h
-flow.o: proinf.h
-flow.o: types.h
-getline.o: ../../h/em_flag.h
-getline.o: ../../h/em_mes.h
-getline.o: ../../h/em_pseu.h
-getline.o: ../../h/em_spec.h
-getline.o: alloc.h
-getline.o: assert.h
-getline.o: ext.h
-getline.o: line.h
-getline.o: lookup.h
-getline.o: param.h
-getline.o: proinf.h
-getline.o: types.h
-lookup.o: alloc.h
-lookup.o: lookup.h
-lookup.o: param.h
-lookup.o: proinf.h
-lookup.o: types.h
-main.o: ../../h/em_spec.h
-main.o: alloc.h
-main.o: ext.h
-main.o: param.h
-main.o: types.h
-mktab.o: ../../h/em_mnem.h
-mktab.o: ../../h/em_spec.h
-mktab.o: optim.h
-mktab.o: param.h
-mktab.o: pattern.h
-mktab.o: scan.c
-mktab.o: types.h
-pattern.o: param.h
-pattern.o: pattern.h
-pattern.o: types.h
-peephole.o: ../../h/em_mnem.h
-peephole.o: ../../h/em_spec.h
-peephole.o: alloc.h
-peephole.o: assert.h
-peephole.o: ext.h
-peephole.o: line.h
-peephole.o: lookup.h
-peephole.o: optim.h
-peephole.o: param.h
-peephole.o: pattern.h
-peephole.o: proinf.h
-peephole.o: types.h
-process.o: ../../h/em_pseu.h
-process.o: ../../h/em_spec.h
-process.o: alloc.h
-process.o: assert.h
-process.o: ext.h
-process.o: line.h
-process.o: lookup.h
-process.o: param.h
-process.o: proinf.h
-process.o: types.h
-putline.o: ../../h/em_flag.h
-putline.o: ../../h/em_mnem.h
-putline.o: ../../h/em_pseu.h
-putline.o: ../../h/em_spec.h
-putline.o: alloc.h
-putline.o: assert.h
-putline.o: ext.h
-putline.o: line.h
-putline.o: lookup.h
-putline.o: optim.h
-putline.o: param.h
-putline.o: proinf.h
-putline.o: types.h
-reg.o: ../../h/em_mes.h
-reg.o: ../../h/em_pseu.h
-reg.o: ../../h/em_spec.h
-reg.o: alloc.h
-reg.o: assert.h
-reg.o: ext.h
-reg.o: line.h
-reg.o: param.h
-reg.o: proinf.h
-reg.o: types.h
-scan.o: stdio.h
-special.o: param.h
-special.o: types.h
-util.o: assert.h
-util.o: ext.h
-util.o: lookup.h
-util.o: optim.h
-util.o: param.h
-util.o: proinf.h
-util.o: types.h
-var.o: lookup.h
-var.o: param.h
-var.o: proinf.h
-var.o: types.h
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#ifdef USEMALLOC
-
-short * myalloc();
-
-#define newcore(size) myalloc(size)
-#define oldcore(p,size) free(p)
-
-#else
-
-/* #define CORECHECK /* if defined tests are made to insure
- each block occurs at most once */
-
-#define CCHUNK 1024 /* number of shorts asked from system */
-
-short *newcore(),*freshcore();
-extern char *sbrk();
-
-#ifdef COREDEBUG
-int shortsasked=0;
-#endif
-
-#endif
-
-/*
- * The following two sizetables contain the sizes of the various kinds
- * of line and argument structures.
- * Care has been taken to make this table implementation independent,
- * but if you think very hard you might find a compiler failing the
- * assumptions made.
- * A wasteful but safe approach is to replace every line of them by
- * sizeof(line_t)
- * and
- * sizeof(arg_t)
- * respectively.
- */
-
-#define LBASE (sizeof(line_t)-sizeof(un_l_a))
-
-int lsizetab[] = {
- LBASE,
- LBASE+sizeof(short),
- LBASE+sizeof(offset),
- LBASE+sizeof(num_p),
- LBASE+sizeof(sym_p),
- LBASE+sizeof(s_la_sval),
- LBASE+sizeof(s_la_lval),
- LBASE+sizeof(arg_p),
- LBASE
-};
-
-#define ABASE (sizeof(arg_t)-sizeof(un_a_a))
-
-int asizetab[] = {
- ABASE+sizeof(offset),
- ABASE+sizeof(num_p),
- ABASE+sizeof(sym_p),
- ABASE+sizeof(s_a_val),
- ABASE+sizeof(argb_t),
- ABASE+sizeof(s_a_con),
- ABASE+sizeof(s_a_con),
- ABASE+sizeof(s_a_con),
-};
-
-/*
- * alloc routines:
- * Two parts:
- * 1) typed alloc and free routines
- * 2) untyped raw core allocation
- */
-
-/*
- * PART 1
- */
-
-line_p newline(optyp) int optyp; {
- register line_p lnp;
- register kind=optyp;
-
- if (kind>OPMINI)
- kind = OPMINI;
- lnp = (line_p) newcore(lsizetab[kind]);
- lnp->l_optyp = optyp;
- return(lnp);
-}
-
-oldline(lnp) register line_p lnp; {
- register kind=lnp->l_optyp&BMASK;
-
- if (kind>OPMINI)
- kind = OPMINI;
- if (kind == OPLIST)
- oldargs(lnp->l_a.la_arg);
- oldcore((short *) lnp,lsizetab[kind]);
-}
-
-arg_p newarg(kind) int kind; {
- register arg_p ap;
-
- ap = (arg_p) newcore(asizetab[kind]);
- ap->a_typ = kind;
- return(ap);
-}
-
-oldargs(ap) register arg_p ap; {
- register arg_p next;
-
- while (ap != (arg_p) 0) {
- next = ap->a_next;
- switch(ap->a_typ) {
- case ARGSTR:
- oldargb(ap->a_a.a_string.ab_next);
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- oldargb(ap->a_a.a_con.ac_con.ab_next);
- break;
- }
- oldcore((short *) ap,asizetab[ap->a_typ]);
- ap = next;
- }
-}
-
-oldargb(abp) register argb_p abp; {
- register argb_p next;
-
- while (abp != (argb_p) 0) {
- next = abp->ab_next;
- oldcore((short *) abp,sizeof (argb_t));
- abp = next;
- }
-}
-
-reg_p newreg() {
-
- return((reg_p) newcore(sizeof(reg_t)));
-}
-
-oldreg(rp) reg_p rp; {
-
- oldcore((short *) rp,sizeof(reg_t));
-}
-
-num_p newnum() {
-
- return((num_p) newcore(sizeof(num_t)));
-}
-
-oldnum(lp) num_p lp; {
-
- oldcore((short *) lp,sizeof(num_t));
-}
-
-offset *newrom() {
-
- return((offset *) newcore(MAXROM*sizeof(offset)));
-}
-
-sym_p newsym(len) int len; {
- /*
- * sym_t includes a 2 character s_name at the end
- * extend this structure with len-2 characters
- */
- return((sym_p) newcore(sizeof(sym_t) - 2 + len));
-}
-
-argb_p newargb() {
-
- return((argb_p) newcore(sizeof(argb_t)));
-}
-
-#ifndef USEMALLOC
-
-/******************************************************************/
-/****** Start of raw core management package *****************/
-/******************************************************************/
-
-#define MAXSHORT 30 /* Maximum number of shorts one can ask for */
-
-short *freelist[MAXSHORT];
-
-typedef struct coreblock {
- struct coreblock *co_next;
- short co_size;
-} core_t,*core_p;
-
-#define SINC (sizeof(core_t)/sizeof(short))
-#ifdef COREDEBUG
-coreverbose() {
- register size;
- register short *p;
- register sum;
-
- sum = 0;
- for(size=1;size<MAXSHORT;size++)
- for (p=freelist[size];p!=0;p = *(short **) p)
- sum += size;
- fprintf(stderr,"Used core %u\n",(shortsasked-sum)*sizeof(short));
-}
-#endif
-
-#ifdef SEPID
-
-compactcore() {
- register core_p corelist=0,tp,cl;
- int size;
-
-#ifdef COREDEBUG
- fprintf(stderr,"Almost out of core\n");
-#endif
- for(size=SINC;size<MAXSHORT;size++) {
- while ((tp = (core_p) freelist[size]) != (core_p) 0) {
- freelist[size] = (short *) tp->co_next;
- tp->co_size = size;
- if (corelist==0 || tp<corelist) {
- tp->co_next = corelist;
- corelist = tp;
- } else {
- for(cl=corelist;cl->co_next != 0 && tp>cl->co_next;
- cl = cl->co_next)
- ;
- tp->co_next = cl->co_next;
- cl->co_next = tp;
- }
- }
- }
- while (corelist != 0) {
- while ((short *) corelist->co_next ==
- (short *) corelist + corelist->co_size) {
- corelist->co_size += corelist->co_next->co_size;
- corelist->co_next = corelist->co_next->co_next;
- }
- assert(corelist->co_next==0 ||
- (short *) corelist->co_next >
- (short *) corelist + corelist->co_size);
- while (corelist->co_size >= MAXSHORT+SINC) {
- oldcore((short *) corelist + corelist->co_size-(MAXSHORT-1),
- sizeof(short)*(MAXSHORT-1));
- corelist->co_size -= MAXSHORT;
- }
- if (corelist->co_size >= MAXSHORT) {
- oldcore((short *) corelist + corelist->co_size-SINC,
- sizeof(short)*SINC);
- corelist->co_size -= SINC;
- }
- cl = corelist->co_next;
- oldcore((short *) corelist, sizeof(short)*corelist->co_size);
- corelist = cl;
- }
-}
-
-short *grabcore(size) int size; {
- register short *p;
- register trysize;
-
- /*
- * Desperate situation, can't get more core from system.
- * Postpone giving up just a little bit by splitting up
- * larger free blocks if possible.
- * Algorithm is worst fit.
- */
-
- assert(size<2*MAXSHORT);
- for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
- p = freelist[trysize/sizeof(short)];
- if ( p != (short *) 0) {
- freelist[trysize/sizeof(short)] = *(short **) p;
- oldcore(p+size/sizeof(short),trysize-size);
- return(p);
- }
- }
-
- /*
- * Can't get more core from the biggies, try to combine the
- * little ones. This is expensive but probably better than
- * giving up.
- */
-
- compactcore();
- if ((p=freelist[size/sizeof(short)]) != 0) {
- freelist[size/sizeof(short)] = * (short **) p;
- return(p);
- }
- for(trysize=2*MAXSHORT-2; trysize>size; trysize -= 2) {
- p = freelist[trysize/sizeof(short)];
- if ( p != (short *) 0) {
- freelist[trysize/sizeof(short)] = *(short **) p;
- oldcore(p+size/sizeof(short),trysize-size);
- return(p);
- }
- }
-
- /*
- * That's it then. Finished.
- */
-
- return(0);
-}
-#endif /* SEPID */
-
-short *newcore(size) int size; {
- register short *p,*q;
-
- if( size < 2*MAXSHORT ) {
- if ((p=freelist[size/sizeof(short)]) != (short *) 0)
- freelist[size/sizeof(short)] = *(short **) p;
- else {
- p = freshcore(size);
-#ifdef SEPID
- if (p == (short *) 0)
- p = grabcore(size);
-#endif
- }
- } else
- p = freshcore(size);
- if (p == 0)
- error("out of memory");
- for (q=p; size > 0 ; size -= sizeof(short))
- *q++ = 0;
- return(p);
-}
-
-#ifdef NOMALLOC
-
-/*
- * stdio uses malloc and free.
- * you can use these as substitutes
- */
-
-char *malloc(size) int size; {
-
- /*
- * malloc(III) is called by stdio,
- * this routine is a substitute.
- */
-
- return( (char *) newcore(size));
-}
-
-free() {
-
-}
-#endif
-
-oldcore(p,size) short *p; int size; {
-#ifdef CORECHECK
- register short *cp;
-#endif
-
- assert(size<2*MAXSHORT);
-#ifdef CORECHECK
- for (cp=freelist[size/sizeof(short)]; cp != (short *) 0;
- cp = (short *) *cp)
- assert(cp != p);
-#endif
- *(short **) p = freelist[size/sizeof(short)];
- freelist[size/sizeof(short)] = p;
-}
-
-short *ccur,*cend;
-
-coreinit(p1,p2) short *p1,*p2; {
-
- /*
- * coreinit is called with the boundaries of a piece of
- * memory that can be used for starters.
- */
-
- ccur = p1;
- cend = p2;
-}
-
-short *freshcore(size) int size; {
- register short *temp;
- static int cchunk=CCHUNK;
-
- while(&ccur[size/sizeof(short)] >= cend && cchunk>0) {
- do {
- temp = (short *) sbrk(cchunk*sizeof(short));
- if (temp == (short *) -1)
- cchunk >>= 1;
- else if (temp != cend)
- ccur = cend = temp;
- } while (temp == (short *) -1 && cchunk>0);
- cend += cchunk;
-#ifdef COREDEBUG
- shortsasked += cchunk;
-#endif
- }
- if (cchunk==0)
- return(0);
- temp = ccur;
- ccur = &ccur[size/sizeof(short)];
- return(temp);
-}
-
-#else /* USEMALLOC */
-
-coreinit() {
-
- /*
- * Empty function, no initialization needed
- */
-}
-
-short *myalloc(size) register size; {
- register short *p,*q;
- extern char *malloc();
-
- p = (short *)malloc(size);
- if (p == 0)
- error("out of memory");
- for(q=p;size>0;size -= sizeof(short))
- *q++ = 0;
- return(p);
-}
-#endif
+++ /dev/null
-/* $Header$ */
-
-extern line_p newline();
-extern offset *newrom();
-extern sym_p newsym();
-extern num_p newnum();
-extern arg_p newarg();
-extern argb_p newargb();
-extern reg_p newreg();
-
-extern oldline();
-extern oldloc();
-extern oldreg();
-
-/* #define USEMALLOC /* if defined malloc() and free() are used */
-
-/* #define COREDEBUG /* keep records and print statistics */
-
-/*
- * The next define gives if defined the number of pseudo's outside
- * procedures that are collected without processing.
- * If undefined all pseudo's will be collected but that may
- * give trouble on small machines, because of lack of room.
- */
-#define PSEUBETWEEN 200
-
-#ifndef USEMALLOC
-/*
- * Now the real bitsqueezing starts.
- * When running on a machine where code and data live in
- * separate address-spaces it is worth putting in some extra
- * code to save on probably less data.
- */
-#define SEPID /* code and data in separate spaces */
-/*
- * If the stack segment and the data are separate as on a PDP11 under UNIX
- * it is worth squeezing some shorts out of the stack page.
- */
-#ifndef EM_WSIZE
-/*
- * Compiled with 'standard' C compiler
- */
-#define STACKROOM 3200 /* number of shorts space in stack */
-#else
-/*
- * Compiled with pcc, has trouble with lots of variables
- */
-#define STACKROOM 2000
-#endif
-
-#else
-
-#define STACKROOM 1 /* 0 gives problems */
-
-#endif /* USEMALLOC */
+++ /dev/null
-/* $Header$ */
-
-#ifndef NDEBUG
-#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__)
-#else
-#define assert(x) /* nothing */
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mnem.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define local(x) if (((x)->s_flags&SYMKNOWN) == 0)\
- x->s_flags &= ~ SYMGLOBAL
-#define global(x) if(((x)->s_flags&SYMKNOWN) == 0)\
- x->s_flags |= SYMGLOBAL
-
-#define DTYPHOL 1
-#define DTYPBSS 2
-#define DTYPCON 3
-#define DTYPROM 4
-byte curdtyp;
-bool goodrom;
-short curfrag = 3; /* see also peephole.c */
-offset rombuf[MAXROM];
-int rc;
-
-backward() {
- register line_p lnp;
- line_p next;
- register arg_p ap;
- line_p i,p;
- int n;
- register sym_p sp;
-
- i = p = (line_p) 0;
- curdtyp=0;
- for (lnp = curpro.lastline; lnp != (line_p) 0; lnp = next) {
- next = lnp->l_next;
- switch(lnp->l_optyp) {
- case OPSYMBOL:
- global(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- global(lnp->l_a.la_sval.lasv_sp);
- break;
- case OPLVAL:
- global(lnp->l_a.la_lval.lalv_sp);
- break;
- case OPLIST:
- ap = lnp->l_a.la_arg;
- while (ap != (arg_p) 0 ) {
- switch(ap->a_typ) {
- case ARGSYM:
- global(ap->a_a.a_sp);
- break;
- case ARGVAL:
- global(ap->a_a.a_val.av_sp);
- }
- ap = ap->a_next;
- }
- break;
- }
-
- /*
- * references to symbols are processed now.
- * for plain instructions nothing else is needed
- */
-
- switch(lnp->l_instr&BMASK) {
- /*
- * count all local occurences for register counts;
- * op_lal is omitted and not by accident.
- */
- case op_del:
- case op_inl:
- case op_ldl:
- case op_lil:
- case op_lol:
- case op_sdl:
- case op_sil:
- case op_stl:
- case op_zrl:
- switch(lnp->l_optyp) {
- case OPNO:
- case OPNUMLAB:
- case OPSYMBOL:
- case OPSVAL:
- case OPLVAL:
- case OPLIST:
- break;
- case OPOFFSET:
- incregusage(lnp->l_a.la_offset);
- break;
- case OPSHORT:
- incregusage((offset)lnp->l_a.la_short);
- break;
- default:
- incregusage((offset)(lnp->l_optyp&BMASK)-Z_OPMINI);
- break;
- }
- /* fall through !! */
- default:
- assert((lnp->l_instr&BMASK)<=op_last);
- lnp->l_next = i;
- i = lnp;
- continue;
- case ps_sym:
- sp = lnp->l_a.la_sp;
- local(sp);
- if (curdtyp == DTYPROM && goodrom) {
- sp->s_rom = newrom();
- for (n=0;n<rc;n++)
- sp->s_rom[n] = rombuf[n];
- }
- sp->s_frag = curfrag;
- break;
- case ps_hol:
- curdtyp = DTYPHOL;
- curfrag++;
- break;
- case ps_bss:
- curdtyp = DTYPBSS;
- curfrag++;
- break;
- case ps_con:
- if (curdtyp != DTYPCON) {
- curdtyp = DTYPCON;
- curfrag++;
- }
- break;
- case ps_rom:
- if (curdtyp != DTYPROM) {
- curdtyp = DTYPROM;
- curfrag++;
- }
- ap = lnp->l_a.la_arg;
- rc = 0;
- while (ap != (arg_p) 0 && rc < MAXROM) {
- if (ap->a_typ == ARGOFF) {
- rombuf[rc++] = ap->a_a.a_offset;
- ap = ap->a_next;
- } else
- ap = (arg_p) 0;
- }
- goodrom = (rc >= 2);
- break;
- case ps_mes:
- break;
- case ps_inp:
- case ps_ina:
- local(lnp->l_a.la_sp);
- case ps_exp:
- case ps_exa:
- case ps_exc:
- oldline(lnp);
- continue;
- }
- lnp->l_next = p;
- p = lnp;
- }
- if (prodepth != 0)
- local(curpro.symbol);
- instrs = i; pseudos = p; curpro.lastline = (line_p) 0;
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mes.h"
-#include "lookup.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-cleanup() {
- FILE *infile;
- register c;
- register sym_p *spp,sp;
-
- for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- if ((sp->s_flags & SYMOUT) == 0)
- outdef(sp);
- if(!Lflag)
- return;
- c=fclose(outfile);
- assert(c != EOF);
- outfile = stdout;
- infile = fopen(template,"r");
- if (infile == NULL)
- error("temp file disappeared");
- outshort(sp_magic);
- outinst(ps_mes);
- outint(ms_ext);
- for (spp=symhash;spp< &symhash[NSYMHASH];spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- if ((sp->s_flags&(SYMDEF|SYMGLOBAL)) == (SYMDEF|SYMGLOBAL))
- outsym(sp);
- putc(sp_cend,outfile);
- while ( (c=getc(infile)) != EOF)
- putc(c,outfile);
- c=fclose(infile);
- assert(c != EOF);
- c=unlink(template);
- assert(c == 0);
-}
+++ /dev/null
-/* $Header$ */
-
-#ifndef FILE
-#include <stdio.h>
-#endif
-extern unsigned linecount;
-extern int prodepth;
-extern bool Lflag;
-extern bool nflag;
-extern byte em_flag[];
-extern line_p instrs,pseudos;
-extern FILE *outfile;
-extern char template[];
-extern offset wordsize;
-extern offset pointersize;
-extern char *progname;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "../../h/em_flag.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "alloc.h"
-#include "line.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-flow() {
-
- findreach(); /* determine reachable labels */
- cleaninstrs(); /* throw away unreachable code */
-}
-
-findreach() {
- register num_p *npp,np;
-
- reach(instrs);
- for(npp=curpro.numhash;npp< &curpro.numhash[NNUMHASH]; npp++)
- for(np= *npp; np != (num_p) 0 ; np = np->n_next)
- if (np->n_flags&NUMDATA) {
- np->n_repl->n_flags |= NUMREACH;
- np->n_repl->n_jumps++;
- if (!(np->n_flags&NUMSCAN)) {
- np->n_flags |= NUMSCAN;
- reach(np->n_line->l_next);
- }
- }
-}
-
-reach(lnp) register line_p lnp; {
- register num_p np;
-
- for (;lnp != (line_p) 0; lnp = lnp->l_next) {
- if(lnp->l_optyp == OPNUMLAB) {
- /*
- * Branch instruction or label
- */
- np = lnp->l_a.la_np;
- if ((lnp->l_instr&BMASK) != op_lab)
- np = np->n_repl;
- np->n_flags |= NUMREACH;
- if (!(np->n_flags&NUMSCAN)) {
- np->n_flags |= NUMSCAN;
- reach(np->n_line->l_next);
- }
- if ((lnp->l_instr&BMASK) == op_lab)
- return;
- else
- np->n_jumps++;
- }
- if ((em_flag[(lnp->l_instr&BMASK)-sp_fmnem]&EM_FLO)==FLO_T)
- return;
- }
-}
-
-cleaninstrs() {
- register line_p *lpp,lp,*lastbra;
- bool reachable,superfluous;
- int instr;
-
- lpp = &instrs; lastbra = (line_p *) 0; reachable = TRUE;
- while ((lp = *lpp) != (line_p) 0) {
- instr = lp->l_instr&BMASK;
- if (instr == op_lab) {
- if ((lp->l_a.la_np->n_flags&NUMREACH) != 0) {
- reachable = TRUE;
- if (lastbra != (line_p *) 0
- && (*lastbra)->l_next == lp
- && (*lastbra)->l_a.la_np->n_repl==lp->l_a.la_np) {
- oldline(*lastbra);
- OPTIM(O_BRALAB);
- lpp = lastbra;
- *lpp = lp;
- lastbra = (line_p *) 0;
- lp->l_a.la_np->n_jumps--;
- }
- }
- if ( lp->l_a.la_np->n_repl != lp->l_a.la_np ||
- ((lp->l_a.la_np->n_flags&NUMDATA)==0 &&
- lp->l_a.la_np->n_jumps == 0))
- superfluous = TRUE;
- else
- superfluous = FALSE;
- } else
- superfluous = FALSE;
- if ( (!reachable) || superfluous) {
- lp = lp->l_next;
- oldline(*lpp);
- OPTIM(O_UNREACH);
- *lpp = lp;
- } else {
- if ( instr <= sp_lmnem &&
- (em_flag[instr-sp_fmnem]&EM_FLO)==FLO_T) {
- reachable = FALSE;
- if ((lp->l_instr&BMASK) == op_bra)
- lastbra = lpp;
- }
- lpp = &lp->l_next;
- }
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_flag.h"
-#include "../../h/em_mes.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-static short tabval; /* temp store for shorts */
-static offset tabval2; /* temp store for offsets */
-static char string[IDL+1]; /* temp store for names */
-
-/*
- * The next constants are close to sp_cend for fast switches
- */
-#define INST 256 /* instruction: number in tabval */
-#define PSEU 257 /* pseudo: number in tabval */
-#define ILBX 258 /* label: number in tabval */
-#define DLBX 259 /* symbol: name in string[] */
-#define CSTX1 260 /* short constant: stored in tabval */
-#define CSTX2 261 /* offset: value in tabval2 */
-#define VALX1 262 /* symbol+short: in string[] and tabval */
-#define VALX2 263 /* symbol+offset: in string[] and tabval2 */
-#define ATEOF 264 /* bumped into end of file */
-
-#define readbyte getchar
-
-short readshort() {
- register int l_byte, h_byte;
-
- l_byte = readbyte();
- h_byte = readbyte();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-#ifdef LONGOFF
-offset readoffset() {
- register long l;
- register int h_byte;
-
- l = readbyte();
- l |= ((unsigned) readbyte())*256 ;
- l |= readbyte()*256L*256L ;
- h_byte = readbyte() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-#endif
-
-draininput() {
-
- /*
- * called when MES ERR is encountered.
- * Drain input in case it is a pipe.
- */
-
- while (getchar() != EOF)
- ;
-}
-
-short getint() {
-
- switch(table2()) {
- default: error("int expected");
- case CSTX1:
- return(tabval);
- }
-}
-
-sym_p getsym(status) int status; {
-
- switch(table2()) {
- default:
- error("symbol expected");
- case DLBX:
- return(symlookup(string,status,0));
- case sp_pnam:
- return(symlookup(string,status,SYMPRO));
- }
-}
-
-offset getoff() {
-
- switch (table2()) {
- default: error("offset expected");
- case CSTX1:
- return((offset) tabval);
-#ifdef LONGOFF
- case CSTX2:
- return(tabval2);
-#endif
- }
-}
-
-make_string(n) int n; {
- register char *s;
- extern char *sprintf();
-
- s=sprintf(string,".%u",n);
- assert(s == string);
-}
-
-inident() {
- register n;
- register char *p = string;
- register c;
-
- n = getint();
- while (n--) {
- c = readbyte();
- if (p<&string[IDL])
- *p++ = c;
- }
- *p++ = 0;
-}
-
-int table3(n) int n; {
-
- switch (n) {
- case sp_ilb1: tabval = readbyte(); return(ILBX);
- case sp_ilb2: tabval = readshort(); return(ILBX);
- case sp_dlb1: make_string(readbyte()); return(DLBX);
- case sp_dlb2: make_string(readshort()); return(DLBX);
- case sp_dnam: inident(); return(DLBX);
- case sp_pnam: inident(); return(n);
- case sp_cst2: tabval = readshort(); return(CSTX1);
-#ifdef LONGOFF
- case sp_cst4: tabval2 = readoffset(); return(CSTX2);
-#endif
- case sp_doff: if (table2()!=DLBX) error("symbol expected");
- switch(table2()) {
- default: error("offset expected");
- case CSTX1: return(VALX1);
-#ifdef LONGOFF
- case CSTX2: return(VALX2);
-#endif
- }
- default: return(n);
- }
-}
-
-int table1() {
- register n;
-
- n = readbyte();
- if (n == EOF)
- return(ATEOF);
- if ((n <= sp_lmnem) && (n >= sp_fmnem)) {
- tabval = n;
- return(INST);
- }
- if ((n <= sp_lpseu) && (n >= sp_fpseu)) {
- tabval = n;
- return(PSEU);
- }
- if ((n < sp_filb0 + sp_nilb0) && (n >= sp_filb0)) {
- tabval = n - sp_filb0;
- return(ILBX);
- }
- return(table3(n));
-}
-
-int table2() {
- register n;
-
- n = readbyte();
- if ((n < sp_fcst0 + sp_ncst0) && (n >= sp_fcst0)) {
- tabval = n - sp_zcst0;
- return(CSTX1);
- }
- return(table3(n));
-}
-
-getlines() {
- register line_p lnp;
- register instr;
-
- for(;;) {
- linecount++;
- switch(table1()) {
- default:
- error("unknown instruction byte");
- /* NOTREACHED */
-
- case ATEOF:
- if (prodepth!=0)
- error("procedure unterminated at eof");
- process();
- return;
- case INST:
- tstinpro();
- instr = tabval;
- break;
- case DLBX:
- lnp = newline(OPSYMBOL);
- lnp->l_instr = ps_sym;
- lnp->l_a.la_sp= symlookup(string,DEFINING,0);
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- continue;
- case ILBX:
- tstinpro();
- lnp = newline(OPNUMLAB);
- lnp->l_instr = op_lab;
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- if (lnp->l_a.la_np->n_line != (line_p) 0)
- error("label %u multiple defined",(unsigned) tabval);
- lnp->l_a.la_np->n_line = lnp;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- continue;
- case PSEU:
- if(inpseudo(tabval))
- return;
- continue;
- }
-
- /*
- * Now we have an instruction number in instr
- * There might be an operand, look for it
- */
-
- if ((em_flag[instr-sp_fmnem]&EM_PAR)==PAR_NO) {
- lnp = newline(OPNO);
- } else switch(table2()) {
- default:
- error("unknown offset byte");
- case sp_cend:
- lnp = newline(OPNO);
- break;
- case CSTX1:
- if ((em_flag[instr-sp_fmnem]&EM_PAR)!= PAR_B) {
- if (CANMINI(tabval))
- lnp = newline(tabval+Z_OPMINI);
- else {
- lnp = newline(OPSHORT);
- lnp->l_a.la_short = tabval;
- }
- } else {
- lnp = newline(OPNUMLAB);
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- }
- break;
-#ifdef LONGOFF
- case CSTX2:
- lnp = newline(OPOFFSET);
- lnp->l_a.la_offset = tabval2;
- break;
-#endif
- case ILBX:
- tstinpro();
- lnp = newline(OPNUMLAB);
- lnp->l_a.la_np = numlookup((unsigned) tabval);
- break;
- case DLBX:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = symlookup(string,OCCURRING,0);
- break;
- case sp_pnam:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = symlookup(string,OCCURRING,SYMPRO);
- break;
- case VALX1:
- lnp = newline(OPSVAL);
- lnp->l_a.la_sval.lasv_sp = symlookup(string,OCCURRING,0);
- lnp->l_a.la_sval.lasv_short = tabval;
- break;
-#ifdef LONGOFF
- case VALX2:
- lnp = newline(OPLVAL);
- lnp->l_a.la_lval.lalv_sp = symlookup(string,OCCURRING,0);
- lnp->l_a.la_lval.lalv_offset = tabval2;
- break;
-#endif
- }
- lnp->l_instr = instr;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- }
-}
-
-argstring(length,abp) offset length; register argb_p abp; {
-
- while (length--) {
- if (abp->ab_index == NARGBYTES)
- abp = abp->ab_next = newargb();
- abp->ab_contents[abp->ab_index++] = readbyte();
- }
-}
-
-line_p arglist(n) int n; {
- line_p lnp;
- register arg_p ap,*app;
- bool moretocome;
- offset length;
-
-
- /*
- * creates an arglist with n elements
- * if n == 0 the arglist is variable and terminated by sp_cend
- */
-
- lnp = newline(OPLIST);
- app = &lnp->l_a.la_arg;
- moretocome = TRUE;
- do {
- switch(table2()) {
- default:
- error("unknown byte in arglist");
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- *app = ap = newarg(ARGOFF);
- ap->a_a.a_offset = tabval2;
- app = &ap->a_next;
- break;
- case ILBX:
- tstinpro();
- *app = ap = newarg(ARGNUM);
- ap->a_a.a_np = numlookup((unsigned) tabval);
- ap->a_a.a_np->n_flags |= NUMDATA;
- app = &ap->a_next;
- break;
- case DLBX:
- *app = ap = newarg(ARGSYM);
- ap->a_a.a_sp = symlookup(string,OCCURRING,0);
- app = &ap->a_next;
- break;
- case sp_pnam:
- *app = ap = newarg(ARGSYM);
- ap->a_a.a_sp = symlookup(string,OCCURRING,SYMPRO);
- app = &ap->a_next;
- break;
- case VALX1:
- tabval2 = (offset) tabval;
- case VALX2:
- *app = ap = newarg(ARGVAL);
- ap->a_a.a_val.av_sp = symlookup(string,OCCURRING,0);
- ap->a_a.a_val.av_offset = tabval2;
- app = &ap->a_next;
- break;
- case sp_scon:
- *app = ap = newarg(ARGSTR);
- length = getoff();
- argstring(length,&ap->a_a.a_string);
- app = &ap->a_next;
- break;
- case sp_icon:
- *app = ap = newarg(ARGICN);
- goto casecon;
- case sp_ucon:
- *app = ap = newarg(ARGUCN);
- goto casecon;
- case sp_fcon:
- *app = ap = newarg(ARGFCN);
- casecon:
- length = getint();
- ap->a_a.a_con.ac_length = (short) length;
- argstring(getoff(),&ap->a_a.a_con.ac_con);
- app = &ap->a_next;
- break;
- case sp_cend:
- moretocome = FALSE;
- }
- if (n && (--n) == 0)
- moretocome = FALSE;
- } while (moretocome);
- return(lnp);
-}
-
-offset aoff(ap,n) register arg_p ap; {
-
- while (n>0) {
- if (ap != (arg_p) 0)
- ap = ap->a_next;
- n--;
- }
- if (ap == (arg_p) 0)
- error("too few parameters");
- if (ap->a_typ != ARGOFF)
- error("offset expected");
- return(ap->a_a.a_offset);
-}
-
-int inpseudo(n) short n; {
- register line_p lnp,head,tail;
- short n1,n2;
- proinf savearea;
-#ifdef PSEUBETWEEN
- static int pcount=0;
-
- if (pcount++ >= PSEUBETWEEN && prodepth==0) {
- process();
- pcount=0;
- }
-#endif
-
- switch(n) {
- default:
- error("unknown pseudo");
- case ps_bss:
- case ps_hol:
- lnp = arglist(3);
- break;
- case ps_rom:
- case ps_con:
- lnp = arglist(0);
- break;
- case ps_ina:
- case ps_inp:
- case ps_exa:
- case ps_exp:
- lnp = newline(OPSYMBOL);
- lnp->l_a.la_sp = getsym(NOTHING);
- break;
- case ps_exc:
- n1 = getint(); n2 = getint();
- if (n1 != 0 && n2 != 0) {
- tail = curpro.lastline;
- while (--n2) tail = tail->l_next;
- head = tail;
- while (n1--) head = head->l_next;
- lnp = tail->l_next;
- tail->l_next = head->l_next;
- head->l_next = curpro.lastline;
- curpro.lastline = lnp;
- }
- lnp = newline(OPNO);
- break;
- case ps_mes:
- lnp = arglist(0);
- switch((int) aoff(lnp->l_a.la_arg,0)) {
- case ms_err:
- draininput(); exit(-1);
- case ms_opt:
- nflag = TRUE; break;
- case ms_emx:
- wordsize = aoff(lnp->l_a.la_arg,1);
- pointersize = aoff(lnp->l_a.la_arg,2);
-#ifndef LONGOFF
- if (wordsize>2)
- error("This optimizer cannot handle wordsize>2");
-#endif
- break;
- case ms_gto:
- curpro.gtoproc=1;
- /* Treat as empty mes ms_reg */
- case ms_reg:
- tstinpro();
- regvar(lnp->l_a.la_arg->a_next);
- oldline(lnp);
- lnp=newline(OPNO);
- n=ps_exc; /* kludge to force out this line */
- break;
- }
- break;
- case ps_pro:
- if (prodepth>0)
- savearea = curpro;
- else
- process();
- curpro.symbol = getsym(DEFINING);
- switch(table2()) {
- case sp_cend:
- curpro.localbytes = (offset) -1;
- break;
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- curpro.localbytes = tabval2;
- break;
- default:
- error("bad second arg of PRO");
- }
- prodepth++;
- curpro.gtoproc=0;
- if (prodepth>1) {
- register i;
-
- curpro.lastline = (line_p) 0;
- curpro.freg = (reg_p) 0;
- for(i=0;i<NNUMHASH;i++)
- curpro.numhash[i] = (num_p) 0;
- getlines();
- curpro = savearea;
- prodepth--;
- }
- return(0);
- case ps_end:
- if (prodepth==0)
- error("END misplaced");
- switch(table2()) {
- case sp_cend:
- if (curpro.localbytes == (offset) -1)
- error("bytes for locals still unknown");
- break;
- case CSTX1:
- tabval2 = (offset) tabval;
- case CSTX2:
- if (curpro.localbytes != (offset) -1 && curpro.localbytes != tabval2)
- error("inconsistency in number of bytes for locals");
- curpro.localbytes = tabval2;
- break;
- }
- process();
- curpro.symbol = (sym_p) 0;
- if (prodepth==1) {
- prodepth=0;
-#ifdef PSEUBETWEEN
- pcount=0;
-#endif
- return(0);
- } else
- return(1);
- }
- lnp->l_instr = n;
- lnp->l_next = curpro.lastline;
- curpro.lastline = lnp;
- return(0);
-}
-
-tstinpro() {
-
- if (prodepth==0)
- error("This is not allowed outside a procedure");
-}
+++ /dev/null
-/* $Header$ */
-
-#define NARGBYTES 14
-struct argbytes {
- argb_p ab_next;
- short ab_index;
- char ab_contents[NARGBYTES];
-};
-
-typedef struct {
- sym_p av_sp;
- offset av_offset;
-} s_a_val;
-
-typedef struct {
- short ac_length;
- argb_t ac_con;
-} s_a_con;
-
-typedef union {
- offset a_offset;
- num_p a_np;
- sym_p a_sp;
- s_a_val a_val;
- argb_t a_string;
- s_a_con a_con;
-} un_a_a;
-
-struct arg {
- arg_p a_next;
- short a_typ;
- un_a_a a_a;
-};
-
-/* possible values for .a_typ
- */
-
-#define ARGOFF 0
-#define ARGNUM 1
-#define ARGSYM 2
-#define ARGVAL 3
-#define ARGSTR 4
-#define ARGICN 5
-#define ARGUCN 6
-#define ARGFCN 7
-
-typedef struct {
- sym_p lasv_sp;
- short lasv_short;
-} s_la_sval;
-
-typedef struct {
- sym_p lalv_sp;
- offset lalv_offset;
-} s_la_lval;
-
-typedef union {
- short la_short;
- offset la_offset;
- num_p la_np;
- sym_p la_sp;
- s_la_sval la_sval;
- s_la_lval la_lval;
- arg_p la_arg;
-} un_l_a;
-
-struct line {
- line_p l_next; /* maintains linked list */
- byte l_instr; /* instruction number */
- byte l_optyp; /* specifies what follows */
- un_l_a l_a;
-};
-
-/* Possible values for .l_optyp */
-
-#define OPNO 0 /* no operand */
-#define OPSHORT 1 /* 16 bit number */
-#define OPOFFSET 2 /* 16 or 32 bit number */
-#define OPNUMLAB 3 /* local label for branches */
-#define OPSYMBOL 4 /* global label or procedurename */
-#define OPSVAL 5 /* symbol + 16 bit constant */
-#define OPLVAL 6 /* symbol + 16 or 32 bit constant */
-#define OPLIST 7 /* operand list for some pseudos */
-#define OPMINI 8 /* start of minis */
-
-#define Z_OPMINI (OPMINI+100) /* tunable */
-
-#define CANMINI(x) ((x)>=OPMINI-Z_OPMINI && (x)<256-Z_OPMINI)
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "lookup.h"
-#include "alloc.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned hash(string) char *string; {
- register char *p;
- register unsigned i,sum;
-
- for (sum=i=0,p=string;*p;i += 3)
- sum ^= (*p++)<<(i&07);
- return(sum);
-}
-
-sym_p symlookup(name,status,flags) char *name; int status,flags; {
- register sym_p *spp,sp;
- register i;
- static short genfrag = 32767;
-
- spp = &symhash[hash(name)%NSYMHASH];
- while (*spp != (sym_p) 0)
- if (strncmp((*spp)->s_name,name,IDL)==0) {
- sp = *spp;
- if ((sp->s_flags^flags)&SYMPRO)
- error("%s is both proc and datalabel",name);
- if (status == DEFINING) {
- if (sp->s_flags&SYMDEF)
- error("redefined symbol %s",name);
- sp->s_flags |= SYMDEF;
- }
- return(sp);
- } else
- spp = &(*spp)->s_next;
-
- /*
- * symbol not found, enter in table
- */
-
- i = strlen(name) + 1;
- if (i & 1)
- i++;
- if (i > IDL)
- i = IDL;
- *spp = sp = newsym(i);
- strncpy(sp->s_name,name,i);
- sp->s_flags = flags;
- if (status == DEFINING)
- sp->s_flags |= SYMDEF;
- sp->s_frag = genfrag--;
- return(sp);
-}
-
-num_p numlookup(number) unsigned number; {
- register num_p *npp, np;
-
- npp = &curpro.numhash[number%NNUMHASH];
- while (*npp != (num_p) 0)
- if ((*npp)->n_number == number)
- return(*npp);
- else
- npp = &(*npp)->n_next;
-
- /*
- * local label not found, enter in tabel
- */
-
- *npp = np = newnum();
- np->n_number = number;
- np->n_repl = np;
- return(np);
-}
+++ /dev/null
-/* $Header$ */
-
-#define IDL 100
-
-struct sym {
- sym_p s_next;
- offset *s_rom;
- short s_flags;
- short s_frag;
- offset s_value;
- char s_name[2]; /* to be extended up to IDL */
-};
-
-/* contents of .s_flags */
-#define SYMPRO 000001
-#define SYMGLOBAL 000002
-#define SYMKNOWN 000004
-#define SYMOUT 000010
-#define SYMDEF 000020
-
-#define NSYMHASH 127
-extern sym_p symhash[NSYMHASH],symlookup();
-#define OCCURRING 0
-#define DEFINING 1
-#define NOTHING 2
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "alloc.h"
-#include "../../h/em_spec.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/*
- * Main program for EM optimizer
- */
-
-main(argc,argv) int argc; char *argv[]; {
- short somespace[STACKROOM];
-
- progname = argv[0];
- while (argc-->1 && **++argv == '-')
- flags(*argv);
- if (argc>1) {
- fprintf(stderr,"Usage: %s [-Ln] [name]\n",progname);
- exit(-1);
- }
- if (argc)
- if (freopen(*argv,"r",stdin) == NULL)
- error("Cannot open %s",*argv);
- fileinit();
- coreinit(somespace,somespace+STACKROOM);
- getlines();
- cleanup();
- return(0);
-}
-
-flags(s) register char *s; {
-
- for (s++;*s;s++)
- switch(*s) {
- case 'L': Lflag = TRUE; break;
- case 'n': nflag = TRUE; break;
- }
-}
-
-fileinit() {
- char *mktemp();
- short readshort();
-
- if (readshort() != (short) sp_magic)
- error("wrong input file");
- if (Lflag) {
- outfile = fopen(mktemp(template),"w");
- if (outfile == NULL)
- error("can't create %s",template);
- } else {
- outfile = stdout;
- outshort(sp_magic);
- }
-}
+++ /dev/null
-: '$Header$'
-for extension in c y
-do
- for file in *.$extension
- do ofile=`basename $file .$extension`.o
- grep '^# *include.*"' $file|sed "s/.*\"\(.*\)\".*/$ofile: \1/"
- done
-done | sort -u >depend
-ed - Makefile <<'!'
-/AUTOAUTOAUTO/+,$d
-$r depend
-w
-q
-!
-rm -f depend
+++ /dev/null
-%{
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "pattern.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "optim.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define MAXNODES 1000
-expr_t nodes[MAXNODES];
-expr_p lastnode = nodes+1;
-int curind,prevind;
-int patlen,maxpatlen,rpllen;
-int lino = 1;
-int patno=1;
-#define MAX 100
-int patmnem[MAX],rplmnem[MAX],rplexpr[MAX];
-byte nparam[N_EX_OPS];
-bool nonumlab[N_EX_OPS];
-bool onlyconst[N_EX_OPS];
-int nerrors=0;
-%}
-
-%union {
- int y_int;
-}
-
-%left OR2
-%left AND2
-%left OR1
-%left XOR1
-%left AND1
-%left CMPEQ,CMPNE
-%left CMPLT,CMPLE,CMPGT,CMPGE
-%left RSHIFT,LSHIFT
-%left ARPLUS,ARMINUS
-%left ARTIMES,ARDIVIDE,ARMOD
-%nonassoc NOT,COMP,UMINUS
-%nonassoc '$'
-
-%token SFIT,UFIT,NOTREG,PSIZE,WSIZE,DEFINED,SAMESIGN,ROM,ROTATE
-%token <y_int> MNEM
-%token <y_int> NUMBER
-%type <y_int> expr,argno,optexpr
-
-%start patternlist
-
-%%
-patternlist
- : /* empty */
- | patternlist '\n'
- | patternlist pattern
- ;
-pattern :
- mnemlist optexpr ':' replacement '\n'
- { register i;
- outbyte(0); outshort(prevind); prevind=curind-3;
- out(patlen);
- for (i=0;i<patlen;i++) outbyte(patmnem[i]);
- out($2);
- out(rpllen);
- for (i=0;i<rpllen;i++) {
- outbyte(rplmnem[i]);
- out(rplexpr[i]);
- }
-#ifdef DIAGOPT
- outshort(patno);
-#endif
- patno++;
- printf("\n");
- if (patlen>maxpatlen) maxpatlen=patlen;
- }
- | error '\n'
- { yyerrok; }
- ;
-replacement
- : expr /* special optimization */
- {
-#ifdef ALLOWSPECIAL
- rpllen=1; rplmnem[0]=0; rplexpr[0]=$1;
-#else
- yyerror("No specials allowed");
-#endif
- }
- | repllist
- ;
-repllist: /* empty */
- { rpllen=0; }
- | repllist repl
- ;
-repl : MNEM optexpr
- { rplmnem[rpllen] = $1; rplexpr[rpllen++] = $2; }
- ;
-mnemlist: MNEM
- { patlen=0; patmnem[patlen++] = $1; }
- | mnemlist MNEM
- { patmnem[patlen++] = $2; }
- ;
-optexpr : /* empty */
- { $$ = 0; }
- | expr
- ;
-expr
- : '$' argno
- { $$ = lookup(0,EX_ARG,$2,0); }
- | NUMBER
- { $$ = lookup(0,EX_CON,(int)(short)$1,0); }
- | PSIZE
- { $$ = lookup(0,EX_POINTERSIZE,0,0); }
- | WSIZE
- { $$ = lookup(0,EX_WORDSIZE,0,0); }
- | DEFINED '(' expr ')'
- { $$ = lookup(0,EX_DEFINED,$3,0); }
- | SAMESIGN '(' expr ',' expr ')'
- { $$ = lookup(1,EX_SAMESIGN,$3,$5); }
- | SFIT '(' expr ',' expr ')'
- { $$ = lookup(0,EX_SFIT,$3,$5); }
- | UFIT '(' expr ',' expr ')'
- { $$ = lookup(0,EX_UFIT,$3,$5); }
- | ROTATE '(' expr ',' expr ')'
- { $$ = lookup(0,EX_ROTATE,$3,$5); }
- | NOTREG '(' expr ')'
- { $$ = lookup(0,EX_NOTREG,$3,0); }
- | ROM '(' argno ',' expr ')'
- { $$ = lookup(0,EX_ROM,$3,$5); }
- | '(' expr ')'
- { $$ = $2; }
- | expr CMPEQ expr
- { $$ = lookup(1,EX_CMPEQ,$1,$3); }
- | expr CMPNE expr
- { $$ = lookup(1,EX_CMPNE,$1,$3); }
- | expr CMPGT expr
- { $$ = lookup(0,EX_CMPGT,$1,$3); }
- | expr CMPGE expr
- { $$ = lookup(0,EX_CMPGE,$1,$3); }
- | expr CMPLT expr
- { $$ = lookup(0,EX_CMPLT,$1,$3); }
- | expr CMPLE expr
- { $$ = lookup(0,EX_CMPLE,$1,$3); }
- | expr OR2 expr
- { $$ = lookup(0,EX_OR2,$1,$3); }
- | expr AND2 expr
- { $$ = lookup(0,EX_AND2,$1,$3); }
- | expr OR1 expr
- { $$ = lookup(1,EX_OR1,$1,$3); }
- | expr XOR1 expr
- { $$ = lookup(1,EX_XOR1,$1,$3); }
- | expr AND1 expr
- { $$ = lookup(1,EX_AND1,$1,$3); }
- | expr ARPLUS expr
- { $$ = lookup(1,EX_PLUS,$1,$3); }
- | expr ARMINUS expr
- { $$ = lookup(0,EX_MINUS,$1,$3); }
- | expr ARTIMES expr
- { $$ = lookup(1,EX_TIMES,$1,$3); }
- | expr ARDIVIDE expr
- { $$ = lookup(0,EX_DIVIDE,$1,$3); }
- | expr ARMOD expr
- { $$ = lookup(0,EX_MOD,$1,$3); }
- | expr LSHIFT expr
- { $$ = lookup(0,EX_LSHIFT,$1,$3); }
- | expr RSHIFT expr
- { $$ = lookup(0,EX_RSHIFT,$1,$3); }
- | ARPLUS expr %prec UMINUS
- { $$ = $2; }
- | ARMINUS expr %prec UMINUS
- { $$ = lookup(0,EX_UMINUS,$2,0); }
- | NOT expr
- { $$ = lookup(0,EX_NOT,$2,0); }
- | COMP expr
- { $$ = lookup(0,EX_COMP,$2,0); }
- ;
-argno : NUMBER
- { if ($1<1 || $1>patlen) {
- YYERROR;
- }
- $$ = (int) $1;
- }
- ;
-
-%%
-
-extern char em_mnem[][4];
-
-#define HASHSIZE (2*(sp_lmnem-sp_fmnem))
-
-struct hashmnem {
- char h_name[3];
- byte h_value;
-} hashmnem[HASHSIZE];
-
-inithash() {
- register i;
-
- enter("lab",op_lab);
- enter("LLP",op_LLP);
- enter("LEP",op_LEP);
- enter("SLP",op_SLP);
- enter("SEP",op_SEP);
- for(i=0;i<=sp_lmnem-sp_fmnem;i++)
- enter(em_mnem[i],i+sp_fmnem);
-}
-
-unsigned hashname(name) register char *name; {
- register unsigned h;
-
- h = (*name++)&BMASK;
- h = (h<<4)^((*name++)&BMASK);
- h = (h<<4)^((*name++)&BMASK);
- return(h);
-}
-
-enter(name,value) char *name; {
- register unsigned h;
-
- h=hashname(name)%HASHSIZE;
- while (hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- strncpy(hashmnem[h].h_name,name,3);
- hashmnem[h].h_value = value;
-}
-
-int mlookup(name) char *name; {
- register unsigned h;
-
- h = hashname(name)%HASHSIZE;
- while (strncmp(hashmnem[h].h_name,name,3) != 0 &&
- hashmnem[h].h_name[0] != 0)
- h = (h+1)%HASHSIZE;
- return(hashmnem[h].h_value&BMASK); /* 0 if not found */
-}
-
-main() {
-
- inithash();
- initio();
- yyparse();
- if (nerrors==0)
- printnodes();
- return nerrors;
-}
-
-yyerror(s) char *s; {
-
- fprintf(stderr,"line %d: %s\n",lino,s);
- nerrors++;
-}
-
-lookup(comm,operator,lnode,rnode) {
- register expr_p p;
-
- for (p=nodes+1;p<lastnode;p++) {
- if (p->ex_operator != operator)
- continue;
- if (!(p->ex_lnode == lnode && p->ex_rnode == rnode ||
- comm && p->ex_lnode == rnode && p->ex_rnode == lnode))
- continue;
- return(p-nodes);
- }
- if (lastnode >= &nodes[MAXNODES])
- yyerror("node table overflow");
- lastnode++;
- p->ex_operator = operator;
- p->ex_lnode = lnode;
- p->ex_rnode = rnode;
- return(p-nodes);
-}
-
-printnodes() {
- register expr_p p;
-
- printf("};\n\nshort lastind = %d;\n\nexpr_t enodes[] = {\n",prevind);
- for (p=nodes;p<lastnode;p++)
- printf("/* %3d */\t%3d,%6u,%6u,\n",
- p-nodes,p->ex_operator,p->ex_lnode,p->ex_rnode);
- printf("};\n\niarg_t iargs[%d];\n",maxpatlen);
-}
-
-initio() {
- register i;
-
- printf("#include \"param.h\"\n#include \"types.h\"\n");
- printf("#include \"pattern.h\"\n\n");
- for(i=0;i<N_EX_OPS;i++) {
- nparam[i]=2;
- nonumlab[i]=TRUE;
- onlyconst[i]=TRUE;
- }
- nparam[EX_POINTERSIZE] = 0;
- nparam[EX_WORDSIZE] = 0;
- nparam[EX_CON] = 0;
- nparam[EX_ROM] = 0;
- nparam[EX_ARG] = 0;
- nparam[EX_DEFINED] = 0;
- nparam[EX_OR2] = 1;
- nparam[EX_AND2] = 1;
- nparam[EX_UMINUS] = 1;
- nparam[EX_NOT] = 1;
- nparam[EX_COMP] = 1;
- nparam[EX_NOTREG] = 1;
- nonumlab[EX_CMPEQ] = FALSE;
- nonumlab[EX_CMPNE] = FALSE;
- onlyconst[EX_CMPEQ] = FALSE;
- onlyconst[EX_CMPNE] = FALSE;
- onlyconst[EX_CMPLE] = FALSE;
- onlyconst[EX_CMPLT] = FALSE;
- onlyconst[EX_CMPGE] = FALSE;
- onlyconst[EX_CMPGT] = FALSE;
- onlyconst[EX_PLUS] = FALSE;
- onlyconst[EX_MINUS] = FALSE;
- printf("byte nparam[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",nparam[i]);
- printf("};\nbool nonumlab[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",nonumlab[i]);
- printf("};\nbool onlyconst[] = {");
- for (i=0;i<N_EX_OPS;i++) printf("%d,",onlyconst[i]);
- printf("};\n\nbyte pattern[] = { 0\n");
- curind = 1;
-}
-
-outbyte(b) {
-
- printf(",%3d",b);
- curind++;
-}
-
-outshort(s) {
-
- outbyte(s&0377);
- outbyte((s>>8)&0377);
-}
-
-out(w) {
-
- if (w<255) {
- outbyte(w);
- } else {
- outbyte(255);
- outshort(w);
- }
-}
-
-#include "scan.c"
+++ /dev/null
-/* $Header$ */
-
-/* #define DIAGOPT /* if defined diagnostics are produced */
-#ifdef DIAGOPT
-#define OPTIM(x) optim(x)
-#define O_UNREACH 1001
-#define O_BRALAB 1002
-#define O_LINLNI 1003
-#define O_LINGONE 1004
-#else
-#define OPTIM(x) /* NOTHING */
-#endif
+++ /dev/null
-/* $Header$ */
-
-#define LONGOFF /* if defined long offsets are used */
-
-#define TRUE 1
-#define FALSE 0
-
-#define MAXROM 3
-
-#define op_lab (sp_lmnem+1)
-#define op_last op_lab
-#define ps_sym (sp_lpseu+1)
-#define ps_last ps_sym
-
-#define BMASK 0377
+++ /dev/null
-/* $Header$ */
-
-/*
- * pattern contains the optimization patterns in an apparently
- * unordered fashion. All patterns follow each other unaligned.
- * Each pattern looks as follows:
- * Byte 0: high byte of hash value associated with this pattern.
- * Byte 1-2: index of next pattern with same low byte of hash value.
- * Byte 3- : pattern and replacement.
- * First comes the pattern length
- * then the pattern opcodes,
- * then a boolean expression,
- * then the one-byte replacement length
- * then the intermixed pattern opcodes and operands or
- * 0 followed by the one-byte special optimization expression.
- * If the DIAGOPT option is set, the optimization is followed
- * by the line number in the tables.
- */
-
-/* #define ALLOWSPECIAL /* Special optimizations allowed */
-
-#define PO_HASH 0
-#define PO_NEXT 1
-#define PO_MATCH 3
-
-struct exprnode {
- short ex_operator;
- short ex_lnode;
- short ex_rnode;
-};
-typedef struct exprnode expr_t;
-typedef struct exprnode *expr_p;
-
-/*
- * contents of .ex_operator
- */
-
-#define EX_CON 0
-#define EX_ARG 1
-#define EX_CMPEQ 2
-#define EX_CMPNE 3
-#define EX_CMPGT 4
-#define EX_CMPGE 5
-#define EX_CMPLT 6
-#define EX_CMPLE 7
-#define EX_OR2 8
-#define EX_AND2 9
-#define EX_OR1 10
-#define EX_XOR1 11
-#define EX_AND1 12
-#define EX_PLUS 13
-#define EX_MINUS 14
-#define EX_TIMES 15
-#define EX_DIVIDE 16
-#define EX_MOD 17
-#define EX_LSHIFT 18
-#define EX_RSHIFT 19
-#define EX_UMINUS 20
-#define EX_NOT 21
-#define EX_COMP 22
-#define EX_ROM 23
-#define EX_NOTREG 24
-#define EX_POINTERSIZE 25
-#define EX_WORDSIZE 26
-#define EX_DEFINED 27
-#define EX_SAMESIGN 28
-#define EX_SFIT 29
-#define EX_UFIT 30
-#define EX_ROTATE 31
-#define N_EX_OPS 32 /* must be one higher then previous */
-
-
-/*
- * Definition of special opcodes used in patterns
- */
-
-#define op_pfirst op_LLP
-#define op_LLP (op_last+1)
-#define op_LEP (op_last+2)
-#define op_SLP (op_last+3)
-#define op_SEP (op_last+4)
-#define op_plast op_SEP
-
-/*
- * Definition of the structure in which instruction operands
- * are kept during pattern matching.
- */
-
-typedef struct eval eval_t;
-typedef struct eval *eval_p;
-
-struct eval {
- short e_typ;
- union {
- offset e_con;
- num_p e_np;
- } e_v;
-};
-
-/*
- * contents of .e_typ
- */
-#define EV_UNDEF 0
-#define EV_CONST 1
-#define EV_NUMLAB 2
-#define EV_FRAG 3 /* and all higher numbers */
-
-typedef struct iarg iarg_t;
-typedef struct iarg *iarg_p;
-
-struct iarg {
- eval_t ia_ev;
- sym_p ia_sp;
-};
-
-/*
- * The next extern declarations refer to data generated by mktab
- */
-
-extern byte pattern[];
-extern short lastind;
-extern iarg_t iargs[];
-extern byte nparam[];
-extern bool nonumlab[];
-extern bool onlyconst[];
-extern expr_t enodes[];
+++ /dev/null
-/* $Header$ */
-loc adi loc sbi $2==w && $4==w: loc $1-$3 adi w
-ldc adi ldc sbi $2==2*w && $4==2*w: ldc $1-$3 adi 2*w
-loc adi loc adi $2==w && $4==w: loc $1+$3 adi w
-ldc adi ldc adi $2==2*w && $4==2*w: ldc $1+$3 adi 2*w
-adp $1==0:
-adp adp : adp $1+$2
-adp lof : lof $1+$2
-adp ldf : ldf $1+$2
-adp loi $1!=0 && $2==w: lof $1
-adp loi $1!=0 && $2==2*w: ldf $1
-adp stf : stf $1+$2
-adp sdf : sdf $1+$2
-adp sti $1!=0 && $2==w: stf $1
-adp sti $1!=0 && $2==2*w: sdf $1
-asp $1==0:
-asp asp : asp $1+$2
-blm $1==0 : asp 2*p
-cmi zeq $1==w: beq $2
-cmi zge $1==w: bge $2
-cmi zgt $1==w: bgt $2
-cmi zle $1==w: ble $2
-cmi zlt $1==w: blt $2
-cmi zne $1==w: bne $2
-dvi ngi $1==$2: ngi $1 dvi $1
-lae adp : lae $1+$2
-lae blm $2==w: loi w ste $1
-lae blm $2==2*w: loi 2*w sde $1
-lae ldf : lde $1+$2
-lae lof : loe $1+$2
-lae loi $2==w: loe $1
-lae loi $2==2*w: lde $1
-#ifdef INT
-lae loi loe $3==$1-w && $2%w==0: lae $3 loi $2+w
-lae loi lde $3==$1-2*w && $2%w==0: lae $3 loi $2+2*w
-lae loi lae loi $1==$3+$4 && $2%w==0 && $4%w==0: lae $3 loi $2+$4
-lae sti ste $3==$1+$2: lae $1 sti $2+w
-lae sti sde $3==$1+$2: lae $1 sti $2+2*w
-lae sti loc ste $4==$1-w: loc $3 lae $4 sti $2+w
-lae sti lol ste $4==$1-w: lol $3 lae $4 sti $2+w
-#endif
-lae lae blm loe ste $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+w
-lae lae blm lde sde $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+2*w
-lae lae blm lae lae blm $4==$1+$3 && $5==$2+$3: lae $1 lae $2 blm $3+$6
-lae lal blm lae lal blm $4==$1+$3 && $5==$2+$3 && samesign($2,$5):
- lae $1 lal $2 blm $3+$6
-lal lae blm lal lae blm $4==$1+$3 && $5==$2+$3 && samesign($1,$4):
- lal $1 lae $2 blm $3+$6
-lal lal blm lal lal blm $4==$1+$3 && $5==$2+$3 && samesign($1,$4) && samesign($2,$5):
- lal $1 lal $2 blm $3+$6
-lal lal sbs $3==w && samesign($1,$2): loc $1-$2
-lae sdf : sde $1+$2
-lae stf : ste $1+$2
-lae sti $2==w: ste $1
-lae sti $2==2*w: sde $1
-lal adp samesign($1,$1+$2): lal $1+$2
-lal blm $2==w: loi w stl $1
-lal blm $2==2*w: loi 2*w sdl $1
-#ifdef INT
-lal sti loc stl notreg($4) && $4==$1-w && samesign($1,$4):
- loc $3 lal $4 sti $2+w
-lal sti loe stl notreg($4) && $4==$1-w && samesign($1,$4):
- loe $3 lal $4 sti $2+w
-#endif
-lal ldf samesign($1,$1+$2): ldl $1+$2
-lal lof samesign($1,$1+$2): lol $1+$2
-lal loi $2==w: lol $1
-lal loi $2==2*w: ldl $1
-#ifdef INT
-lal loi lol notreg($3) && $3==$1-w && samesign($1,$3) && $2%w==0:
- lal $3 loi $2+w
-lal loi ldl notreg($3) && $3==$1-2*w && samesign($1,$3) && $2%w==0:
- lal $3 loi $2+2*w
-lal loi lal loi $1==$3+$4 && samesign($1,$3) && $2%w==0 && $4%w==0:
- lal $3 loi $2+$4
-lal sti stl notreg($3) && $3==$1+$2 && samesign($1,$3): lal $1 sti $2+w
-lal sti sdl notreg($3) && $3==$1+$2 && samesign($1,$3): lal $1 sti $2+2*w
-#endif
-lal sdf samesign($1,$1+$2): sdl $1+$2
-lal stf samesign($1,$1+$2): stl $1+$2
-lal sti $2==w: stl $1
-lal sti $2==2*w: sdl $1
-#ifdef INT
-lde lde $2==$1-2*w: lae $2 loi 4*w
-lde loe $2==$1-w: lae $2 loi 3*w
-#endif
-lde sde $2==$1:
-lde sde lde sde $3==$1+2*w && $4==$2+2*w: lae $1 lae $2 blm 4*w
-#ifdef INT
-ldl ldl $2==$1-2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $2 loi 4*w
-ldl lol $2==$1-w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $2 loi 3*w
-#endif
-ldl sdl $1==$2:
-lxa loi lxa sti $3==$1 && $4==$2:
-lxa lof lxa stf $3==$1 && $4==$2:
-lxa ldf lxa sdf $3==$1 && $4==$2:
-lxa stf lxa lof $3==$1 && $4==$2: dup w lxa $1 stf $2
-lxa sdf lxa ldf $3==$1 && $4==$2: dup 2*w lxa $1 sdf $2
-lxl lof lxl stf $3==$1 && $4==$2:
-lxl ldf lxl sdf $3==$1 && $4==$2:
-lxl stf lxl lof $3==$1 && $4==$2: dup w lxl $1 stf $2
-lxl sdf lxl ldf $3==$1 && $4==$2: dup 2*w lxl $1 sdf $2
-lxa sti lxa loi $3==$1 && $4==$2 && $2%w==0: dup $2 lxa $1 sti $2
-loc adi $1==-1 && $2==w: dec
-loc dec sfit($1-1,8*w) : loc $1-1
-loc bgt $1==-1: zge $2
-loc ble $1==-1: zlt $2
-loc dvi $1==-1 && $2==w: ngi w
-ldc dvi $1==-1 && $2==2*w: ngi 2*w
-loc loe adi $1==-1 && $3==w: loe $2 dec
-loc loe mli $1==-1 && $3==w: loe $2 ngi w
-loc lol adi $1==-1 && $3==w: lol $2 dec
-loc mli $1==-1 && $2==w: ngi w
-ldc mli $1==-1 && $2==2*w: ngi 2*w
-loc sbi $1==-1 && $2==w: inc
-loc inc sfit($1+1,8*w) : loc $1+1
-loc adi $1==0 && $2==w:
-ldc adi $1==0 && $2==2*w:
-zer adi $1==$2:
-loc beq $1==0: zeq $2
-loc bge $1==0: zge $2
-loc bgt $1==0: zgt $2
-loc ble $1==0: zle $2
-loc blt $1==0: zlt $2
-loc bne $1==0: zne $2
-loc cmi teq $1==0 && $2==w: teq
-loc cmi tge $1==0 && $2==w: tge
-loc cmi tgt $1==0 && $2==w: tgt
-loc cmi tle $1==0 && $2==w: tle
-loc cmi tlt $1==0 && $2==w: tlt
-loc cmi tne $1==0 && $2==w: tne
-loc ior $1==0 && $2==w:
-ldc ior $1==0 && $2==2*w:
-zer ior $1==$2:
-loc ste $1==0: zre $2
-loc stl $1==0: zrl $2
-loc sbi $1==0 && $2==w:
-ldc sbi $1==0 && $2==2*w:
-zer sbi $1==$2:
-loc xor $1==0 && $2==w:
-ldc xor $1==0 && $2==2*w:
-zer xor $1==$2:
-loc adi $1==1 && $2==w: inc
-loc bge $1==1: zgt $2
-loc blt $1==1: zle $2
-loc dvi $1==1 && $2==w:
-ldc dvi $1==1 && $2==2*w:
-loc loe adi $1==1 && $3==w: loe $2 inc
-loc loe mli $1==1 && $3==w: loe $2
-loc lol adi $1==1 && $3==w: lol $2 inc
-loc lol mli $1==1 && $3==w: lol $2
-loc mli $1==1 && $2==w:
-loc sbi $1==1 && $2==w: dec
-loc loe mli $3==w: loe $2 loc $1 mli w
-loc lol mli $3==w: lol $2 loc $1 mli w
-ldc lde mli $3==2*w: lde $2 ldc $1 mli 2*w
-ldc lde adi $3==2*w: lde $2 ldc $1 adi 2*w
-ldc ldl mli $3==2*w: ldl $2 ldc $1 mli 2*w
-ldc ldl adi $3==2*w: ldl $2 ldc $1 adi 2*w
-loc mli $1==2 && $2==w: loc 1 sli w
-loc mli $1==4 && $2==w: loc 2 sli w
-loc mli $1==8 && $2==w: loc 3 sli w
-loc mli $1==16 && $2==w: loc 4 sli w
-loc mli $1==32 && $2==w: loc 5 sli w
-loc mli $1==64 && $2==w: loc 6 sli w
-loc mli $1==128 && $2==w: loc 7 sli w
-loc mli $1==256 && $2==w: loc 8 sli w
-loc adi !defined($2): adi $1
-loc sbi !defined($2): sbi $1
-loc mli !defined($2): mli $1
-loc dvi !defined($2): dvi $1
-loc rmi !defined($2): rmi $1
-loc ngi !defined($2): ngi $1
-loc sli !defined($2): sli $1
-loc sri !defined($2): sri $1
-loc adu !defined($2): adu $1
-loc sbu !defined($2): sbu $1
-loc mlu !defined($2): mlu $1
-loc dvu !defined($2): dvu $1
-loc rmu !defined($2): rmu $1
-loc slu !defined($2): slu $1
-loc sru !defined($2): sru $1
-loc adf !defined($2): adf $1
-loc sbf !defined($2): sbf $1
-loc mlf !defined($2): mlf $1
-loc dvf !defined($2): dvf $1
-loc ngf !defined($2): ngf $1
-loc fif !defined($2): fif $1
-loc fef !defined($2): fef $1
-loc zer !defined($2): zer $1
-loc zrf !defined($2): zrf $1
-loc los $2==w: loi $1
-loc sts $2==w: sti $1
-loc ads $2==w: adp $1
-loc ass $2==w: asp $1
-loc bls $2==w: blm $1
-loc dus $2==w: dup $1
-loc loc cii $1==$2:
-loc loc cuu $1==$2:
-loc loc cff $1==$2:
-loc and !defined($2): and $1
-loc ior !defined($2): ior $1
-loc xor !defined($2): xor $1
-loc com !defined($2): com $1
-loc rol !defined($2): rol $1
-loc rol $1==0:
-loc ror !defined($2): ror $1
-loc ror $1==0:
-loc inn !defined($2): inn $1
-loc set !defined($2): set $1
-loc cmi !defined($2): cmi $1
-loc cmu !defined($2): cmu $1
-loc cmf !defined($2): cmf $1
-loe dec ste $1==$3: dee $1
-loe inc ste $1==$3: ine $1
-loe loc mli $2==0 && $3==w: loc 0
-#ifdef INT
-loe loe $2==$1-w: lde $2
-loe loe beq $2==$1+w: lde $1 beq $3
-loe loe bge $2==$1+w: lde $1 ble $3
-loe loe bgt $2==$1+w: lde $1 blt $3
-loe loe ble $2==$1+w: lde $1 bge $3
-loe loe blt $2==$1+w: lde $1 bgt $3
-loe loe bne $2==$1+w: lde $1 bne $3
-loe loe cmi $2==$1+w && $3==w: lde $1 cmi w ngi w
-#endif
-ngi teq $1==w: teq
-ngi tge $1==w: tle
-ngi tgt $1==w: tlt
-ngi tle $1==w: tge
-ngi tlt $1==w: tgt
-ngi tne $1==w: tne
-#ifdef INT
-loe loe mli $2==$1+w && $3==w: lde $1 mli w
-loe loe adi $2==$1+w && $3==w: lde $1 adi w
-loe loe $1==$2: loe $1 dup w
-#endif
-loe ste $1==$2:
-LLP blm $2==w: loi w sil $1
-lol dec stl $1==$3: del $1
-lol inc stl $1==$3: inl $1
-lol loc mli $2==0 && $3==w: loc 0
-LLP loi $2==w: lil $1
-#ifdef INT
-lol lol $2==$1-w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $2
-lol lol beq $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 beq $3
-lol lol bge $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 ble $3
-lol lol bgt $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 blt $3
-lol lol ble $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bge $3
-lol lol blt $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bgt $3
-lol lol bne $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 bne $3
-lol lol cmi $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 cmi w ngi w
-lol lol mli $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 mli w
-lol lol adi $3==w && $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2):
- ldl $1 adi w
-lol lol $1==$2: lol $1 dup w
-#endif
-lol stl $1==$2:
-LLP sti $2==w: sil $1
-mli ngi $1==$2: ngi $1 mli $1
-ngi adi $1==$2: sbi $1
-ngf adf $1==$2: sbf $1
-ngi sbi $1==$2: adi $1
-ngf sbf $1==$2: adf $1
-ngi ngi $1==$2:
-ngf ngf $1==$2:
-#ifdef INT
-sde sde $2==$1+2*w: lae $1 sti 4*w
-sde ste $2==$1+2*w: lae $1 sti 3*w
-sde loc ste $3==$1-w: loc $2 lae $3 sti 3*w
-sde lol ste $3==$1-w: lol $2 lae $3 sti 3*w
-sde lde $1==$2: dup 2*w sde $1
-#endif
-sdf $1==0: sti 2*w
-#ifdef INT
-sdl sdl $2==$1+2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $1 sti 4*w
-sdl stl $2==$1+2*w && notreg($1) && notreg($2) && samesign($1,$2):
- lal $1 sti 3*w
-sdl loc stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loc $2 lal $3 sti 3*w
-sdl loe stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loe $2 lal $3 sti 3*w
-sdl ldl $1==$2: dup 2*w sdl $1
-ste loe $1==$2: dup w ste $1
-ste ste $2==$1-w: sde $2
-ste loc ste $3==$1-w: loc $2 sde $3
-ste lol ste $3==$1-w: lol $2 sde $3
-stl lol $1==$2: dup w stl $1
-#endif
-stf $1==0: sti w
-sdl ldl ret $1==$2 && $3==2*w: ret 2*w
-#ifdef INT
-stl stl $2==$1+w && notreg($1) && notreg($2) && samesign($1,$2): sdl $1
-stl loc stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loc $2 sdl $3
-stl loe stl $3==$1-w && notreg($1) && notreg($3) && samesign($1,$3):
- loe $2 sdl $3
-#endif
-stl lol ret $1==$2 && $3==w: ret w
-lal sti lal loi ret $1==$3 && $2==$4 && $2==$5: ret $2
-loc sbi loc sbi $2==w && $4==w: loc $1+$3 sbi w
-ldc sbi ldc sbi $2==2*w && $4==2*w: ldc $1+$3 sbi 2*w
-loc sbi loc adi $2==w && $4==w: loc $1-$3 sbi w
-ldc sbi ldc adi $2==2*w && $4==2*w: ldc $1-$3 sbi 2*w
-teq teq : tne
-teq tne : teq
-teq zne : zeq $2
-teq zeq : zne $2
-tge teq : tlt
-tge tne : tge
-tge zeq : zlt $2
-tge zne : zge $2
-tgt teq : tle
-tgt tne : tgt
-tgt zeq : zle $2
-tgt zne : zgt $2
-tle teq : tgt
-tle tne : tle
-tle zeq : zgt $2
-tle zne : zle $2
-tlt teq : tge
-tlt tne : tlt
-tlt zeq : zge $2
-tlt zne : zlt $2
-tne teq : teq
-tne tne : tne
-tne zeq : zeq $2
-tne zne : zne $2
-#ifdef INT
-loc loc loc $1==0 && $2==0 && $3==0 : zer 6
-zer loc defined($1) && $2==0: zer $1+w
-#endif
-loi loc and $1==1 && $3==w && ($2&255)==255: loi 1
-loi loc loc cii $1<w && $2==w: loi $1 loc $2 loc $3 cuu
-cmp teq : cms p teq
-cmp tne : cms p tne
-cmu teq defined($1): cms $1 teq
-cmu tne defined($1): cms $1 tne
-cms zeq $1==w: beq $2
-cms zne $1==w: bne $2
-lol lae aar adp $3==w: adp $4 lol $1 lae $2 aar w
-loe lae aar adp $3==w: adp $4 loe $1 lae $2 aar w
-cmi zeq defined($1): cms $1 zeq $2
-cmi zne defined($1): cms $1 zne $2
-loe inc dup ste $1==$4 && $3==w: ine $1 loe $1
-loe dec dup ste $1==$4 && $3==w: dee $1 loe $1
-lol inc dup stl $1==$4 && $3==w: inl $1 lol $1
-lol dec dup stl $1==$4 && $3==w: del $1 lol $1
-adp dup SEP adp $1==-$4 && $2==p: dup p adp $1 SEP $3
-adp dup SLP adp $1==-$4 && $2==p: dup p adp $1 SLP $3
-inc dup ste dec $2==w: dup w inc ste $3
-inc dup stl dec $2==w: dup w inc stl $3
-zeq bra lab $1==$3: zne $2 lab $1
-zge bra lab $1==$3: zlt $2 lab $1
-zgt bra lab $1==$3: zle $2 lab $1
-zlt bra lab $1==$3: zge $2 lab $1
-zle bra lab $1==$3: zgt $2 lab $1
-zne bra lab $1==$3: zeq $2 lab $1
-beq bra lab $1==$3: bne $2 lab $1
-bge bra lab $1==$3: blt $2 lab $1
-bgt bra lab $1==$3: ble $2 lab $1
-blt bra lab $1==$3: bge $2 lab $1
-ble bra lab $1==$3: bgt $2 lab $1
-bne bra lab $1==$3: beq $2 lab $1
-lin lin : lin $2
-lin lab lin : lab $2 lin $3
-lin ret : ret $2
-lin bra : bra $2
-dup SLP loi $1==p && $3==w: SLP $2 lil $2
-dup SLP sti $1==p && $3==w: SLP $2 sil $2
-loc cms $1==0 && $2==w: tne
-zer $1==w: loc 0
-loc loc adi $3==w && sfit($1+$2,8*w) : loc $1+$2
-loc loc sbi $3==w && sfit($1-$2,8*w) : loc $1-$2
-loc loc mli $3==w && sfit($1*$2,8*w) : loc $1*$2
-loc loc dvi $3==w && $2!=0 : loc $1/$2
-loc loc and $3==w : loc $1&$2
-loc loc ior $3==w : loc $1|$2
-loc loc ior $1==0 && $2==0 && $3==2*w :
-loc loc xor $3==w : loc $1^$2
-loc loc xor $1==0 && $2==0 && $3==2*w :
-loc loc rol $3==w : loc rotate($1,$2)
-loc loc ror $3==w : loc rotate($1,8*w-$2)
-loc ngi $2==w && sfit(-$1,8*w) : loc -$1
-loc com $2==w : loc ~$1
-ldc ngi $2==2*w : ldc -$1
-loc lae aar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2)
-loc lae lar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2) loi rom(2,2)
-loc lae sar $3==w && $1>=rom(2,0) && $1 <= rom(2,0)+rom(2,1) :
- adp ($1-rom(2,0))*rom(2,2) sti rom(2,2)
-loc teq : loc $1==0
-loc tne : loc $1!=0
-loc tge : loc $1>=0
-loc tle : loc $1<=0
-loc tgt : loc $1>0
-loc tlt : loc $1<0
-loc zeq $1==0 : bra $2
-loc zeq :
-loc zne $1!=0 : bra $2
-loc zne :
-loc zge $1>=0 : bra $2
-loc zge :
-loc zle $1<=0 : bra $2
-loc zle :
-loc zgt $1>0 : bra $2
-loc zgt :
-loc zlt $1<0 : bra $2
-loc zlt :
-loc loc beq $1==$2 : bra $3
-loc loc beq :
-loc loc bne $1!=$2 : bra $3
-loc loc bne :
-loc loc bge $1>=$2 : bra $3
-loc loc bge :
-loc loc ble $1<=$2 : bra $3
-loc loc ble :
-loc loc bgt $1>$2 : bra $3
-loc loc bgt :
-loc loc blt $1<$2 : bra $3
-loc loc blt :
-lae loi lal sti $2==$4 && $2>4*w : lae $1 lal $3 blm $2
-lal loi lae sti $2==$4 && $2>4*w : lal $1 lae $3 blm $2
-lal loi lal sti $2==$4 && $2>4*w && ( $3<=$1-$2 || $3>=$1+$2 ) :
- lal $1 lal $3 blm $2
-lae loi lae sti $2==$4 && $2>4*w && ( !defined($1==$3) || $3<=$1-$2 || $3>=$1+$2 ) :
- lae $1 lae $3 blm $2
-loc loc loc cif $1==0 && $2==w : zrf $3
-loc loc loc ciu $1>=0 && $2==w && $3==2*w : ldc $1
-loc loc loc cii $2==w && $3==2*w : ldc $1
-loi loc inn $1==$3 && $2>=0 && $2<$1*8 :
- lof ($2/(8*w))*w loc $2&(8*w-1) inn w
-ldl loc inn $3==2*w && $2>=0 && $2<16*w :
- lol $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-lde loc inn $3==2*w && $2>=0 && $2<16*w :
- loe $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-ldf loc inn $3==2*w && $2>=0 && $2<16*w :
- lof $1+($2/(8*w))*w loc $2&(8*w-1) inn w
-loc inn $1<0 || $1>=8*$2 : asp $2 loc 0
-lol loc adi stl $3==w && $1==$4 : loc $2 lol $1 adi w stl $4
-lol loe adi stl $3==w && $1==$4 : loe $2 lol $1 adi w stl $4
-lol lol adi stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 adi w stl $4
-loe loc adi ste $3==w && $1==$4 : loc $2 loe $1 adi w ste $4
-loe loe adi ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 adi w ste $4
-loe lol adi ste $3==w && $1==$4 : lol $2 loe $1 adi w ste $4
-lol loc ior stl $3==w && $1==$4 : loc $2 lol $1 ior w stl $4
-lol loe ior stl $3==w && $1==$4 : loe $2 lol $1 ior w stl $4
-lol lol ior stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 ior w stl $4
-loe loc ior ste $3==w && $1==$4 : loc $2 loe $1 ior w ste $4
-loe loe ior ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 ior w ste $4
-loe lol ior ste $3==w && $1==$4 : lol $2 loe $1 ior w ste $4
-lol loc and stl $3==w && $1==$4 : loc $2 lol $1 and w stl $4
-lol loe and stl $3==w && $1==$4 : loe $2 lol $1 and w stl $4
-lol lol and stl $3==w && $1==$4 && $1!=$2 : lol $2 lol $1 and w stl $4
-loe loc and ste $3==w && $1==$4 : loc $2 loe $1 and w ste $4
-loe loe and ste $3==w && $1==$4 && $1!=$2 : loe $2 loe $1 and w ste $4
-loe lol and ste $3==w && $1==$4 : lol $2 loe $1 and w ste $4
-loi asp $1==$2 : asp p
-lal loi loc loc loc loc ior $2==4*w && $7==4*w && ($3==0)+($4==0)+($5==0)+($6==0)>2 :
- lol $1+3*w loc $3 ior w lol $1+2*w loc $4 ior w lol $1+w loc $5 ior w lol $1 loc $6 ior w
-loc dup stl loc dup stl $2==2 && $5==2:
- loc $1 stl $3 loc $4 stl $6 loc $1 loc $4
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "alloc.h"
-#include "pattern.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_mnem.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-/* #define CHK_HASH /* print numbers patterns are hashed to */
-#ifdef CHK_HASH
-#include <stdio.h>
-#endif
-
-#define ILLHASH 0177777
-short pathash[256]; /* table of indices into pattern[] */
-
-int opind = 0; /* second index of next matrix */
-byte transl[op_plast-op_pfirst+1][3] = {
- /* LLP */ { op_LLP, op_lol, op_ldl },
- /* LEP */ { op_LEP, op_loe, op_lde },
- /* SLP */ { op_SLP, op_stl, op_sdl },
- /* SEP */ { op_SEP, op_ste, op_sde }
-};
-
-opcheck(bp) register byte *bp; {
-
- if (((*bp)&BMASK) >= op_pfirst)
- *bp = transl[((*bp)&BMASK)-op_pfirst][opind];
-}
-
-/*
- * The hashing method used is believed to be reasonably efficient.
- * A minor speed improvement could be obtained by keeping a boolean
- * array telling which opcode has any patterns starting with it.
- * Currently only about one third of the opcodes actually have a
- * pattern starting with it, but they are the most common ones.
- * Estimated improvement possible: about 2%
- */
-
-hashpatterns() {
- short index;
- register byte *bp,*tp;
- register short i;
- unsigned short hashvalue;
- byte *save;
- int patlen;
-
- if (pointersize == wordsize)
- opind=1;
- else if (pointersize == 2*wordsize)
- opind=2;
- index = lastind; /* set by mktab */
- while (index != 0) {
- bp = &pattern[index];
- tp = &bp[PO_MATCH];
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<8;
- }
- save = tp;
- patlen = i;
- while (i--)
- opcheck(tp++);
- if ((*tp++&BMASK)==BMASK)
- tp += 2;
- i = *tp++&BMASK;
- if (i==BMASK) {
- i = *tp++&BMASK;
- i |= (*tp++&BMASK)<<8;
- }
- while (i--) {
- opcheck(tp++);
- if ((*tp++&BMASK)==BMASK)
- tp += 2;
- }
-
- /*
- * Now the special opcodes are filled
- * in properly, we can hash the pattern
- */
-
- hashvalue = 0;
- tp = save;
- switch(patlen) {
- default: /* 3 or more */
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 2:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- case 1:
- hashvalue = (hashvalue<<4)^(*tp++&BMASK);
- }
- assert(hashvalue!= ILLHASH);
- i=index;
- index = (bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<8);
- bp[PO_HASH] = hashvalue>>8;
- hashvalue &= BMASK;
- bp[PO_NEXT] = pathash[hashvalue]&BMASK;
- bp[PO_NEXT+1] = pathash[hashvalue]>>8;
- pathash[hashvalue] = i;
-#ifdef CHK_HASH
- fprintf(stderr,"%d\n",hashvalue);
-#endif
- }
-}
-
-peephole() {
- static bool phashed = FALSE;
-
- if (!phashed) {
- hashpatterns();
- phashed=TRUE;
- }
- optimize();
-}
-
-optimize() {
- register num_p *npp,np;
- register instr;
-
- basicblock(&instrs);
- for (npp=curpro.numhash;npp< &curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np=np->n_next) {
- if(np->n_line->l_next == (line_p) 0)
- continue;
- instr = np->n_line->l_next->l_instr&BMASK;
- if (instr == op_lab || instr == op_bra)
- np->n_repl = np->n_line->l_next->l_a.la_np;
- else
- basicblock(&np->n_line->l_next);
- }
-}
-
-offset oabs(off) offset off; {
-
- return(off >= 0 ? off : -off);
-}
-
-line_p repline(ev,patlen) eval_t ev; {
- register line_p lp;
- register iarg_p iap;
- register sym_p sp;
- offset diff,newdiff;
-
- assert(ev.e_typ != EV_UNDEF);
- switch(ev.e_typ) {
- case EV_CONST:
- if ((short) ev.e_v.e_con == ev.e_v.e_con) {
- if (CANMINI((short) ev.e_v.e_con))
- lp = newline((short) (ev.e_v.e_con)+Z_OPMINI);
- else {
- lp = newline(OPSHORT);
- lp->l_a.la_short = (short) ev.e_v.e_con;
- }
- } else {
- lp = newline(OPOFFSET);
- lp->l_a.la_offset = ev.e_v.e_con;
- }
- return(lp);
- case EV_NUMLAB:
- lp = newline(OPNUMLAB);
- lp->l_a.la_np = ev.e_v.e_np;
- return(lp);
- default: /* fragment + offset */
- /*
- * There is a slight problem here, because we have to
- * map fragment+offset to symbol+offset.
- * Fortunately the fragment we have must be the fragment
- * of one of the symbols in the matchpattern.
- * So a short search should do the job.
- */
- sp = (sym_p) 0;
- for (iap= &iargs[patlen-1]; iap >= iargs; iap--)
- if (iap->ia_ev.e_typ == ev.e_typ) {
- /*
- * Although lint complains, diff is not used
- * before set.
- *
- * The proof is left as an exercise to the
- * reader.
- */
- newdiff = oabs(iap->ia_sp->s_value-ev.e_v.e_con);
- if (sp==(sym_p) 0 || newdiff < diff) {
- sp = iap->ia_sp;
- diff = newdiff;
- }
- }
- assert(sp != (sym_p) 0);
- if (diff == 0) {
- lp = newline(OPSYMBOL);
- lp->l_a.la_sp = sp;
- } else {
- diff = ev.e_v.e_con - sp->s_value;
- if ((short) diff == diff) {
- lp = newline(OPSVAL);
- lp->l_a.la_sval.lasv_short = (short) diff;
- lp->l_a.la_sval.lasv_sp = sp;
- } else {
- lp = newline(OPLVAL);
- lp->l_a.la_lval.lalv_offset = diff;
- lp->l_a.la_lval.lalv_sp = sp;
- }
- }
- return(lp);
- }
-}
-
-offset rotate(w,amount) offset w,amount; {
- offset highmask,lowmask;
-
-#ifndef LONGOFF
- assert(wordsize<=4);
-#endif
- highmask = (offset)(-1) << amount;
- lowmask = ~highmask;
- if (wordsize != 4)
- highmask &= wordsize==2 ? 0xFFFF : 0xFF;
- return(((w<<amount)&highmask)|((w>>(8*wordsize-amount))&lowmask));
-}
-
-eval_t undefres = { EV_UNDEF };
-
-eval_t compute(pexp) register expr_p pexp; {
- eval_t leaf1,leaf2,res;
- register i;
- register sym_p sp;
- offset mask;
-
- switch(nparam[pexp->ex_operator]) {
- default:
- assert(FALSE);
- case 2:
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ == EV_UNDEF ||
- nonumlab[pexp->ex_operator] && leaf2.e_typ == EV_NUMLAB ||
- onlyconst[pexp->ex_operator] && leaf2.e_typ != EV_CONST)
- return(undefres);
- case 1:
- leaf1 = compute(&enodes[pexp->ex_lnode]);
- if (leaf1.e_typ == EV_UNDEF ||
- nonumlab[pexp->ex_operator] && leaf1.e_typ == EV_NUMLAB ||
- onlyconst[pexp->ex_operator] && leaf1.e_typ != EV_CONST)
- return(undefres);
- case 0:
- break;
- }
-
- res.e_typ = EV_CONST;
- res.e_v.e_con = 0;
- switch(pexp->ex_operator) {
- default:
- assert(FALSE);
- case EX_CON:
- res.e_v.e_con = (offset) pexp->ex_lnode;
- break;
- case EX_ARG:
- return(iargs[pexp->ex_lnode - 1].ia_ev);
- case EX_CMPEQ:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- if (leaf1.e_typ == EV_NUMLAB) {
- if (leaf1.e_v.e_np == leaf2.e_v.e_np)
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_v.e_con == leaf2.e_v.e_con)
- res.e_v.e_con = 1;
- break;
- case EX_CMPNE:
- if (leaf1.e_typ != leaf2.e_typ) {
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_typ == EV_NUMLAB) {
- if (leaf1.e_v.e_np != leaf2.e_v.e_np)
- res.e_v.e_con = 1;
- break;
- }
- if (leaf1.e_v.e_con != leaf2.e_v.e_con)
- res.e_v.e_con = 1;
- break;
- case EX_CMPGT:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con > leaf2.e_v.e_con;
- break;
- case EX_CMPGE:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con >= leaf2.e_v.e_con;
- break;
- case EX_CMPLT:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con < leaf2.e_v.e_con;
- break;
- case EX_CMPLE:
- if (leaf1.e_typ != leaf2.e_typ)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con <= leaf2.e_v.e_con;
- break;
- case EX_OR2:
- if (leaf1.e_v.e_con != 0)
- return(leaf1);
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST)
- return(undefres);
- return(leaf2);
- case EX_AND2:
- if (leaf1.e_v.e_con == 0)
- return(leaf1);
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST)
- return(undefres);
- return(leaf2);
- case EX_OR1:
- res.e_v.e_con = leaf1.e_v.e_con | leaf2.e_v.e_con;
- break;
- case EX_XOR1:
- res.e_v.e_con = leaf1.e_v.e_con ^ leaf2.e_v.e_con;
- break;
- case EX_AND1:
- res.e_v.e_con = leaf1.e_v.e_con & leaf2.e_v.e_con;
- break;
- case EX_TIMES:
- res.e_v.e_con = leaf1.e_v.e_con * leaf2.e_v.e_con;
- break;
- case EX_DIVIDE:
- res.e_v.e_con = leaf1.e_v.e_con / leaf2.e_v.e_con;
- break;
- case EX_MOD:
- res.e_v.e_con = leaf1.e_v.e_con % leaf2.e_v.e_con;
- break;
- case EX_LSHIFT:
- res.e_v.e_con = leaf1.e_v.e_con << leaf2.e_v.e_con;
- break;
- case EX_RSHIFT:
- res.e_v.e_con = leaf1.e_v.e_con >> leaf2.e_v.e_con;
- break;
- case EX_UMINUS:
- res.e_v.e_con = -leaf1.e_v.e_con;
- break;
- case EX_NOT:
- res.e_v.e_con = !leaf1.e_v.e_con;
- break;
- case EX_COMP:
- res.e_v.e_con = ~leaf1.e_v.e_con;
- break;
- case EX_PLUS:
- if (leaf1.e_typ >= EV_FRAG) {
- if (leaf2.e_typ >= EV_FRAG)
- return(undefres);
- res.e_typ = leaf1.e_typ;
- } else
- res.e_typ = leaf2.e_typ;
- res.e_v.e_con = leaf1.e_v.e_con + leaf2.e_v.e_con;
- break;
- case EX_MINUS:
- if (leaf1.e_typ >= EV_FRAG) {
- if (leaf2.e_typ == EV_CONST)
- res.e_typ = leaf1.e_typ;
- else if (leaf2.e_typ != leaf1.e_typ)
- return(undefres);
- } else if (leaf2.e_typ >= EV_FRAG)
- return(undefres);
- res.e_v.e_con = leaf1.e_v.e_con - leaf2.e_v.e_con;
- break;
- case EX_POINTERSIZE:
- res.e_v.e_con = pointersize;
- break;
- case EX_WORDSIZE:
- res.e_v.e_con = wordsize;
- break;
- case EX_NOTREG:
- res.e_v.e_con = !inreg(leaf1.e_v.e_con);
- break;
- case EX_DEFINED:
- leaf1 = compute(&enodes[pexp->ex_lnode]);
- res.e_v.e_con = leaf1.e_typ != EV_UNDEF;
- break;
- case EX_SAMESIGN:
- res.e_v.e_con = (leaf1.e_v.e_con ^ leaf2.e_v.e_con) >= 0;
- break;
- case EX_ROM:
- if ((sp = iargs[pexp->ex_lnode - 1].ia_sp) != (sym_p) 0 &&
- sp->s_rom != (offset *) 0) {
- leaf2 = compute(&enodes[pexp->ex_rnode]);
- if (leaf2.e_typ != EV_CONST ||
- leaf2.e_v.e_con < 0 ||
- leaf2.e_v.e_con >= MAXROM)
- return(undefres);
- res.e_v.e_con = sp->s_rom[leaf2.e_v.e_con];
- break;
- } else
- return(undefres);
- case EX_SFIT:
- mask = 0;
- for (i=leaf2.e_v.e_con - 1;i < 8*sizeof(offset); i++)
- mask |= 1<<i;
- res.e_v.e_con = (leaf1.e_v.e_con&mask) == 0 ||
- (leaf1.e_v.e_con&mask) == mask;
- break;
- case EX_UFIT:
- mask = 0;
- for (i=leaf2.e_v.e_con;i < 8*sizeof(offset); i++)
- mask |= 1<<i;
- res.e_v.e_con = (leaf1.e_v.e_con&mask) == 0;
- break;
- case EX_ROTATE:
- res.e_v.e_con = rotate(leaf1.e_v.e_con,leaf2.e_v.e_con);
- break;
- }
- return(res);
-}
-
-#ifdef ALLOWSPECIAL
-extern bool special();
-#endif
-
-bool tryrepl(lpp,bp,patlen)
-line_p *lpp;
-register byte *bp;
-int patlen;
-{
- int rpllen,instr,rplval;
- register line_p lp;
- line_p replacement,*rlpp,tp;
-
- rpllen = *bp++&BMASK;
- if (rpllen == BMASK) {
- rpllen = *bp++&BMASK;
- rpllen |= (*bp++&BMASK)<<8;
- }
-#ifdef ALLOWSPECIAL
- if (rpllen == 1 && *bp == 0)
- return(special(lpp,bp+1,patlen));
-#endif
- replacement = (line_p) 0;
- rlpp = &replacement;
- while (rpllen--) {
- instr = *bp++&BMASK;
- rplval = *bp++&BMASK;
- if (rplval == BMASK) {
- rplval = (*bp++&BMASK);
- rplval |= (*bp++&BMASK)<<8;
- }
- if (rplval)
- lp = repline(compute(&enodes[rplval]),patlen);
- else
- lp = newline(OPNO);
-
- /*
- * One replacement instruction is generated,
- * link in list and proceed with the next one.
- */
-
- if (instr == op_lab)
- lp->l_a.la_np->n_line = lp;
- *rlpp = lp;
- rlpp = &lp->l_next;
- lp->l_instr = instr;
- }
-
- /*
- * Replace instructions matched by the created replacement
- */
-
-
- OPTIM((bp[0]&BMASK)|(bp[1]&BMASK)<<8);
- for (lp= *lpp;patlen>0;patlen--,tp=lp,lp=lp->l_next)
- ;
- tp->l_next = (line_p) 0;
- *rlpp = lp;
- lp = *lpp;
- *lpp = replacement;
- while ( lp != (line_p) 0 ) {
- tp = lp->l_next;
- oldline(lp);
- lp = tp;
- }
- return(TRUE);
-}
-
-bool trypat(lpp,bp,len)
-line_p *lpp;
-register byte *bp;
-int len;
-{
- register iarg_p iap;
- int i,patlen;
- register line_p lp;
- eval_t result;
-
- patlen = *bp++&BMASK;
- if (patlen == BMASK) {
- patlen = *bp++&BMASK;
- patlen |= (*bp++&BMASK)<<8;
- }
- if (len == 3) {
- if (patlen<3)
- return(FALSE);
- } else {
- if (patlen != len)
- return(FALSE);
- }
-
- /*
- * Length is ok, now check opcodes
- */
-
- for (i=0,lp= *lpp;i<patlen && lp != (line_p) 0;i++,lp=lp->l_next)
- if (lp->l_instr != *bp++)
- return(FALSE);
- if (i != patlen)
- return(FALSE);
-
- /*
- * opcodes are also correct, now comes the hard part
- */
-
- for(i=0,lp= *lpp,iap= iargs; i<patlen;i++,iap++,lp=lp->l_next) {
- switch(lp->l_optyp) {
- case OPNO:
- iap->ia_ev.e_typ = EV_UNDEF;
- break;
- default:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = (lp->l_optyp&BMASK)-Z_OPMINI;
- break;
- case OPSHORT:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = lp->l_a.la_short;
- break;
-#ifdef LONGOFF
- case OPOFFSET:
- iap->ia_ev.e_typ = EV_CONST;
- iap->ia_ev.e_v.e_con = lp->l_a.la_offset;
- break;
-#endif
- case OPNUMLAB:
- iap->ia_ev.e_typ = EV_NUMLAB;
- iap->ia_ev.e_v.e_np = lp->l_a.la_np;
- break;
- case OPSYMBOL:
- iap->ia_ev.e_typ = lp->l_a.la_sp->s_frag;
- iap->ia_sp = lp->l_a.la_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_sp->s_value;
- break;
- case OPSVAL:
- iap->ia_ev.e_typ = lp->l_a.la_sval.lasv_sp->s_frag;
- iap->ia_sp = lp->l_a.la_sval.lasv_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_sval.lasv_sp->s_value + lp->l_a.la_sval.lasv_short;
- break;
-#ifdef LONGOFF
- case OPLVAL:
- iap->ia_ev.e_typ = lp->l_a.la_lval.lalv_sp->s_frag;
- iap->ia_sp = lp->l_a.la_lval.lalv_sp;
- iap->ia_ev.e_v.e_con = lp->l_a.la_lval.lalv_sp->s_value + lp->l_a.la_lval.lalv_offset;
- break;
-#endif
- }
- }
- i = *bp++&BMASK;
- if ( i==BMASK ) {
- i = *bp++&BMASK;
- i |= (*bp++&BMASK)<<8;
- }
- if ( i != 0) {
- /* there is a condition */
- result = compute(&enodes[i]);
- if (result.e_typ != EV_CONST || result.e_v.e_con == 0)
- return(FALSE);
- }
- return(tryrepl(lpp,bp,patlen));
-}
-
-basicblock(alpp) line_p *alpp; {
- register line_p *lpp,lp;
- bool madeopt;
- unsigned short hash[3];
- line_p *next;
- register byte *bp;
- int i;
- short index;
-
- do { /* make pass over basicblock */
- lpp = alpp; madeopt = FALSE;
- while ((*lpp) != (line_p) 0 && ((*lpp)->l_instr&BMASK) != op_lab) {
- lp = *lpp; next = &lp->l_next;
- hash[0] = lp->l_instr&BMASK;
- lp=lp->l_next;
- if (lp != (line_p) 0) {
- hash[1] = (hash[0]<<4)^(lp->l_instr&BMASK);
- lp=lp->l_next;
- if (lp != (line_p) 0)
- hash[2] = (hash[1]<<4)^(lp->l_instr&BMASK);
- else
- hash[2] = ILLHASH;
- } else {
- hash[1] = ILLHASH;
- hash[2] = ILLHASH;
- }
-
- /*
- * hashvalues computed. Try for longest pattern first
- */
-
- for (i=2;i>=0;i--) {
- index = pathash[hash[i]&BMASK];
- while (index != 0) {
- bp = &pattern[index];
- if((bp[PO_HASH]&BMASK) == (hash[i]>>8))
- if(trypat(lpp,&bp[PO_MATCH],i+1)) {
- madeopt = TRUE;
- next = lpp;
- i = 0; /* dirty way of double break */
- break;
- }
- index=(bp[PO_NEXT]&BMASK)|(bp[PO_NEXT+1]<<8);
- }
- }
- lpp = next;
- }
- } while(madeopt); /* as long as there is progress */
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-process() {
-
- if (wordsize == 0 || pointersize == 0)
- error("No MES EMX encountered");
- backward(); /* reverse and cleanup list */
- symknown(); /* symbol scope is now known */
- if (!nflag)
- symvalue(); /* give symbols value */
- if (prodepth != 0) {
- if (!nflag) {
- checklocs(); /* check definition of locals */
- peephole(); /* local optimization */
- relabel(); /* relabel local labels */
- flow(); /* throw away unreachable code */
- }
- outpro(); /* generate PRO pseudo */
- outregs(); /* generate MES ms_reg pseudos */
- }
- putlines(pseudos); /* pseudos first */
- if (prodepth != 0) {
- putlines(instrs); /* instructions next */
- outend(); /* generate END pseudo */
- cleanlocals(); /* forget instruction labels */
- } else if(instrs != (line_p) 0)
- error("instructions outside procedure");
-#ifdef COREDEBUG
- coreverbose();
-#endif
-}
-
-relabel() {
- register num_p *npp,np,tp;
- register num_p repl,ttp;
-
- /*
- * For each label find its final destination after crossjumping.
- * Care has to be taken to prevent a loop in the program to
- * cause same in the optimizer.
- */
-
- for (npp = curpro.numhash; npp < &curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np = np->n_next) {
- assert((np->n_line->l_instr&BMASK) == op_lab
- && np->n_line->l_a.la_np == np);
- for(tp=np; (tp->n_flags&(NUMKNOWN|NUMMARK))==0;
- tp = tp->n_repl)
- tp->n_flags |= NUMMARK;
- repl = tp->n_repl;
- for(tp=np; tp->n_flags&NUMMARK; tp = ttp) {
- ttp = tp->n_repl;
- tp->n_repl = repl;
- tp->n_flags &= ~ NUMMARK;
- tp->n_flags |= NUMKNOWN;
- }
- }
-}
-
-symknown() {
- register sym_p *spp,sp;
-
- for (spp = symhash; spp < &symhash[NSYMHASH]; spp++)
- for (sp = *spp; sp != (sym_p) 0; sp = sp->s_next)
- sp->s_flags |= SYMKNOWN;
-}
-
-cleanlocals() {
- register num_p *npp,np,tp;
-
- for (npp = curpro.numhash; npp < &curpro.numhash[NNUMHASH]; npp++) {
- np = *npp;
- while (np != (num_p) 0) {
- tp = np->n_next;
- oldnum(np);
- np = tp;
- }
- *npp = (num_p) 0;
- }
-}
-
-checklocs() {
- register num_p *npp,np;
-
- for (npp=curpro.numhash; npp < & curpro.numhash[NNUMHASH]; npp++)
- for (np = *npp; np != (num_p) 0; np=np->n_next)
- if (np->n_line == (line_p) 0)
- error("local label %u undefined",
- (unsigned) np->n_number);
-}
-
-offset align(count,alignment) offset count,alignment; {
-
- assert(alignment==1||alignment==2||alignment==4);
- return((count+alignment-1)&~(alignment-1));
-}
-
-symvalue() {
- register line_p lp;
- register sym_p sp;
- register arg_p ap;
- register argb_p abp;
- short curfrag = 0;
- offset count;
-
- for (lp=pseudos; lp != (line_p) 0; lp = lp->l_next)
- switch(lp->l_instr&BMASK) {
- default:
- assert(FALSE);
- case ps_sym:
- sp = lp->l_a.la_sp;
- if (sp->s_frag != curfrag) {
- count = 0;
- curfrag = sp->s_frag;
- }
- count = align(count,wordsize);
- sp->s_value = count;
- break;
- case ps_bss:
- case ps_hol:
- /* nothing to do, all bss pseudos are in diff frags */
- case ps_mes:
- break;
- case ps_con:
- case ps_rom:
- for (ap=lp->l_a.la_arg; ap != (arg_p) 0; ap = ap->a_next)
- switch(ap->a_typ) {
- default:
- assert(FALSE);
- case ARGOFF:
- count = align(count,wordsize)+wordsize;
- break;
- case ARGNUM:
- case ARGSYM:
- case ARGVAL:
- count = align(count,wordsize)+pointersize;
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- if (ap->a_a.a_con.ac_length < wordsize)
- count = align(count,(offset)ap->a_a.a_con.ac_length);
- else
- count = align(count,wordsize);
- count += ap->a_a.a_con.ac_length;
- break;
- case ARGSTR:
- for (abp = &ap->a_a.a_string; abp != (argb_p) 0;
- abp = abp->ab_next)
- count += abp->ab_index;
- break;
- }
- }
-}
+++ /dev/null
-/* $Header$ */
-
-struct num {
- num_p n_next;
- unsigned n_number;
- unsigned n_jumps;
- num_p n_repl;
- short n_flags;
- line_p n_line;
-};
-
-/* contents of .n_flags */
-#define NUMDATA 000001
-#define NUMREACH 000002
-#define NUMKNOWN 000004
-#define NUMMARK 000010
-#define NUMSCAN 000020
-
-#define NNUMHASH 37
-extern num_p numlookup();
-
-struct regs {
- reg_p r_next;
- offset r_par[4];
-};
-
-typedef struct proinf {
- offset localbytes;
- line_p lastline;
- sym_p symbol;
- reg_p freg;
- bool gtoproc;
- num_p numhash[NNUMHASH];
-} proinf;
-
-extern proinf curpro;
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mnem.h"
-#include "../../h/em_flag.h"
-#include "alloc.h"
-#include "line.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-#define outbyte(b) putc(b,outfile)
-
-putlines(lnp) register line_p lnp; {
- register arg_p ap;
- line_p temp;
- register instr;
- short curlin= -2;
- short thislin;
-
- while ( lnp != (line_p) 0) {
- instr = lnp->l_instr&BMASK;
- switch(lnp->l_optyp) {
- case OPSYMBOL:
- if ((lnp->l_instr&BMASK) == ps_sym)
- outdef(lnp->l_a.la_sp);
- else
- outocc(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- outocc(lnp->l_a.la_sval.lasv_sp);
- break;
-#ifdef LONGOFF
- case OPLVAL:
- outocc(lnp->l_a.la_lval.lalv_sp);
- break;
-#endif
- case OPLIST:
- ap = lnp->l_a.la_arg;
- while (ap != (arg_p) 0) {
- switch(ap->a_typ) {
- case ARGSYM:
- outocc(ap->a_a.a_sp);
- break;
- case ARGVAL:
- outocc(ap->a_a.a_val.av_sp);
- break;
- }
- ap = ap->a_next;
- }
- break;
- }
-
- /*
- * global symbols now taken care of
- */
-
-
- switch(instr) {
- case ps_sym:
- break;
- case op_lni:
- if (curlin != -2)
- curlin++;
- outinst(instr);
- break;
- case op_lin:
- switch(lnp->l_optyp) {
- case OPNO:
- case OPOFFSET:
- case OPNUMLAB:
- case OPSYMBOL:
- case OPSVAL:
- case OPLVAL:
- case OPLIST:
- outinst(instr);
- goto processoperand;
- case OPSHORT:
- thislin = lnp->l_a.la_short;
- break;
- default:
- thislin = (lnp->l_optyp&BMASK)-Z_OPMINI;
- break;
- }
- if (thislin == curlin && !nflag) {
- temp = lnp->l_next;
- oldline(lnp);
- lnp = temp;
- OPTIM(O_LINGONE);
- continue;
- } else if (thislin == curlin+1 && !nflag) {
- instr = op_lni;
- outinst(instr);
- temp = lnp->l_next;
- oldline(lnp);
- OPTIM(O_LINLNI);
- lnp = newline(OPNO);
- lnp->l_next = temp;
- lnp->l_instr = instr;
- } else {
- outinst(instr);
- }
- curlin = thislin;
- break;
- case op_lab:
- curlin = -2;
- break;
- default:
- outinst(instr);
- }
-processoperand:
- switch(lnp->l_optyp) {
- case OPNO:
- if ((em_flag[instr-sp_fmnem]&EM_PAR)!=PAR_NO)
- outbyte( (byte) sp_cend) ;
- break;
- default:
- outint((lnp->l_optyp&BMASK)-Z_OPMINI);
- break;
- case OPSHORT:
- outint(lnp->l_a.la_short);
- break;
-#ifdef LONGOFF
- case OPOFFSET:
- outoff(lnp->l_a.la_offset);
- break;
-#endif
- case OPNUMLAB:
- if (instr == op_lab)
- numlab(lnp->l_a.la_np->n_repl);
- else if (instr < sp_fpseu) /* plain instruction */
- outint((short) lnp->l_a.la_np->n_repl->n_number);
- else
- outnum(lnp->l_a.la_np->n_repl);
- break;
- case OPSYMBOL:
- outsym(lnp->l_a.la_sp);
- break;
- case OPSVAL:
- outbyte( (byte) sp_doff) ;
- outsym(lnp->l_a.la_sval.lasv_sp);
- outint(lnp->l_a.la_sval.lasv_short);
- break;
-#ifdef LONGOFF
- case OPLVAL:
- outbyte( (byte) sp_doff) ;
- outsym(lnp->l_a.la_lval.lalv_sp);
- outoff(lnp->l_a.la_lval.lalv_offset);
- break;
-#endif
- case OPLIST:
- putargs(lnp->l_a.la_arg);
- switch(instr) {
- case ps_con:
- case ps_rom:
- case ps_mes:
- outbyte( (byte) sp_cend) ;
- }
- }
- /*
- * instruction is output now.
- * remove its useless body
- */
-
- temp = lnp->l_next;
- oldline(lnp);
- lnp = temp;
- if (ferror(outfile))
- error("write error");
- }
-}
-
-putargs(ap) register arg_p ap; {
-
- while (ap != (arg_p) 0) {
- switch(ap->a_typ) {
- default:
- assert(FALSE);
- case ARGOFF:
- outoff(ap->a_a.a_offset);
- break;
- case ARGNUM:
- outnum(ap->a_a.a_np->n_repl);
- break;
- case ARGSYM:
- outsym(ap->a_a.a_sp);
- break;
- case ARGVAL:
- outbyte( (byte) sp_doff) ;
- outsym(ap->a_a.a_val.av_sp);
- outoff(ap->a_a.a_val.av_offset);
- break;
- case ARGSTR:
- outbyte( (byte) sp_scon) ;
- putstr(&ap->a_a.a_string);
- break;
- case ARGICN:
- outbyte( (byte) sp_icon) ;
- goto casecon;
- case ARGUCN:
- outbyte( (byte) sp_ucon) ;
- goto casecon;
- case ARGFCN:
- outbyte( (byte) sp_fcon) ;
- casecon:
- outint(ap->a_a.a_con.ac_length);
- putstr(&ap->a_a.a_con.ac_con);
- break;
- }
- ap = ap->a_next;
- }
-}
-
-putstr(abp) register argb_p abp; {
- register argb_p tbp;
- register length;
-
- length = 0;
- tbp = abp;
- while (tbp!= (argb_p) 0) {
- length += tbp->ab_index;
- tbp = tbp->ab_next;
- }
- outint(length);
- while (abp != (argb_p) 0) {
- for (length=0;length<abp->ab_index;length++)
- outbyte( (byte) abp->ab_contents[length] );
- abp = abp->ab_next;
- }
-}
-
-outdef(sp) register sym_p sp; {
-
- /*
- * The surrounding If statement is removed to be friendly
- * to Backend writers having to deal with assemblers
- * not following our conventions.
- if ((sp->s_flags&SYMOUT)==0) {
- */
- sp->s_flags |= SYMOUT;
- if (sp->s_flags&SYMGLOBAL) {
- outinst(sp->s_flags&SYMPRO ? ps_exp : ps_exa);
- outsym(sp);
- }
- /*
- }
- */
-}
-
-outocc(sp) register sym_p sp; {
-
- if ((sp->s_flags&SYMOUT)==0) {
- sp->s_flags |= SYMOUT;
- if ((sp->s_flags&SYMGLOBAL)==0) {
- outinst(sp->s_flags&SYMPRO ? ps_inp : ps_ina);
- outsym(sp);
- }
- }
-}
-
-outpro() {
-
- outdef(curpro.symbol);
- outinst(ps_pro);
- outsym(curpro.symbol);
- outoff(curpro.localbytes);
-}
-
-outend() {
-
- outinst(ps_end);
- outoff(curpro.localbytes);
-}
-
-outinst(m) {
-
- outbyte( (byte) m );
-}
-
-outoff(off) offset off; {
-
-#ifdef LONGOFF
- if ((short) off == off)
-#endif
- outint((short) off);
-#ifdef LONGOFF
- else {
- outbyte( (byte) sp_cst4) ;
- outshort( (short) (off&0177777L) );
- outshort( (short) (off>>16) );
- }
-#endif
-}
-
-outint(i) short i; {
-
- if (i>= -sp_zcst0 && i< sp_ncst0-sp_zcst0)
- outbyte( (byte) (i+sp_zcst0+sp_fcst0) );
- else {
- outbyte( (byte) sp_cst2) ;
- outshort(i);
- }
-}
-
-outshort(i) short i; {
-
- outbyte( (byte) (i&BMASK) );
- outbyte( (byte) (i>>8) );
-}
-
-numlab(np) register num_p np; {
-
- if (np->n_number < sp_nilb0)
- outbyte( (byte) (np->n_number + sp_filb0) );
- else
- outnum(np);
-}
-
-outnum(np) register num_p np; {
-
- if(np->n_number<256) {
- outbyte( (byte) sp_ilb1) ;
- outbyte( (byte) (np->n_number) );
- } else {
- outbyte( (byte) sp_ilb2) ;
- outshort((short) np->n_number);
- }
-}
-
-outsym(sp) register sym_p sp; {
- register byte *p;
- register unsigned num;
-
- if (sp->s_name[0] == '.') {
- num = atoi(&sp->s_name[1]);
- if (num < 256) {
- outbyte( (byte) sp_dlb1) ;
- outbyte( (byte) (num) );
- } else {
- outbyte( (byte) sp_dlb2) ;
- outshort((short) num);
- }
- } else {
- p= sp->s_name;
- while (*p && p < &sp->s_name[IDL])
- p++;
- num = p - sp->s_name;
- outbyte( (byte) (sp->s_flags&SYMPRO ? sp_pnam : sp_dnam) );
- outint((short) num);
- p = sp->s_name;
- while (num--)
- outbyte( (byte) *p++ );
- }
-}
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "assert.h"
-#include "param.h"
-#include "types.h"
-#include "line.h"
-#include "proinf.h"
-#include "alloc.h"
-#include "../../h/em_spec.h"
-#include "../../h/em_pseu.h"
-#include "../../h/em_mes.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-regvar(ap) register arg_p ap; {
- register reg_p rp;
- register i;
-
- rp = newreg();
- i=0;
- while (ap!=(arg_p)0 && ap->a_typ==ARGOFF && i<4) {
- rp->r_par[i++]=ap->a_a.a_offset;
- ap=ap->a_next;
- }
- /*
- * Omit incomplete messages
- */
- switch(i) {
- default:assert(FALSE);
- case 0:
- case 1:
- case 2: oldreg(rp); return;
- case 3: rp->r_par[3]= (offset) 0; break;
- case 4: break;
- }
- rp->r_next = curpro.freg;
- curpro.freg = rp;
-}
-
-inreg(off) offset off; {
- register reg_p rp;
-
- for (rp=curpro.freg; rp != (reg_p) 0; rp=rp->r_next)
- if( rp->r_par[0] == off)
- return(TRUE);
- return(FALSE);
-}
-
-outregs() {
- register reg_p rp,tp;
- register i;
-
- for(rp=curpro.freg; rp != (reg_p) 0; rp = tp) {
- tp = rp->r_next;
- if (rp->r_par[3] != 0) {
- outinst(ps_mes);
- outoff((offset)ms_reg);
- for(i=0;i<4;i++)
- outoff(rp->r_par[i]);
- outinst(sp_cend);
- }
- oldreg(rp);
- }
- /* List of register messages is followed by an empty ms_reg
- * unless an ms_gto was in this procedure, then the ms_gto
- * will be output. Kludgy.
- */
- outinst(ps_mes);
- outoff((offset)(curpro.gtoproc? ms_gto : ms_reg));
- outinst(sp_cend);
- curpro.freg = (reg_p) 0;
-}
-
-incregusage(off) offset off; {
- register reg_p rp;
-
- for(rp=curpro.freg; rp != (reg_p) 0; rp=rp->r_next)
- if (rp->r_par[0]==off) {
- rp->r_par[3]++;
- return;
- }
-}
+++ /dev/null
-%{
-#ifndef NORCSID
-static char rcsid2[] = "$Header$";
-#endif
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-extern long atol();
-%}
-%%
-notreg return(NOTREG);
-sfit return(SFIT);
-ufit return(UFIT);
-rotate return(ROTATE);
-p return(PSIZE);
-w return(WSIZE);
-defined return(DEFINED);
-samesign return(SAMESIGN);
-rom return(ROM);
-[a-zA-Z]{3} {
- int m;
- m = mlookup(yytext);
- if (m==0) {
- REJECT;
- } else {
- yylval.y_int = m;
- return(MNEM);
- }
- }
-"&&" return(AND2);
-"||" return(OR2);
-"&" return(AND1);
-"|" return(OR1);
-"^" return(XOR1);
-"+" return(ARPLUS);
-"-" return(ARMINUS);
-"*" return(ARTIMES);
-"/" return(ARDIVIDE);
-"%" return(ARMOD);
-"==" return(CMPEQ);
-"!=" return(CMPNE);
-"<" return(CMPLT);
-"<=" return(CMPLE);
-">" return(CMPGT);
-">=" return(CMPGE);
-"!" return(NOT);
-"~" return(COMP);
-"<<" return(LSHIFT);
-">>" return(RSHIFT);
-[0-9]+ { long l= atol(yytext);
- if (l>32767) yyerror("Number too big");
- yylval.y_int= (int) l;
- return(NUMBER);
- }
-[ \t] ;
-. return(yytext[0]);
-\n { lino++; return(yytext[0]); }
-:[ \t]*\n[ \t]+ { lino++; return(':'); }
-^"# "[0-9]+.*\n { lino=atoi(yytext+2); }
-^\#.*\n { lino++; }
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include "param.h"
-#include "types.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-bool special(lpp,bp,patlen)
-line_p *lpp;
-byte *bp;
-int patlen;
-{
-
- return(FALSE);
-}
+++ /dev/null
-: '$Header$'
-while true
-do
- (echo ' mes 2,2,2
- pro $foo,0';cat;echo ' end') >t.e
- npc -2=${1-opt} -O -2 t.e;npc -D t.m
- cat t.e
-done
+++ /dev/null
-/* $Header$ */
-
-typedef char byte;
-typedef char bool;
-typedef struct line line_t;
-typedef struct line *line_p;
-typedef struct sym sym_t;
-typedef struct sym *sym_p;
-typedef struct num num_t;
-typedef struct num *num_p;
-typedef struct arg arg_t;
-typedef struct arg *arg_p;
-typedef struct argbytes argb_t;
-typedef struct argbytes *argb_p;
-typedef struct regs reg_t;
-typedef struct regs *reg_p;
-#ifdef LONGOFF
-typedef long offset;
-#else
-typedef short offset;
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "assert.h"
-#include "lookup.h"
-#include "proinf.h"
-#include "optim.h"
-#include "ext.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-
-/* VARARGS1 */
-error(s,a) char *s,*a; {
-
- fprintf(stderr,"%s: error on line %u",progname,linecount);
- if (prodepth != 0)
- fprintf(stderr,"(%.*s)",IDL,curpro.symbol->s_name);
- fprintf(stderr,": ");
- fprintf(stderr,s,a);
- fprintf(stderr,"\n");
- abort();
- exit(-1);
-}
-
-#ifndef NDEBUG
-badassertion(file,line) char *file; unsigned line; {
-
- fprintf(stderr,"assertion failed file %s, line %u\n",file,line);
- error("assertion");
-}
-#endif
-
-#ifdef DIAGOPT
-optim(n) {
-
- fprintf(stderr,"Made optimization %d",n);
- if (inpro)
- fprintf(stderr," (%.*s)",IDL,curpro.symbol->s_name);
- fprintf(stderr,"\n");
-}
-#endif
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#include <stdio.h>
-#include "param.h"
-#include "types.h"
-#include "lookup.h"
-#include "proinf.h"
-
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- * This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- * Dr. Andrew S. Tanenbaum
- * Wiskundig Seminarium
- * Vrije Universiteit
- * Postbox 7161
- * 1007 MC Amsterdam
- * The Netherlands
- *
- * Author: Hans van Staveren
- */
-
-unsigned linecount = 0; /* "line"number for errormessages */
-int prodepth = 0; /* Level of nesting */
-bool Lflag = 0; /* make library module */
-bool nflag = 0; /* do not optimize */
-line_p instrs,pseudos; /* pointers to chains */
-sym_p symhash[NSYMHASH]; /* array of pointers to chains */
-FILE *outfile;
-char template[] = "/usr/tmp/emoptXXXXXX";
-offset wordsize = 0;
-offset pointersize = 0;
-char *progname;
-proinf curpro; /* collected information about current pro */
public / ack.git / commitdiff