+++ /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
-# $Header$
-
-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) LLgen.$(SUF)\
-basic.$(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) $? >$@
-basic.$(SUF): basic.doc
- $(NROFF) $(MS) $? >$@
-peep.$(SUF): peep.doc
- $(NROFF) $(MS) $? >$@
-val.$(SUF): val.doc
- $(NROFF) $? >$@
-toolkit.$(SUF): toolkit.doc
- $(NROFF) $(MS) $? >$@
-LLgen.$(SUF): LLgen.doc
- eqn $? | $(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
-.\" $Header$
-.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
-.\" $Header$
-.TL
-.de Sy
-.LP
-.IP \fBsyntax\fR 10
-..
-.de PU
-.IP \fBpurpose\fR 10
-..
-.de RM
-.IP \fBremarks\fR 10
-..
-The ABC compiler
-.AU
-Martin L. Kersten
-.AI
-Department of Mathematics and Computer Science.
-.br
-Vrije Universiteit
-.AB
-This manual describes the
-programming language BASIC and its compiler
-included in the Amsterdam Compiler Kit.
-.AE
-.SH
-INTRODUCTION.
-.LP
-The BASIC-EM compiler is an extensive implementation of the
-programming language BASIC.
-The language structure and semantics are modelled after the
-BASIC interpreter/compiler of Microsoft (tr), a detailed comparison
-is provided in appendix A.
-.LP
-The compiler generates code for a virtual machine, the EM machine
-[[ACM, etc]]
-Using EM as an intermediate machine results in a highly portable
-compiler and BASIC code.
-The drawback of EM is that it does not directly reflect one particular
-hardware design, which means that many of
-the low level operations available within
-BASIC are ill-defined or even inapplicable.
-To mention a few, the peek and poke instructions are likely
-to be behave errorneous, while line printer and tapedeck
-primitives are unknown.
-.LP
-This manual is divided into three chapters.
-The first chapter discusses the general language syntax and semantics.
-Chapter two describes the statements available in BASIC-EM.
-Chapter 3 describes the predefined functions,
-ordered alphabetically.
-Appendix A discusses the differences with
-Microsoft BASIC. Appendix B describes all reserved symbols.
-Appendix C lists the error messages in use.
-.sp
-Additional information about EM and the Amsterdam Compiler Kit
-can be obtained from .... and found in ......
-.SH
-SyNTAX NOTATION
-.LP
-The conventions for syntax presentation are as follows:
-.IP CAPS 10
-Items are reserved words, must be input as shown
-.IP <> 10
-Items in lowercase letters enclosed in angular brackets
-are to be supplied by the user.
-.IP [] 10
-Items are optional.
-.IP \.\.\. 10
-Items may be repeated any number of times
-.IP {} 10
-A choice between two or more alternatives. At least one of the entries
-must be chosen.
-.IP | 10
-Vertical bars separate the choices within braces.
-.LP
-All punctuation must be included where shown.
-.NH 1
-GENERAL INFORMATION
-.LP
-The BASIC-EM compiler is designed for a UNIX based environment.
-It accepts a text file with your BASIC program (suffix .b) and generates
-an executable file, called a.out.
-.LP
-Should we call the preprocessor first?
-.NH 2
-LINE FORMAT
-.LP
-A BASIC program consists of a series of lines, starting with a
-positive line number in the range 0 to 65529.
-A line may consists of more then one physical line on your terminal, but must
-is limited to 1024 characters.
-Multiple BASIC statements may be placed on a single line, provided
-they are separated by a colon (:).
-.NH 2
-CONSTANTS
-.LP
-The BASIC compiler character set is comprised of alphabetic
-characters, numeric characters, and special characters shown below.
-.DS
-= + - * / ^ ( ) % # $ \\ _
-! [ ] , . ; : & ' ? > < \\ (blanc)
-.DE
-.LP
-BASIC uses two different types of constants during processing:
-numeric and string constants.
-.br
-A string constant is a sequence of characters taken from the ASCII
-character set enclosed by double quotation marks.
-.br
-Numeric constants are positive or negative numbers, grouped into
-five different classes.
-.IP "a) integer constants" 25
-Whole numbers in the range of -32768 and 32767. Integer constants do
-not contain decimal points.
-.IP "b) fixed point constants" 25
-Positive or negative real numbers, i.e. numbers with a decimal point.
-.IP "c) floating point constants" 25
-Real numbers in scientific notation. A floating point constant
-consists of an optional signed integer or fixed point number
-followed by the letter E (or D) and an optional signed integer
-(the exponent).
-The allowable range of floating point constants is 10^-38 to 10^+38.
-.IP "d) Hex constants" 25
-Hexadecimal numbers, denoted by the prefix &H.
-.IP "d) Octal constants" 25
-Octal numbers, denoted by the prefix &O.
-.NH 2
-VARIABLES
-.LP
-Variables are names used to represent values in a BASIC program.
-A variable is assigned a value by assigment specified in the program.
-Before a variable is assigned its value is assumed to be zero.
-.br
-Variable names are composed of letters, digits or the decimal point,
-starting with a letter. Up to 40 characters are significant.
-A variable name be be followed by any of the following type
-declaration characters:
-.IP % 5
-Defines an integer variable
-.IP ! 5
-Defines a single precision variable (see below)
-.IP # 5
-Defines a double precision variable
-.IP $ 5
-Defines a string variable.
-.LP
-NOTE: Two variables with the same name but different type is
-considered illegal (DONE?).
-.LP
-Beside single valued variables, values may be grouped
-into tables or arrays.
-Each element in an array is referenced by the array name and an index,
-such a variable is called a subscripted variable.
-An array has as many subscripts as there are dimensions in the array,
-the maximum of which is 11.
-.br
-If a variable starts with FN it is assumed to be a call to a user defined
-function.
-.br
-A variable name may not be a reserved word nor the name
-of a predefined function.
-A list of all reserved identifiers is included as Appendix ?.
-.NH 2
-EXPRESSIONS
-.LP
-BASIC-EM differs from Microsoft BASIC in supporting floats in one precision
-only (due to EM).
-All floating point constants have the same precision, i.e. 16 digits.
-.LP
-When necessary the compiler will convert a numeric value from
-one type to another.
-A value is always converted to the precision of the variable it is assigned
-to.
-When a floating point value is converted to an integer the fractional
-portion is rounded.
-In an expression all values are converted to the same degree of precision,
-i.e. that of the most precise operand.
-.br
-Division by zero results in the message "Division by zero".
-If overflow (or underflow) occurs, the "Overflow (underflow)" message is
-displayed and execution is terminated (contrary to Microsoft).
-.SH
-Arithmetic
-.LP
-The arithmetic operators in order of precedence,a re:
-.DS L
-\^ Exponentiation
-- Negation
-*,/,\\,MOD Multiplication, Division, Remainder
-+,- Addition, Substraction
-.DE
-The operator \\\\ denotes integer division, its operands are rounded to
-integers before the operator is applied.
-Modulus arithmetic is denoted by the operator MOD, which yields the
-integer value that is the remainder of an integer division.
-.br
-The order in which operators are performed can be changec with parentheses.
-.SH
-Relational
-.LP
-The relational operators in order of precedence, are:
-.DS
-= Equality
-<> Inequality
-< Less than
-> Greater than
-<= Less than or equal to
->= Greater than or equal to
-.DE
-The relational operators are used to compare two values and returns
-either "true" (-1) or "false" (0) (See IF statement).
-The precedence of the relational operators is lower
-then the arithmetic operators.
-.SH
-Logical
-.LP
-The logical operators performs tests on multiple relations, bit manipulations,
-or Boolean operations.
-The logical operators returns a bitwise result ("true" or "false").
-In an expression, logical operators are performed after the relational and
-arithmetic operators.
-The logical operators work by converting their operands to signed
-two-complement integers in the range -32768 to 32767.
-.DS
-NOT Bitwise negation
-AND Bitwise and
-OR Bitwise or
-XOR Bitwise exclusive or
-EQV Bitwise equivalence
-IMP Bitwise implies
-.DE
-.SH
-Functional
-.LP
-A function is used in an expression to call a system or user defined
-function.
-A list of predefined functions is presented in chapter 3.
-.SH
-String operations
-.LP
-Strings can be concatenated by using +. Strings can be compared with
-the relational operators. String comparison is performed in lexicographic
-order.
-.NH 2
-ERROR MESSAGES
-.LP
-The occurence of an error results in termination of the program
-unless an ON....ERROR statement has been encountered.
-.NH 1
-B-EM STATEMENTS
-.LP
-This chapter describes the statements available within the BASIC-EM
-compiler. Each description is formatted as follows:
-.Sy
-Shows the correct syntax for the statement. See introduction of
-syntax notation above.
-.PU
-Describes the purpose and details of the instructions.
-.RM
-Describes special cases, deviation from Microsoft BASIC etc.
-.LP
-.NH 2
-CALL
-.Sy
-CALL <variable name>[(<argument list>)]
-.PU
-The CALL statement provides the means to execute procedures
-and functions written in another language included in the
-Amsterdam Compiler Kit.
-The argument list consist of (subscripted) variables.
-The BASIC compiler pushes the address of the arguments on the stack in order
-of encounter.
-.RM
-Not yet available
-.NH 2
-CLOSE
-.Sy
-CLOSE [[#]<file number>[,[#]<file number...>]]
-.PU
-To terminate I/O on a disk file.
-<file number> is the number associated with the file
-when it was OPENed (See OPEN). Ommission of parameters results in closing
-all files.
-.sp
-The END statement and STOP statement always issue a CLOSE of
-all files.
-.NH 2
-DATA
-.Sy
-DATA <list of constants>
-.PU
-DATA statements are used to construct a data bank of values that are
-accessed by the program's READ statement.
-DATA statements are non-executable,
-the data items are assembled in a data file by the BASIC compiler.
-This file can be replaced, provided the layout remains
-the same (otherwise the RESTORE won't function properly).
-.sp
-The list of data items consists of numeric and string constants
-as discussed in section 1.
-Moreover, string constants starting with a letter and not
-containing blancs, newlines, commas, colon need not be enclosed with
-the string quotes.
-.sp
-DATA statements can be reread using the RESTORE statement.
-.NH 2
-DEF FN
-.Sy
-DEF FN<name> [(<parameterlist>)]=<expression>
-.PU
-To define and name a function that is written by the user.
-<name> must be an identifier and should be preceded by FN,
-which is considered integral part of the function name.
-<expression> defines the expression to be evaluated upon function call.
-.sp
-The parameter list is comprised of a comma separated
-list of variable names, used within the function definition,
-that are to replaced by values upon function call.
-The variable names defined in the parameterlist, called formal
-parameters, do not affect the definition and use of variables
-defined with the same name in the rest of the BASIC program.
-.sp
-A type declaration character may be suffixed to the function name to
-designate the data type of the function result.
-.NH 2
-DEFINT/SNG/DBL/STR
-.Sy
-DEF<type> <range of letters>
-.PU
-Any undefined variable starting with the letter included in the range of
-letters is declared of type <type> unless a type declaration character
-is appended.
-The range of letters is a comma separated list of characters and
-character ranges (<letter>-<letter>).
-.NH 2
-DIM
-.Sy
-DIM <list of subscripted variable>
-.PU
-The DIM statement allocates storage for subscripted variables.
-If an undefined subscripted variable is used
-the maximum value of the array subscript(s) is assumed to be 10.
-A subscript out of range is signalled by the program (when RCK works)
-The minimum subscript value is 0, unless the OPTION BASE statement has been
-encountered.
-.sp
-All variables in a subscripted variable are initially zero.
-.sp
-BUG. Multi-dimensional arrays MUST be defined.
-.NH 2
-END
-.Sy
-END
-.PU
-END terminates a BASIC program and returns to the UNIX shell.
-An END statement at the end of the BASIC program is optional.
-.NH 2
-ERR and ERL
-.PU
-Whenever an error occurs the variable ERR contains the
-error number and ERL the BASIC line where the error occurred.
-The variables are usually used in error handling routines
-provided by the user.
-.NH 2
-ERROR
-.Sy
-ERROR <integer expression>
-.PU
-To simulate the occurrence of a BASIC error.
-To define your own error code use a value not already in
-use by the BASIC runtime system.
-The list of error messages currently in use
-can be found in appendix B.
-.NH 2
-FIELD
-.PU
-To be implemented.
-.NH 2
-FOR...NEXT
-.Sy
-FOR <variable>= <low>TO<high>[STEP<size>]
-.br
- ......
-.br
-NEXT [<variable>][,<variable>...]
-.PU
-The FOR statements allows a series of statements to be performed
-repeatedly. <variable> is used as a counter. During the first
-execution pass it is assigned the value <low>,
-an arithmetic expression. After each pass the counter
-is incremented with the step size <size>, an expression.
-Ommission of the step size is intepreted as an increment of 1.
-Execution of the program lines specified between the FOR and the NEXT
-statement is terminated as soon as <low> is greater than <high>
-.sp
-The NEXT statement is labeled with the name(s) of the counter to be
-incremented.
-.sp
-The body of the FOR statement is skipped when the initial value of the
-loop times the sign of the step exceeds the value of the highest value
-times the sign of the step.
-.sp
-The variables mentioned in the NEXT statement may be ommitted, in which case
-the variable of increment the counter of the most recent FOR statement.
-If a NEXT statement is encountered before its corresponding FOR statement,
-the error message "NEXT without FOR" is generated.
-.NH 2
-GET
-.Sy
-GET [#]<file number>[, <record number>]
-.PU
-To be implemented.
-.NH 2
-GOSUB...RETURN
-.Sy
-GOSUB <line number
- ...
-.br
-RETURN
-.PU
-The GOSUB statement branches to the first statement of a subroutine.
-The RETURN statement cause a branch back to the statement following the
-most recent GOSUB statement.
-A subroutine may contain more than one RETURN statement.
-.sp
-Subroutines may be called recursively.
-Nesting of subroutine calls is limited, upon exceeding the maximum depth
-the error message "XXXXX" is displayed.
-.NH 2
-GOTO
-.Sy
-GOTO <line number>
-.PU
-To branch unconditionally to a specified line in the program.
-If <line number> does not exists, the compilation error message
-"Line not defined" is displayed.
-.RM
-Microsoft BASIC continues at the first line
-equal or greater then the line specified.
-.NH 2
-IF...THEN
-.Sy
-.br
-IF <expression> THEN {<statements>|<line number>}
-[ELSE {<statements>|<line number>}]
-.br
-.Sy
-IF <expression> GOTO <line number>
-[ELSE {<statements>|<line number>}]
-.PU
-The IF statement is used
-to make a decision regarding the program flow based on the
-result of the expressions.
-If the expression is not zero, the THEN or GOTO clause is
-executed. If the result of <expression> is zero, the THEN or
-GOTO clause is ignored and the ELSE clause, if present is
-executed.
-.br
-IF..THEN..ELSE statements may be nested.
-Nesting is limited by the length of the line.
-The ELSE clause matches with the closests unmatched THEN.
-.sp
-When using IF to test equality for a value that is the
-result of a floating point expression, remember that the
-internal representation of the value may not be exact.
-Therefore, the test should be against a range to
-handle the relative error.
-.RM
-Microsoft BASIC allows a comma before THEN.
-.NH 2
-INPUT
-.Sy
-INPUT [;][<"prompt string">;]<list of variables>
-.PU
-An INPUT statement can be used to obtain values from the user at the
-terminal.
-When an INPUT statement is encountered a question mark is printed
-to indicate the program is awaiting data.
-IF <"prompt string"> is included, the string is printed before the
-the question mark. The question mark is suppressed when the prompt
-string is followed by a comma, rather then a semicolon.
-.sp
-For each variable in the variable a list a value should be supplied.
-Data items presented should be separated by a comma.
-.sp
-The type of the variable in the variable list must aggree with the
-type of the data item entered. Responding with too few or too many
-data items causes the message "?Redo". No assignment of input values
-is made until an acceptable response is given.
-.RM
-The option to disgard the carriage return with the semicolon after the
-input symbol is not yet implemented.
-.NH 2
-INPUT [#]
-.Sy
-INPUT #<file number>,<list of variables>
-.PU
-The purpose of the INPUT# statement is to read data items from a sequential
-file and assign them to program variables.
-<file number> is the number used to open the file for input.
-The variables mentioned are (subscripted) variables.
-The type of the data items read should aggree with the type of the variables.
-A type mismatch results in the error message "XXXXX".
-.sp
-The data items on the sequential file are separated by commas and newlines.
-In scanning the file, leading spaces, new lines, tabs, and
-carriage returns are ignored. The first character encountered
-is assumed to be the state of a new item.
-String items need not be enclosed with double quotes, provided
-it does not contain spaces, tabs, newlines and commas,
-.RM
-Microsoft BASIC won't assign values until the end of input statement.
-This means that the user has to supply all the information.
-.NH 2
-LET
-.Sy
-[LET]<variable>=<expression>
-.PU
-To assign the value of an expression to a (subscribted) variable.
-The type convertions as dictated in section 1.X apply.
-.NH 2
-LINE INPUT
-.Sy
-LINE INPUT [;][<"prompt string">;]<string variable>
-.PU
-An entire line of input is assigned to the string variable.
-See INPUT for the meaning of the <"prompt string"> option.
-.NH 2
-LINE INPUT [#]
-.Sy
-LINE INPUT #<file number>,<string variable>
-.PU
-Read an entire line of text from a sequential file <file number>
-and assign it to a string variable.
-.NH 2
-LSET and RSET
-.PU
-To be implemented
-.NH 2
-MID$
-.Sy
-MID$(<string expr1>,n[,m])=<string expr2>
-.PU
-To replace a portion of a string with another string value.
-The characters of <string expr> replaces characters in <string expr1>
-starting at position n. If m is present, at most m characters are copied,
-otherwise all characters are copied.
-However, the string obtained never exceeds the length of string expr1.
-.NH 2
-ON ERROR GOTO
-.Sy
-ON ERROR GOTO <line number>
-.PU
-To enable error handling within the BASIC program.
-An error may result from arithmetic errors, disk problems, interrupts, or
-as a result of the ERROR statement.
-After printing an error message the program is continued at the
-statements associated with <line number>.
-.sp
-Error handling is disabled using ON ERROR GOTO 0.
-Subsequent errors result in an error message and program termination.
-.NH 2
-ON...GOSUB and ON ...GOTO
-.Sy
-ON <expression> GOSUB <list of line numbers>
-ON <expression> GOTO <list of line numbers>
-.PU
-To branch to one of several specified line numbers or subroutines, based
-on the result of the <expression>. The list of line numbers are considered
-the first, second, etc alternative. Branching to the first occurs when
-the expression evaluates to one, to the second alternative on two, etc.
-If the value of the expression in zero or greater than the number of alternatives, processing continues at the first statement following the ON..GOTO
-(ON GOSUB) statement.
-When the expression results in a negative number the
-an "Illegal function call" error occurs.
-.NH 2
-OPEN
-.NH 2
-OPTION BASE
-.Sy
-OPTION BASE n
-.PU
-To declare the lower bound of subsequent array subscripts as either
-0 or 1. The default lower bound is zero.
-.NH 2
-POKE
-.Sy
-POKE <expr1>,<expr2>
-.PU
-To poke around in memory. The use of this statement is not recommended,
-because it requires full understanding of both
-the implementation of the Amsterdam
-Compiler Kit and the hardware characteristics.
-.NH 2
-PRINT [USING]
-.NH 2
-PUT
-.PU
-To be implemented
-.NH 2
-RANDOMIZE
-.Sy
-RANDOMIZE [<expression>]
-.PU
-To reset the random seed. When the expression is ommitted, the system
-will ask for a value between -32768 and 32767.
-The random number generator returns the same sequence of values provided
-the same seed is used.
-.NH 2
-READ
-.Sy
-READ <list of variables>
-.PU
-To read values from the DATA statements and assign them to variables.
-The type of the variables should match to the type of the items being read,
-otherwise a "Syntax error" occurs.
-.NH 2
-REM
-.Sy
-REM <remark>
-.PU
-To include explantory information in a program.
-The REM statements are not executed.
-A single quote has the same effect as : REM, which
-allows for the inclusion of comment at the end of the line.
-.RM
-Microsoft BASIC does not allow REM statements as part of
-DATA lines.
-.NH 2
-RESTORE
-.Sy
-RESTORE [<line number>]
-.PU
-To allow DATA statements to be re-read from a specific line.
-After a RESTORE statement is executed, the next READ accesses
-the first item of the DATA statements.
-If <line number> is specified, the next READ accesses the first
-item in the specified line.
-.sp
-Note that data statements result in a sequential datafile generated
-by the compiler, being read by the read statements.
-This data file may be replaced using the operating system functions
-with a modified version, provided the same layout of items
-(same number of lines and items per line) is used.
-.NH 2
-STOP
-.Sy
-STOP
-.PU
-To terminate the execution of a program and return to the operating system
-command interpreter. A STOP statement results in the message "Break in line
-???"
-.NH 2
-SWAP
-.Sy
-SWAP <variable>,<variable>
-.PU
-To exchange the values of two variables.
-.NH 2
-TRON/TROFF
-.Sy
-TRON
-.Sy
-TROFF
-.PU
-As an aid in debugging the TRON statement results in a program
-listing each line being interpreted. TROFF disables generation of
-this code.
-.NH 2
-WHILE...WEND
-.Sy
-WHILE <expression>
- .....
-WEND
-.PU
-To execute a series of BASIC statements as long as a conditional expression
-is true. WHILE...WEND loops may be nested.
-.NH 2
-WRITE
-.Sy
-WRITE [<list of expressions>]
-.PU
-To write data at the terminal in DATA statement layout conventions.
-The expressions should be separated by commas.
-.NH 2
-WRITE #
-.Sy
-WRITE #<file number> ,<list of expressions>
-.PU
-To write a sequential data file, being opened with the "O" mode.
-The values are being writting using the DATA statements layout conventions.
-.NH
-FUNCTIONS
-.LP
-.IP ABS(X) 12
-Returns the absolute value of expression X
-.IP ASC(X$) 12
-Returns the numeric value of the first character of the string.
-If X$ is not initialized an "Illegal function call" error
-is returned.
-.IP ATN(X) 12
-Returns the arctangent of X in radians. Result is in the range
-of -pi/2 to pi/2.
-.IP CDBL(X) 12
-Converts X to a double precision number.
-.IP CHR$(X) 12
-Converts the integer value X to its ASCII character.
-X must be in the range of 0 to 127.
-It is used for cursor addressing and generating bel signals.
-.IP CINT(X) 12
-Converts X to an integer by rounding the fractional portion.
-If X is not in the range -32768 to 32767 an "Overflow"
-error occurs.
-.IP COS(X) 12
-Returns the cosine of X in radians.
-.IP CSNG(X) 12
-Converts X to a double precision number.
-.IP CVI(<2-bytes>) 12
-Convert two byte string value to integer number.
-.IP CVS(<4-bytes>) 12
-Convert four byte string value to single precision number.
-.IP CVD(<8-bytes>) 12
-Convert eight byte string value to double precision number.
-.IP EOF[(<file-number>)] 12
-Returns -1 (true) if the end of a sequential file has been reached.
-.IP EXP(X) 12
-Returns e(base of natural logarithm) to the power of X.
-X should be less then 10000.0.
-.IP FIX(X) 12
-Returns the truncated integer part of X. FIX(X) is
-equivalent to SGN(X)*INT(ABS(X)).
-The major difference between FIX and INT is that FIX does not
-return the next lower number for negative X.
-.IP HEX$(X) 12
-Returns the string which represents the hexadecimal value of
-the decimal argument. X is rounded to an integer using CINT
-before HEX$ is evaluated.
-.IP INT(X) 12
-Returns the largest integer <= X.
-.IP INPUT$(X[,[#]Y]) 12
-Returns the string of X characters read from the terminal or
-the designated file.
-.IP LEX(X$) 12
-Returns the number of characters in the string X$.
-Non printable and blancs are counted too.
-.IP LOC(<file\ number>) 12
-For sequential files LOC returns
-position of the read/write head, counted in number of bytes.
-For random files the function returns the record number just
-read or written from a GET or PUT statement.
-If nothing was read or written 0 is returned.
-.IP LOG(X) 12
-Returns the natural logarithm of X. X must be greater than zero.
-.IP MID$(X,I,[J]) 12
-To be implemented.
-.IP MKI$(X) 12
-Converts an integer expression to a two-byte string.
-.IP MKS$(X) 12
-Converts a single precision expression to a four-byte string.
-.IP MKD$(X) 12
-Converts a double precision expression to a eight-byte string.
-.IP OCT$(X) 12
-Returns the string which represents the octal value of the decimal
-argument. X is rounded to an integer using CINT before OCTS is evaluated.
-.IP PEEK(I) 12
-Returns the byte read from the indicated memory. (Of limited use
-in the context of ACK)
-.IP POS(I) 12
-Returns the current cursor position. To be implemented.
-.IP RIGHT$(X$,I)
-Returns the right most I characters of string X$.
-If I=0 then the empty string is returned.
-.IP RND(X) 12
-Returns a random number between 0 and 1. X is a dummy argument.
-.IP SGN(X) 12
-If X>0 , SGN(X) returns 1.
-.br
-if X=0, SGN(X) returns 0.
-.br
-if X<0, SGN(X) returns -1.
-.IP SIN(X) 12
-Returns the sine of X in radians.
-.IP SPACE$(X) 12
-Returns a string of spaces length X. The expression
-X is rounded to an integer using CINT.
-.IP STR$(X)
-Returns the string representation value of X.
-.IP STRING$(I,J) 12
-Returns thes string of length Iwhose characters all
-have ASCII code J. (or first character when J is a string)
-.IP TAB(I) 12
-Spaces to position I on the terminal. If the current
-print position is already beyond space I,TAB
-goes to that position on the next line.
-Space 1 is leftmost position, and the rightmost position
-is width minus 1. To be used within PRINT statements only.
-.IP TAN(X) 12
-Returns the tangent of X in radians. If TAN overflows
-the "Overflow" message is displayed.
-.IP VAL(X$) 12
-Returns the numerical value of string X$.
-The VAL function strips leading blanks and tabs from the
-argument string.
-.SH
-APPENDIX A DIFFERENCES WITH MICROSOFT BASIC
-.LP
-The following list of Microsoft commands and statements are
-not recognized by the compiler.
-.DS
-SPC
-USR
-VARPTR
-AUTO
-CHAIN
-CLEAR
-CLOAD
-COMMON
-CONT
-CSAVE
-DELETE
-EDIT
-ERASE
-FRE
-KILL
-LIST
-LLIST
-LOAD
-LPRINT
-MERGE
-NAME
-NEW
-NULL
-RENUM
-RESUME
-RUN
-SAVE
-WAIT
-WIDTH LPRINT
-.DE
-Some statements are in the current implementation not available,
-but will be soon. These include:
-.DS
-CALL
-DEFUSR
-FIELD
-GET
-INKEY
-INPUT$
-INSTR$
-LEFT$
-LSET
-RSET
-PUT
-.DE
+++ /dev/null
-.\" $Header$
-.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
-.ta 10m 20m 30m 40m 50m 60m
-\fBlol\fP 6 \fBlol\fP -2 \fBlol\fP 4
-\fBinc\fP \fBinc\fP but \fInot\fP \fBinc\fP
-\fBstl\fP 6 \fBstl\fP -2 \fBstl\fP -4
-.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 newplb(s)
-Must print the definition of procedure label \fIs\fR.
-If left undefined the newilb() macro is used instead.
-.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 fmt_ilb(ip,il,s)
-Must use the numbers
-.I ip
-and
-.I il
-which are a procedure number
-and a label number respectively and copy a string to
-.I s
-that must be unique for that combination.
-This procedure is optional, if it is not given ilb_fmt
-must be defined as below.
-.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 fmt_id(sf,st)
-Must take the string in
-.I sf
-which is a nonnumeric global label, and transform it into a copy made to
-.I st
-which will not collide with reserved assembler words and system labels.
-This procedure is optional, if it is not given the id_first macro is used
-as defined below.
-.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 newplb(x) fprintf(codefile,"%s:\en",x)
-#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
-.\" $Header$
-.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 initializer is the wordsize unless
-the indicator is followed by an integer specifying the
-initializer'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 (").
-Semicolon'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.
-.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.
-Each argument is used to allocate and initialize a number of
-consequtive bytes in data memory.
-The number of bytes to be allocated and the alignment depend on the type
-of the 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 initializers are aligned on a multiple of their size or the wordsize
-whichever is smaller.
-Strings form an exception, they are to be seen as a sequence of initializers
-each for one byte, i.e. strings are not padded with zero bytes.
-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.
-The default instruction pointer is used when the index is out of bounds.
-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));
- if (st>=0) and (st<=memw(a+wsize+asize)) then
- b:=mema(a+2*wsize+asize+asize*st) else 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
-.\" $Header$
-.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_DIR in em_path.h should be altered to
-specify the root
-directory for the Compiler Kit distribution on your system.
-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_DIR/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_DIR/mach/vax2/cg and
-EM_DIR/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_DIR/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
-.\" $Header$
-.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
-.\" $Header$
-.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
-.\" $Header$
-.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
-.\" $Header$
-.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
-.\" $Header$
-.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
-.\" $Header$
-.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 mP 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
-lae 4 1
-lal P4 2
-lal N4 3
-lde w4 4
-ldf 4 5
-ldl wP4 6
-ldl wN4 7
-lil wP4 8
-lil wN4 9
-loc 4 10
-loe w4 11
-lof 4 12
-lol wP4 13
-lol wN4 14
-lpi 4 15
-adp 4 16
-asp w4 17
-beq 4 18
-bge 4 19
-bgt 4 20
-ble 4 21
-blm 4 22
-blt 4 23
-bne 4 24
-bra 4 25
-cal 4 26
-dee w4 27
-del wP4 28
-del wN4 29
-fil 4 30
-gto 4 31
-ine w4 32
-inl wP4 33
-inl wN4 34
-lin 4 35
-sde 4 36
-sdf 4 37
-sdl wP4 38
-sdl wN4 39
-sil wP4 40
-sil wN4 41
-ste w4 42
-stf 4 43
-stl wP4 44
-stl wN4 45
-zeq 4 46
-zge 4 47
-zgt 4 48
-zle 4 49
-zlt 4 50
-zne 4 51
-zre w4 52
-zrl wP4 53
-zrl wN4 54
+++ /dev/null
-/* Intended as a common directory for ALL temporary files */
-#define TMP_DIR "/usr/tmp"
-
-/* Access to the ACK tree and parts thereof */
-#define EM_DIR "/usr/em" /* The root directory for EM stuff */
-#define RTERR_PATH "etc/pc_rt_errors"
-#define ACK_PATH "lib/ack"
+++ /dev/null
-/* collection of options, selected by including or excluding 'defines' */
-
-/* Version number of the EM object code */
-# define VERSION 3 /* 16 bits number */
-
-/* The default machine used by ack, acc, apc */
-# define ACKM "vax2"
+++ /dev/null
-install cmp:
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile *.h
-
-clean:
- -rm -f *.old
+++ /dev/null
-#define ARMAG 0177545
-struct ar_hdr {
- char ar_name[14];
- long ar_date;
- char ar_uid;
- char ar_gid;
- int ar_mode;
- long ar_size;
-};
-
-#define AR_TOTAL 26
-#define AR_SIZE 22
+++ /dev/null
-#define as_magic (sp_magic|(14<<8))
+++ /dev/null
-#include <stdio.h>
-
-/* $Header$ */
-
-/* BASIC file io definitions */
-
-extern FILE *_chanrd;
-extern FILE *_chanwr;
-extern int _chann;
-/* BASIC file descriptor table */
-/* Channel assignment:
- -1 terminal IO
- 0 data file
- 1-15 user files
-*/
-
-/* FILE MODES:*/
-#define IMODE 1
-#define OMODE 2
-#define RMODE 3
-
-typedef struct {
- char *fname;
- FILE *fd;
- int pos;
- int mode;
- int reclength;
- }Filedesc;
-extern Filedesc _fdtable[16];
+++ /dev/null
-#
-
-/* $Header$ */
-
-/* Strings are allocated in a fixed string descriptor table
-** This mechanism is used to avoid string copying as much as possible
-*/
-
-typedef struct{
- char *strval;
- int strcount;
- int strlength;
- } String;
-
-#define MAXSTRING 1024
+++ /dev/null
-/* offsets of interesting fields in EM-pattern */
-
-#define PO_HASH 0
-#define PO_NEXT 1
-#define PO_MATCH 3
-
-#define ILLHASH 0177777
-
-/* Escapes in printstrings */
-
-#define PR_TOK '\001'
-#define PR_TOKFLD '\002'
-#define PR_EMINT '\003'
-#define PR_EMSTR '\004'
-#define PR_ALLREG '\005'
-#define PR_SUBREG '\006'
-/*
- * In case this list gets longer remember to keep out printable nonprintables
- * like \t \n \r and the like.
- */
-
-/* Commands for codegenerator, in low order 5 bits of byte */
-
-#define DO_NEXTEM 0
-#define DO_MATCH 1
-#define DO_XMATCH 2
-#define DO_XXMATCH 3
-#define DO_REMOVE 4
-#define DO_DEALLOCATE 5
-#define DO_REALLOCATE 6
-#define DO_ALLOCATE 7
-#define DO_LOUTPUT 8
-#define DO_ROUTPUT 9
-#define DO_MOVE 10
-#define DO_ERASE 11
-#define DO_TOKREPLACE 12
-#define DO_EMREPLACE 13
-#define DO_COST 14
-#define DO_RETURN 15
-#define DO_COERC 16
-#define DO_PRETURN 17
-#define DO_RREMOVE 18
-
-typedef struct instance {
- int in_which;
-# define IN_COPY 1
-# define IN_RIDENT 2
-# define IN_ALLOC 3
-# define IN_DESCR 4
-# define IN_REGVAR 5
- int in_info[TOKENSIZE+1];
-} inst_t,*inst_p;
-
-typedef struct {
- int c_size; /* index in enode-table */
- int c_time; /* dito */
-} cost_t,*cost_p;
-
-typedef struct {
- int m_set1; /* number of tokenexpr in move: from */
- int m_expr1; /* optional expression */
- int m_set2; /* number of tokenexpr in move: to */
- int m_expr2; /* optional expression */
- int m_cindex; /* code index to really do it */
- cost_t m_cost; /* associated cost */
-} move_t, *move_p;
-
-typedef struct {
- int set_size;
- short set_val[SETSIZE];
-} set_t,*set_p;
-
-struct exprnode {
- short ex_operator;
- short ex_lnode;
- short ex_rnode;
-};
-typedef struct exprnode node_t;
-typedef struct exprnode *node_p;
-
-typedef struct { /* to stack coercions */
- int c1_texpno; /* token expression number */
- int c1_expr; /* boolean expression */
- int c1_prop; /* property of register needed */
- int c1_codep; /* code index */
- cost_t c1_cost; /* cost involved */
-} c1_t,*c1_p;
-
-#ifdef MAXSPLIT
-typedef struct { /* splitting coercions */
- int c2_texpno; /* token expression number */
- int c2_nsplit; /* split factor */
- int c2_repl[MAXSPLIT]; /* replacement instances */
- int c2_codep; /* code index */
-} c2_t,*c2_p;
-#endif MAXSPLIT
-
-typedef struct { /* one to one coercions */
- int c3_texpno; /* token expression number */
- int c3_prop; /* property of register needed */
- int c3_repl; /* replacement instance */
- int c3_codep; /* code index */
-} c3_t,*c3_p;
-
-/*
- * contents of .ex_operator
- */
-
-#define EX_TOKFIELD 0
-#define EX_ARG 1
-#define EX_CON 2
-#define EX_ALLREG 3
-#define EX_SAMESIGN 4
-#define EX_SFIT 5
-#define EX_UFIT 6
-#define EX_ROM 7
-#define EX_NCPEQ 8
-#define EX_SCPEQ 9
-#define EX_RCPEQ 10
-#define EX_NCPNE 11
-#define EX_SCPNE 12
-#define EX_RCPNE 13
-#define EX_NCPGT 14
-#define EX_NCPGE 15
-#define EX_NCPLT 16
-#define EX_NCPLE 17
-#define EX_OR2 18
-#define EX_AND2 19
-#define EX_PLUS 20
-#define EX_CAT 21
-#define EX_MINUS 22
-#define EX_TIMES 23
-#define EX_DIVIDE 24
-#define EX_MOD 25
-#define EX_LSHIFT 26
-#define EX_RSHIFT 27
-#define EX_NOT 28
-#define EX_COMP 29
-#define EX_COST 30
-#define EX_STRING 31
-#define EX_DEFINED 32
-#define EX_SUBREG 33
-#define EX_TOSTRING 34
-#define EX_UMINUS 35
-#define EX_REG 36
-#define EX_LOWW 37
-#define EX_HIGHW 38
-#define EX_INREG 39
-#define EX_REGVAR 40
-
-
-
-#define getint(a,b) \
- if ((a=((*(b)++)&BMASK)) >= 128) {\
- a = ((a-128)<<BSHIFT) | (*(b)++&BMASK); \
- }
+++ /dev/null
-#define LINO_AD 0
-#define FILN_AD 4
-
-#define LINO (*(int *)(_hol0()+LINO_AD))
-#define FILN (*(char **)(_hol0()+FILN_AD))
-
-#define EARRAY 0
-#define ERANGE 1
-#define ESET 2
-#define EIOVFL 3
-#define EFOVFL 4
-#define EFUNFL 5
-#define EIDIVZ 6
-#define EFDIVZ 7
-#define EIUND 8
-#define EFUND 9
-#define ECONV 10
-
-#define ESTACK 16
-#define EHEAP 17
-#define EILLINS 18
-#define EODDZ 19
-#define ECASE 20
-#define EMEMFLT 21
-#define EBADPTR 22
-#define EBADPC 23
-#define EBADLAE 24
-#define EBADMON 25
-#define EBADLIN 26
-#define EBADGTO 27
+++ /dev/null
-/*
- * The various different hints as given after a mes ms_ego
- *
- * Yet to be stabilized
- */
-
-#define ego_live 0 /* ,offset,size,regno */
-#define ego_dead 1 /* ,offset,size,regno */
-#define ego_assoc 2 /* ,offset,size,regno */
-#define ego_unass 3 /* ,offset,size,regno */
-#define ego_init 4 /* ,offset,size,regno */
-#define ego_update 5 /* ,offset,size,regno */
+++ /dev/null
-/* flags */
-#define EM_PAR 0017 /* parameter type */
-#define EM_FLO 0060 /* flow information */
-
-/* types */
-#define PAR_NO 0000 /* no parameter */
-#define PAR_C 0001 /* constant */
-#define PAR_D 0002 /* double word constant */
-#define PAR_N 0003 /* numeric (>=0) */
-#define PAR_F 0004 /* address offset */
-#define PAR_L 0005 /* addressing locals/parameters */
-#define PAR_G 0006 /* addressing globals */
-#define PAR_W 0007 /* size: word multiple, fits word, possibly indirect */
-#define PAR_S 0010 /* size: word multiple */
-#define PAR_Z 0011 /* size: zero or word multiple */
-#define PAR_O 0012 /* size: word multiple or word fraction */
-#define PAR_P 0013 /* procedure name */
-#define PAR_B 0014 /* branch: instruction label */
-#define PAR_R 0015 /* register number (0,1,2) */
-
-/* flow */
-#define FLO_NO 0000 /* straight on */
-#define FLO_C 0020 /* conditional branch */
-#define FLO_P 0040 /* procedure: call and return */
-#define FLO_T 0060 /* terminate: no return */
+++ /dev/null
-/*
- * mnemonics for the message numbers in EM
- */
-
-#define ms_err 0 /* Compilation error occurred, ignore rest of module */
-#define ms_opt 1 /* Disable optimization please */
-#define ms_emx 2 /* Wordsize and pointersize assumed */
-#define ms_reg 3 /* Hint for possible register usage from frontend */
-#define ms_src 4 /* Number of source lines in this module */
-#define ms_flt 5 /* Floating point used */
-#define ms_com 6 /* Comment to be retained in compact code */
-#define ms_ret 7 /* Reserved */
-#define ms_ext 8 /* List of exported symbols from this library module */
-#define ms_par 9 /* Number of bytes of parameters accessed */
-#define ms_ego 10 /* Hint from EM Global Optimizer */
-#define ms_gto 11 /* Dangerous procedure, uses nonlocal goto */
-
-/*
- * for details about ms_reg, see em_reg.h
- * for details about ms_ego, see em_ego.h
- */
+++ /dev/null
-#define ptyp(x) (1<<(x-sp_fspec))
-
-#define cst_ptyp 0000140
-#define sym_ptyp 0000034
-#define arg_ptyp 0000574
-#define con_ptyp 0036000
-#define val_ptyp 0037777
-#define any_ptyp 0137777
+++ /dev/null
-/*
- * mes ms_reg,offset,size,type,priority
- *
- * Here are the defines for type
- */
-
-#define reg_any 0 /* Unspecified type */
-#define reg_loop 1 /* loop control variable */
-#define reg_pointer 2 /* pointer variable */
-#define reg_float 3 /* floating point variable */
+++ /dev/null
-#define EARGC 64
-#define EEXP 65
-#define ELOG 66
-#define ESQT 67
-#define EASS 68
-#define EPACK 69
-#define EUNPACK 70
-#define EMOD 71
-#define EBADF 72
-#define EFREE 73
-
-#define EWRITEF 96
-#define EREADF 97
-#define EEOF 98
-#define EFTRUNC 99
-#define ERESET 100
-#define EREWR 101
-#define ECLOSE 102
-#define EREAD 103
-#define EWRITE 104
-#define EDIGIT 105
-#define EASCII 106
+++ /dev/null
-#define WRBIT 0100000
-#define TXTBIT 040000
-#define EOFBIT 020000
-#define ELNBIT 010000
-#define WINDOW 04000
-#define MAGIC 0252
-
-struct file {
- char *ptr;
- unsigned flags;
- char *fname;
- int ufd;
- int size;
- int count;
- int buflen;
- char bufadr[512];
-};
-
-#define EXTFL(z) ((struct file *)(_hbase + _extfl[z]))
+++ /dev/null
-/* fundamental */
-#define sz_byte 1
-#define sz_bool 1
-#define sz_char 1
-
-/* fixed for the time being */
-#define sz_word 2
-#define sz_int 2
-#define sz_long 4
-
-/* variable (see pc.c) */
-#define sz_addr sizes[0]
-#define sz_real sizes[1]
-#define sz_head sizes[2]
-#define sz_buff sizes[3]
-#define sz_mset sizes[4]
-#define sz_iset sizes[5]
-
-#define sz_last 5
-
-#define sz_proc 2*sz_addr
+++ /dev/null
-typedef char jmp_buf[256];
+++ /dev/null
-/*
- * Error codes
- */
-
-#define EPERM 1
-#define ENOENT 2
-#define ESRCH 3
-#define EINTR 4
-#define EIO 5
-#define ENXIO 6
-#define E2BIG 7
-#define ENOEXEC 8
-#define EBADF 9
-#define ECHILD 10
-#define EAGAIN 11
-#define ENOMEM 12
-#define EACCES 13
-#define EFAULT 14
-#define ENOTBLK 15
-#define EBUSY 16
-#define EEXIST 17
-#define EXDEV 18
-#define ENODEV 19
-#define ENOTDIR 20
-#define EISDIR 21
-#define EINVAL 22
-#define ENFILE 23
-#define EMFILE 24
-#define ENOTTY 25
-#define ETXTBSY 26
-#define EFBIG 27
-#define ENOSPC 28
-#define ESPIPE 29
-#define EROFS 30
-#define EMLINK 31
-#define EPIPE 32
-
-/* math software */
-#define EDOM 33
-#define ERANGE 34
-
-#define EQUOT 35
+++ /dev/null
-tail_bc.a
-abs.c
-asc.c
-asrt.c
-atn.c
-conversion.c
-error.c
-file.c
-hlt.c
-print.c
-read.c
-return.c
-salloc.c
-string.c
-trap.c
-write.c
-chr.c
-power.c
-io.c
-exp.c
-log.c
-sin.c
-sqt.c
-sgn.c
-random.c
-mki.c
-peek.c
-trace.c
-swap.c
-fef.e
-fif.e
-oct.c
-setline.e
-stop.c
+++ /dev/null
-/* $Header $ */
-
-long _abl(i) long i;
-{
- return( i>=0?i:-i);
-}
-double _abr(f) double f;
-{
- return( f>=0.0?f: -f);
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-int _asc(str)
-String *str;
-{
- if(str==0 || str->strval==0)
- error(3);
- return( *str->strval);
-}
+++ /dev/null
-/* $Header $ */
-
-asrt(b)
-{
- if(!b){
- printf("ASSERTION ERROR\n");
- abort();
- }
-}
+++ /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
- *
- */
-
-/* $Header $ */
-
-/* Author: J.W. Stevenson */
-
-/*
- floating-point arctangent
-
- atan returns the value of the arctangent of its
- argument in the range [-pi/2,pi/2].
-
- there are no error returns.
-
- coefficients are #5077 from Hart & Cheney. (19.56D)
-*/
-
-
-static double sq2p1 = 2.414213562373095048802e0;
-static double sq2m1 = .414213562373095048802e0;
-static double pio2 = 1.570796326794896619231e0;
-static double pio4 = .785398163397448309615e0;
-static double p4 = .161536412982230228262e2;
-static double p3 = .26842548195503973794141e3;
-static double p2 = .11530293515404850115428136e4;
-static double p1 = .178040631643319697105464587e4;
-static double p0 = .89678597403663861959987488e3;
-static double q4 = .5895697050844462222791e2;
-static double q3 = .536265374031215315104235e3;
-static double q2 = .16667838148816337184521798e4;
-static double q1 = .207933497444540981287275926e4;
-static double q0 = .89678597403663861962481162e3;
-
-/*
- xatan evaluates a series valid in the
- range [-0.414...,+0.414...].
-*/
-
-static double
-xatan(arg)
-double arg;
-{
- double argsq;
- double value;
-
- argsq = arg*arg;
- value = ((((p4*argsq + p3)*argsq + p2)*argsq + p1)*argsq + p0);
- value = value/(((((argsq + q4)*argsq + q3)*argsq + q2)*argsq + q1)*argsq + q0);
- return(value*arg);
-}
-
-static double
-satan(arg)
-double arg;
-{
- if(arg < sq2m1)
- return(xatan(arg));
- else if(arg > sq2p1)
- return(pio2 - xatan(1/arg));
- else
- return(pio4 + xatan((arg-1)/(arg+1)));
-}
-
-
-/*
- atan makes its argument positive and
- calls the inner routine satan.
-*/
-
-double
-_atn(arg)
-double arg;
-{
- if(arg>0)
- return(satan(arg));
- else
- return(-satan(-arg));
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-String *_chr(i)
-int i;
-{
- String *s;
- char buf[2];
-
- if( i<0 || i>127)
- error(3);
- buf[0]=i;
- buf[1]=0;
- s= (String *) _newstr(buf);
- return(s);
-}
+++ /dev/null
-/* $Header $ */
-
-int _cint(f) double f;
-{
- int r;
- if( f<-32768 || f>32767) error(4);
- if(f<0)
- r= f-0.5;
- else r= f+0.5;
- return(r);
-}
-
-double _trunc(f)
-double f;
-{
- long d;
- d=f;
- f=d;
- return( f );
-}
-
-double _fcint(f) double f;
-{
- long r;
- if(f<0){
- r= -f;
- r= -r -1;
- }else r= f;
- f=r;
- return(f);
-}
-int _fix(f)
-double f;
-{
- int r;
-
- if( f<-32768.0 || f>32767.0) error(4);
- r= _sgn(f) * _fcint((f>0.0? f : -f));
- return(r);
-}
+++ /dev/null
-/* $Header $ */
-
-/* error takes an error value in the range of 0-255 */
-/* and generates a trap */
-
-char *errortable[255]={
-/* 0 */ "",
-/* 1 */ "RETURN without GOSUB",
-/* 2 */ "Out of data",
-/* 3 */ "Illegal function call",
-/* 4 */ "Overflow",
-/* 5 */ "Out of memory",
-/* 6 */ "Undefined line ",
-/* 7 */ "Subscript out of range",
-/* 8 */ "Redimensioned array",
-/* 9 */ "Division by zero",
-/* 10 */ "Illegal indirect",
-/* 11 */ "Type mismatch",
-/* 12 */ "Out of string space",
-/* 13 */ "String too long",
-/* 14 */ "String formula too complex",
-/* 15 */ "Can't continue",
-/* 16 */ "Undefined user function",
-/* 17 */ "No resume",
-/* 18 */ "Resume without error",
-/* 19 */ "Unprintable error",
-/* 20 */ "Missing operand",
-/* 21 */ "Line buffer overflow",
-/* 22 */ "FOR without NEXT",
-/* 23 */ "WHILE without WEND",
-/* 24 */ "WEND without WHILE",
-/* 25 */ "Field overflow",
-/* 26 */ "Internal error",
-/* 27 */ "Bad file number",
-/* 28 */ "File not found",
-/* 29 */ "Bad file mode",
-/* 30 */ "File already open",
-/* 31 */ "Disk IO error",
-/* 32 */ "File already exists",
-/* 33 */ "Disk full",
-/* 34 */ "Input past end",
-/* 35 */ "Bad record number",
-/* 36 */ "Bad file name",
-/* 37 */ "Direct statement in file",
-/* 38 */ "Too many files",
-/* 39 */ "File not open",
-/* 40 */ "Syntax error in data",
-0
-};
-
-error(index)
-int index;
-{
- extern int _errsym;
- extern int _erlsym;
-
- _setline();
- if( index<0 || index >40 )
- printf("LINE %d:ERROR %d: Unprintable error\n",_erlsym,index);
- else printf("LINE %d:ERROR %d: %s\n",_erlsym,index,errortable[index]);
- _errsym= index;
- _trap();
-}
+++ /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
- *
- */
-
-/* $Header $ */
-
-/* Author: J.W. Stevenson */
-
-extern double _fif();
-extern double _fef();
-
-/*
- exp returns the exponential function of its
- floating-point argument.
-
- The coefficients are #1069 from Hart and Cheney. (22.35D)
-*/
-
-#define HUGE 1.701411733192644270e38
-
-static double p0 = .2080384346694663001443843411e7;
-static double p1 = .3028697169744036299076048876e5;
-static double p2 = .6061485330061080841615584556e2;
-static double q0 = .6002720360238832528230907598e7;
-static double q1 = .3277251518082914423057964422e6;
-static double q2 = .1749287689093076403844945335e4;
-static double log2e = 1.4426950408889634073599247;
-static double sqrt2 = 1.4142135623730950488016887;
-static double maxf = 10000.0;
-
-static double
-floor(d)
-double d;
-{
- if (d<0) {
- d = -d;
- if (_fif(d, 1.0, &d) != 0)
- d += 1;
- d = -d;
- } else
- _fif(d, 1.0, &d);
- return(d);
-}
-
-static double
-ldexp(fr,exp)
-double fr;
-int exp;
-{
- int neg,i;
-
- neg = 1;
- if (fr < 0) {
- fr = -fr;
- neg = -1;
- }
- fr = _fef(fr, &i);
- /*
- while (fr < 0.5) {
- fr *= 2;
- exp--;
- }
- */
- exp += i;
- if (exp > 127) {
- error(3);
- return(neg * HUGE);
- }
- if (exp < -127)
- return(0);
- while (exp > 14) {
- fr *= (1<<14);
- exp -= 14;
- }
- while (exp < -14) {
- fr /= (1<<14);
- exp += 14;
- }
- if (exp > 0)
- fr *= (1<<exp);
- if (exp < 0)
- fr /= (1<<(-exp));
- return(neg * fr);
-}
-
-double
-_exp(arg)
-double arg;
-{
- double fract;
- double temp1, temp2, xsq;
- int ent;
-
- if(arg == 0)
- return(1);
- if(arg < -maxf)
- return(0);
- if(arg > maxf) {
- error(3);
- return(HUGE);
- }
- arg *= log2e;
- ent = floor(arg);
- fract = (arg-ent) - 0.5;
- xsq = fract*fract;
- temp1 = ((p2*xsq+p1)*xsq+p0)*fract;
- temp2 = ((xsq+q2)*xsq+q1)*xsq + q0;
- return(ldexp(sqrt2*(temp2+temp1)/(temp2-temp1), ent));
-}
+++ /dev/null
-#
- mes 2,EM_WSIZE,EM_PSIZE
-
-; $Header$
-
-#define FARG 0
-#define ERES EM_DSIZE
-
-; _fef is called with two parameters:
-; - address of exponent result (ERES)
-; - floating point number to be split (FARG)
-; and returns an EM_DSIZE-byte floating point number
-
- exp $_fef
- pro $_fef,0
- lal FARG
- loi EM_DSIZE
- fef EM_DSIZE
- lal ERES
- loi EM_PSIZE
- sti EM_WSIZE
- ret EM_DSIZE
- end ?
+++ /dev/null
-#
- mes 2,EM_WSIZE,EM_PSIZE
-
-; $Header$
-
-#define ARG1 0
-#define ARG2 EM_DSIZE
-#define IRES 2*EM_DSIZE
-
-; _fif is called with three parameters:
-; - address of integer part result (IRES)
-; - float two (ARG2)
-; - float one (ARG1)
-; and returns an EM_DSIZE-byte floating point number
-
- exp $_fif
- pro $_fif,0
- lal 0
- loi 2*EM_DSIZE
- fif EM_DSIZE
- lal IRES
- loi EM_PSIZE
- sti EM_DSIZE
- ret EM_DSIZE
- end ?
+++ /dev/null
-#include "string.h"
-#include <stdio.h>
-#include "io.h"
-
-/* $Header $ */
-
-Filedesc _fdtable[16];
-/* BASIC file descriptor table */
-/* Channel assignment:
- -1 terminal IO
- 0 data file
- 1-15 user files
-*/
-
-
-
-int _chann = -1;
-FILE *_chanrd = stdin;
-FILE *_chanwr = stdout;
-
-_setchannel(index)
-int index;
-{
-#ifdef DEBUG
- printf("setchannel %d\n",index);
-#endif
- fflush(_chanwr);
- if( index == -1)
- {
- _chann= -1;
- _chanrd= stdin;
- _chanwr= stdout;
- return;
- }
- if( index<0 || index>15)
- error(27);
- _chann=index;
- _chanrd= _chanwr= _fdtable[index].fd;
-}
-
-_asschn()
-{
-#ifdef DEBUG
- printf("_asschn %d\n",_chann);
-#endif
- if( _chann == -1) return;
-#ifdef DEBUG
- printf(" file %d\n", _fdtable[_chann].fd);
-#endif
- if( _chann<0 || _chann>15)
- error(27);
- if( _fdtable[_chann].fd== 0)
- error(39);
- if( feof( _fdtable[_chann].fd))
- error(2);
-}
-
-_clochn(nr)
-int nr;
-{
- if( nr<1 || nr >15 || _fdtable[nr].fd==0) error(3);
- fclose(_fdtable[nr].fd);
- _fdtable[nr].fd=0; _fdtable[nr].fname=0;
-}
-
-_opnchn(reclen,fname,mode)
-String *mode,*fname;
-int reclen;
-{
- /* channel has been set */
- FILE *f;
- int m;
-
-#ifdef DEBUG
- printf("open %d %s %s \n",reclen,mode->strval,fname->strval);
-#endif
- /* check for opened/closed file */
- if(_fdtable[_chann].fd)
- error(30);
- switch(*mode->strval)
- {
- case 'O':
- case 'o':
- if( (f=fopen(fname->strval,"w")) == NULL)
- error(28);
- m= OMODE;
- break;
- case 'I':
- case 'i':
- if( (f=fopen(fname->strval,"r")) == NULL)
- error(28);
- m= IMODE;
- break;
- case 'r':
- case 'R':
- if( (f=fopen(fname->strval,"a")) == NULL)
- error(28);
- m= RMODE;
- break;
- default:
- printf("file mode %s\n",mode->strval);
- error(29);
- }
- _chanrd= _fdtable[_chann].fd= f;
- _fdtable[_chann].fname= fname->strval;
- _fdtable[_chann].reclength= reclen;
- _fdtable[_chann].mode= m;
-#ifdef DEBUG
- printf("file descr %d\n",f);
-#endif
-}
-
-_ioeof(channel)
-int channel;
-{
- FILE *fd;
- char c;
- if( channel<0 || channel >15) error(3);
- fd= _fdtable[channel].fd;
- if( fd==0)
- error(3);
- c=fgetc(fd);
- if( feof(_fdtable[channel].fd) ) return(-1);
- ungetc(c,fd);
- return(0);
-}
-
-_close()
-{
- /* close all open files */
- int i;
- for(i=1;i<16;i++)
- if( _fdtable[i].fd)
- _clochn(i);
-}
+++ /dev/null
-/* $Header $ */
-
-_hlt(nr)
-int nr;
-{
- exit(nr);
-}
+++ /dev/null
-#include "io.h"
-#include <sgtty.h>
-
-/* $Header $ */
-
-struct sgttyb _ttydef;
-
-/* BASIC has some nasty io characteristics */
-
-#define MAXWIDTH 255
-
-int _width = 75, _pos=0, _zonewidth=15;
-
-_out(str)
-char *str;
-{
- int pos;
-
- if( _chann== -1) pos= _pos;
- else pos= _fdtable[_chann].pos;
- while( *str)
- {
- if( pos>= _width){ _outnl(); pos=0;}
- fputc(*str++, _chanwr);
- pos++;
- }
- if( _chann== -1) _pos=pos;
- else _fdtable[_chann].pos= pos;
-}
-
-_outnl()
-{
- fputc('\n',_chanwr);
- if( _chann == -1)
- _pos=0;
- else
- _fdtable[_chann].pos=0;
-}
-_zone()
-{
- /* go to next zone */
- int pos;
- if( _chann == -1)
- pos= _pos;
- else pos= _fdtable[_chann].pos;
- do{
- fputc(' ',_chanwr);
- pos++;
- if( pos==_width)
- {
- _outnl();
- pos=0;
- break;
- }
- } while( pos % _zonewidth != 0);
- if( _chann== -1) _pos=pos;
- else _fdtable[_chann].pos= pos;
-}
-_in(buf)
-char *buf;
-{
- char *c;
- int pos;
- if( _chann == -1)
- {
- pos= _pos;
- gtty(0,_ttydef);
- _ttydef.sg_flags &= ~ECHO;
- stty(0,_ttydef);
- }else pos= _fdtable[_chann].pos;
- c= buf;
- while( (*c = fgetc(_chanrd)) != EOF && *c != '\n'){
- if( _chann == -1) putchar(*c);
- c++; pos++;
- }
- *c= 0;
- if( _chann== -1)
- {
- _pos=pos;
- _ttydef.sg_flags |= ECHO;
- stty(0,_ttydef);
- } else _fdtable[_chann].pos= pos;
-}
-_tab(x)
-int x;
-{
- if( x> _width) error(3);
- if( x< _pos) _outnl();
- _spc(x-_pos);
-}
-_spc(x)
-int x;
-{
- while(x-->0) _out(" ");
-}
+++ /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
- *
- */
-
-/* $Header $ */
-
-/* Author: J.W. Stevenson */
-
-extern double _fef();
-
-/*
- log returns the natural logarithm of its floating
- point argument.
-
- The coefficients are #2705 from Hart & Cheney. (19.38D)
-
- It calls _fef.
-*/
-
-#define HUGE 1.701411733192644270e38
-
-static double log2 = 0.693147180559945309e0;
-static double sqrto2 = 0.707106781186547524e0;
-static double p0 = -.240139179559210510e2;
-static double p1 = 0.309572928215376501e2;
-static double p2 = -.963769093368686593e1;
-static double p3 = 0.421087371217979714e0;
-static double q0 = -.120069589779605255e2;
-static double q1 = 0.194809660700889731e2;
-static double q2 = -.891110902798312337e1;
-
-double
-_log(arg)
-double arg;
-{
- double x,z, zsq, temp;
- int exp;
-
- if(arg <= 0) {
- error(3);
- return(-HUGE);
- }
- x = _fef(arg,&exp);
- /*
- while(x < 0.5) {
- x =* 2;
- exp--;
- }
- */
- if(x<sqrto2) {
- x *= 2;
- exp--;
- }
-
- z = (x-1)/(x+1);
- zsq = z*z;
-
- temp = ((p3*zsq + p2)*zsq + p1)*zsq + p0;
- temp = temp/(((zsq + q2)*zsq + q1)*zsq + q0);
- temp = temp*z + exp*log2;
- return(temp);
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-String *_mki(i)
-int i;
-{
- char *buffer =" ";
- String *s;
-
- s= (String *) _newstr(buffer);
- strncpy(s->strval,&i,2);
- return(s);
-}
-String *_mkd(d)
-double d;
-{
- char *buffer =" ";
- String *s;
-
- s= (String *) _newstr(buffer);
- strncpy(s->strval,&d,8);
- return(s);
-}
-_cvi(s)
-String *s;
-{
- int i;
- strncpy(&i,s->strval,2);
- return(i);
-}
-double _cvd(s)
-String *s;
-{
- double d;
- strncpy(&d,s->strval,8);
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-String *_oct(i)
-int i;
-{
- char buffer[30];
- sprintf(buffer,"%o",i);
- return( (String *)_newstr(buffer));
-}
-
-String *_hex(i)
-int i;
-{
- char buffer[30];
- sprintf(buffer,"%x",i);
- return( (String *)_newstr(buffer));
-}
+++ /dev/null
-/* $Header $ */
-
-int peek(addr)
-int addr;
-{
- /* this can not work properly for machines in which the
- POINTERSIZE differs from the integer size
- */
- char *p;
- int i;
-
- p= (char *)addr;
- i= *p;
-#ifdef DEBUG
- printf("peek %d = %d\n",addr,i);
-#endif
- return(i);
-}
-
-_poke(i,j)
-int i,j;
-{
- char *p;
- p= (char *) i;
- *p=j;
-}
+++ /dev/null
-/* $Header $ */
-
-/*
- computes a^b.
- uses log and exp
-*/
-
-double _log(), _exp();
-
-double
-_power(base,pownr)
-double pownr, base;
-{
- double temp;
- long l;
-
- if(pownr <= 0.0) {
- if(pownr == 0.0) {
- if(base <= 0.0)
- error(3);
- return(0.0);
- }
- l = base;
- if(l != base)
- error(3);
- temp = _exp(base * _log(-pownr));
- if(l & 1)
- temp = -temp;
- return(temp);
- }
- return(_exp(base * _log(pownr)));
-}
+++ /dev/null
-#include "string.h"
-#include "io.h"
-
-/* $Header $ */
-
-/* Here all routine to generate terminal oriented output is located */
-
-_qstmark()
-{
- /* prompt for terminal input */
- putchar('?');
-}
-
-_nl()
-{
- _asschn();
- _outnl();
-}
-_prinum(i)
-int i;
-{
- char buffer[40];
-
- _asschn();
- if(i>=0)
- sprintf(buffer," %d ",i);
- else sprintf(buffer,"-%d ",-i);
- _out(buffer);
-}
-_str(f,buffer)
-double f;
-char *buffer;
-{
- char *c;
- c= buffer;
- if( f>=0){
- if( f> 1.0e8)
- sprintf(buffer," %e",f);
- else sprintf(buffer," %f",f);
- c++;
- }else {
- if(-f> 1.0e8)
- sprintf(buffer,"-%e",-f);
- else sprintf(buffer,"-%f",-f);
- }
- for( ; *c && *c!= ' ';c++) ;
- c--;
- while( c>buffer && *c== '0')
- {
- *c= 0;c--;
- }
- if( *c=='.') *c=0;
- strcat(buffer," ");
-}
-_prfnum(f)
-double f;
-{
- /* BASIC strings trailing zeroes */
- char buffer[100];
- char *c;
-
- _asschn();
- c= buffer;
- _str(f,c);
- _out(buffer);
-}
-_prstr(str)
-String *str;
-{
- _asschn();
- if( str==0) _out("<null>");
- else _out(str->strval);
-}
+++ /dev/null
-/* $Header $ */
-
-_randomize()
-{
- int i;
- double f;
- _setchannel(-1);
- printf("Random number seed (-32768 to 32767) ? ");
- _readint(&i);
- f=i;
- _setrandom(f);
-}
-
-_setrandom(f)
-double f;
-{
- int i;
- i=f;
- srand(i);
-}
-double _rnd(d) double d;
-{
- double f; f= (int) rand();
- return(f/32767.0);
-}
+++ /dev/null
-#include "string.h"
-#include "io.h"
-#include <ctype.h>
-
-/* $Header $ */
-
-_readln()
-{
- char c;
- while( (c=fgetc(_chanrd)) != EOF && c!= '\n')
- ;
-}
-
-readskip()
-{
- char c;
-#ifdef DEBUG
- printf("readskip\n");
-#endif
- while( (c=fgetc(_chanrd)) != EOF && c!= ',' && c!= '\n')
- ;
-}
-_readint(addr)
-int *addr;
-{
- int i;
- char buf[1024];
-
-#ifdef DEBUG
- printf("read int from %d\n",_chann);
-#endif
- _asschn();
- if( fscanf(_chanrd,"%d",&i) != 1)
- {
- if( ferror(_chanrd)) error(29);
- if( feof(_chanrd)) error(2);
- if( _chann == -1)
- {
- _asschn(); /* may be closed by now */
- fgets(buf,1024,_chanrd);
- printf("?Redo ");
- _readint(addr);
- return;
- }
- error(40);
- }else { readskip(); *addr=i;}
-}
-_readflt(addr)
-double *addr;
-{
- double f;
- char buf[1024];
-
-#ifdef DEBUG
- printf("read flt from %d\n",_chann);
-#endif
- _asschn();
- if( fscanf(_chanrd,"%lf",&f) != 1)
- {
- if( ferror(_chanrd)) error(29);
- if( feof(_chanrd)) error(2);
- if( _chann == -1)
- {
- fgets(buf,1024,_chanrd);
- printf("?Redo ");
- _readflt(addr);
- return;
- }
- error(40);
- }else { readskip(); *addr=f;}
-}
-_readstr(s)
-String **s;
-{
- char buffer[1024];
- char *c;
-
-#ifdef DEBUG
- printf("read str from %d\n",_chann);
-#endif
- _asschn();
- c= buffer;
- *c= fgetc(_chanrd);
- while(isspace(*c) && *c!= EOF)
- *c= fgetc(_chanrd);
- if( *c== '"')
- {
- /* read quoted string */
-#ifdef DEBUG
- printf("qouted string\n");
-#endif
- while( (*c= fgetc(_chanrd)) != '"' && *c!= EOF ) c++;
- ungetc(*c,_chanrd);
- *c=0;
- }else
- if( isalpha(*c))
- {
- /* read normal string */
- c++;
-#ifdef DEBUG
- printf("non-qouted string\n");
-#endif
- while( (*c= fgetc(_chanrd)) != ',' && *c!= EOF &&
- !isspace(*c) && *c!='\n')
- c++;
- ungetc(*c,_chanrd);
- *c=0;
- }else{
- if( ferror(_chanrd)) error(29);
- if( feof(_chanrd)) error(2);
- if( _chann == -1)
- {
- fgets(buffer,1024,_chanrd);
- printf("?Redo ");
- _rdline(s);
- return;
- }
- error(40);
- }
-#ifdef DEBUG
- printf("string read: %s\n",buffer);
-#endif
- readskip();
- /* save value read */
- _decstr(*s);
- *s= (String *) _newstr(buffer);
-}
-
-extern int _seektable[];
-
-_restore(line)
-int line;
-{
- int nr;
- char buffer[1024];
-
-#ifdef DEBUG
- printf("seek to %d",line);
-#endif
- fseek(_chanrd,0l,0);
- if( line)
- {
- /* search number of lines to skip */
- for(nr=0; _seektable[nr] && _seektable[nr]< line; nr+=2)
-#ifdef DEBUG
- printf("test %d %d\n",_seektable[nr], _seektable[nr+1]);
-#endif
- ;
- nr /= 2;
-#ifdef DEBUG
- printf(" %d lines to skip\n",nr);
-#endif
- while(nr-- >0 ) fgets(buffer,1024,_chanrd);
- }
-}
-_rdline(s)
-String **s;
-{
- char buffer[1024];
- if( fgets(buffer,1024,_chanrd) == 0)
- {
- if( _chann == -1)
- {
- printf("?Redo ");
- _rdline(s);
- return;
- }
- error(40);
- }
- _decstr(*s);
- *s= (String *) _newstr(buffer);
-}
+++ /dev/null
-/* $Header $ */
-
-#define MAXNESTING 1000
-
-int _gotable[MAXNESTING];
-int topstk=0;
-
-_gosub(x)
-int x;
-{
- /* administer gosub */
-#ifdef DEBUG
- printf("store %d in %d\n",x,topstk);
-#endif
- if( topstk== MAXNESTING) error(26);
- _gotable[topstk]= x;
- topstk++;
-}
-_retstmt()
-{
- /* make sure that a return label index is on top
- of the stack */
-#ifdef DEBUG
- printf("return to %d %d\n",_gotable[topstk-1],topstk-1);
-#endif
- if( topstk==0 || topstk==MAXNESTING)
- error(1);
- return( _gotable[--topstk]);
-}
+++ /dev/null
-/* $Header $ */
-
-char * salloc(length)
-int length;
-{
- char *c, *s;
- c= (char *) malloc(length);
- if( c== (char *) -1) error(5);
- for(s=c;s<c+length;s++) *s = 0;
- return(c);
-}
-
-sfree(c)
-char *c;
-{
- if( c== 0) return;
- free(c);
-}
+++ /dev/null
-#
- mes 2,EM_WSIZE,EM_PSIZE
-; $Header$
-; Save the line where the error occurred
- exp $_setline
- pro $_setline,0
- exa _erlsym
- loe 0
- ste _erlsym
- ret 0
- end
+++ /dev/null
-/* $Header $ */
-
-_sgn(v)
-double v;
-{
- if( v>0) return(1);
- if( v<0) return(-1);
- return(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
- *
- */
-
-/* $Header $ */
-
-/* Author: J.W. Stevenson */
-
-extern double _fif();
-
-/*
- C program for floating point sin/cos.
- Calls _fif.
- There are no error exits.
- Coefficients are #3370 from Hart & Cheney (18.80D).
-*/
-
-static double twoopi = 0.63661977236758134308;
-static double p0 = .1357884097877375669092680e8;
-static double p1 = -.4942908100902844161158627e7;
-static double p2 = .4401030535375266501944918e6;
-static double p3 = -.1384727249982452873054457e5;
-static double p4 = .1459688406665768722226959e3;
-static double q0 = .8644558652922534429915149e7;
-static double q1 = .4081792252343299749395779e6;
-static double q2 = .9463096101538208180571257e4;
-static double q3 = .1326534908786136358911494e3;
-
-static double
-sinus(arg, quad)
-double arg;
-int quad;
-{
- double e, f;
- double ysq;
- double x,y;
- int k;
- double temp1, temp2;
-
- x = arg;
- if(x<0) {
- x = -x;
- quad = quad + 2;
- }
- x = x*twoopi; /*underflow?*/
- if(x>32764){
- y = _fif(x, 10.0, &e);
- e = e + quad;
- _fif(0.25, e, &f);
- quad = e - 4*f;
- }else{
- k = x;
- y = x - k;
- quad = (quad + k) & 03;
- }
- if (quad & 01)
- y = 1-y;
- if(quad > 1)
- y = -y;
-
- ysq = y*y;
- temp1 = ((((p4*ysq+p3)*ysq+p2)*ysq+p1)*ysq+p0)*y;
- temp2 = ((((ysq+q3)*ysq+q2)*ysq+q1)*ysq+q0);
- return(temp1/temp2);
-}
-
-double
-_cos(arg)
-double arg;
-{
- if(arg<0)
- arg = -arg;
- return(sinus(arg, 1));
-}
-
-double
-_sin(arg)
-double arg;
-{
- return(sinus(arg, 0));
-}
-
-/* EXTENSION */
-double
-_tan(arg)
-double arg;
-{
- return( _sin(arg)/_cos(arg));
-}
+++ /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
- *
- */
-
-/* $Header $ */
-
-/* Author: J.W. Stevenson */
-
-extern double _fef();
-
-/*
- sqrt returns the square root of its floating
- point argument. Newton's method.
-
- calls _fef
-*/
-
-double
-_sqt(arg)
-double arg;
-{
- double x, temp;
- int exp;
- int i;
-
- if(arg <= 0) {
- if(arg < 0)
- error(3);
- return(0);
- }
- x = _fef(arg,&exp);
- /*
- while(x < 0.5) {
- x =* 2;
- exp--;
- }
- */
- /*
- * NOTE
- * this wont work on 1's comp
- */
- if(exp & 1) {
- x *= 2;
- exp--;
- }
- temp = 0.5*(1 + x);
-
- while(exp > 28) {
- temp *= (1<<14);
- exp -= 28;
- }
- while(exp < -28) {
- temp /= (1<<14);
- exp += 28;
- }
- if(exp >= 0)
- temp *= 1 << (exp/2);
- else
- temp /= 1 << (-exp/2);
- for(i=0; i<=4; i++)
- temp = 0.5*(temp + arg/temp);
- return(temp);
-}
+++ /dev/null
-/* $Header $ */
-
-_stop()
-{
- extern int _erlsym;
-
- _setline();
- printf("Break in %d\n", _erlsym);
- exit(0);
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-#define ok(X) if( X ==0) return;
-#define okr(X) if( X ==0) return(0);
-
-_len(str)
-String *str;
-{
- okr(str);
- return(str->strlength);
-}
-String *_newstr(str)
-char *str;
-{
- String *s;
- okr(str);
- s= (String *) salloc(sizeof(String));
- s->strcount=1;
- s->strlength= strlen(str);
- s->strval= (char *) salloc(s->strlength+1);
- strcpy(s->strval,str);
- return(s);
-}
-_incstr(src)
-String *src;
-{
- /* one more variable uses the string */
- ok(src);
- src->strcount++;
-}
-_decstr(str)
-String *str;
-{
- ok(str);
- str->strcount--;
- if(str->strcount<=0) _delstr(str);
-}
-_strcpy(dst,src)
-String *src,*dst;
-{
- ok(src);
- ok(dst);
- _decstr(dst);
- *dst = *src;
- _incstr(src);
-}
-_delstr(src)
-String *src;
-{
- ok(src);
- sfree(src->strval);
- sfree(src);
-}
-String *_concat(s1,s2)
-String *s1,*s2;
-{
- String *s;
- int length;
- okr(s1); okr(s2);
- s= (String *) salloc(sizeof(String));
- length= _len(s1)+_len(s2)+1;
- s->strval= (char *) salloc(length);
- strcpy(s->strval,s2->strval);
- strcat(s->strval,s1->strval);
- return(s);
-}
-_strcompare(s1,s2)
-String *s1,*s2;
-{
- okr(s1);okr(s2);
- return(strcmp(s2->strval,s1->strval));
-}
-
-String *_left(size,s)
-String *s;
-int size;
-{
- String *ns;
- int i;
-
- okr(s);
- if( size <0 || size >s->strlength) error(3);
- ns= (String *) salloc(sizeof(String));
- ns->strval= (char *) salloc(size+1);
- ns->strcount=1;
- for(i=0; i<size && s->strval[i];i++)
- ns->strval[i]= s->strval[i];
- ns->strval[i]=0;
- ns->strlength= i;
- return(ns);
-}
-
-String *_space(d)
-int d;
-{
- String *s;
- int i,len;
-
- len= d;
- s= (String *) salloc(sizeof(String));
- s->strlength= len;
- s->strcount=1;
- s->strval= (char *) salloc(len+1);
- for(i=0;i<len;i++)
- s->strval[i]= ' ';
- s->strval[i]=0;
- return(s);
-}
-
-String *_strascii()
-{
-}
-String *_string(d,f)
-double d,f;
-{
- int i,j;
- String *s;
-
- i=d;j=f;
- if( i<0 || i>MAXSTRING) error(3);
- s= (String *) salloc(sizeof(String));
- s->strlength= i;
- s->strcount=1;
- s->strval= (char *) salloc(i+1);
- s->strval[i]=0;
- for(; i>=0;i--)
- s->strval[i]= j;
- return(s);
-}
-_midstmt(s2,i1,i2,s)
-int i1,i2;
-String *s, *s2;
-{
- int l;
-
-/* printf("mid called %d %d %s %s\n",i1,i2,s->strval, s2->strval);*/
- if( i1== -1) i1= s2->strlength;
- if( s->strlength<i2) error(3); /* source string too short */
- l= s->strlength - i2+1;
- if( i1>l ) i1=l;
- strncpy(s->strval+i2-1,s2->strval,i1);
-}
-String *_mid(i1,i2,s)
-int i1,i2;
-String *s;
-{
- int l;
- String *s2;
-
-/* printf("mid fcn called %d %d %s\n",i1,i2,s->strval);*/
- if( i1 == -1) i1= s->strlength;
- s2= _newstr(s->strval);
- s2->strval[0]=0;
- if( s->strlength<i2) return(s2); /* source string too short */
- l= s->strlength - i2+1;
- if( i1>l ) i1=l;
- strncpy(s2->strval,s->strval+i2-1,i1);
- s2->strval[i1]=0;
- return(s2);
-}
-
-String *_right(length,str)
-String *str;
-int length;
-{
- String *s;
- int i;
-
- i= _len(str)-length;
- if(i<0) i=0;
- s= _newstr(str->strval+i);
- return(s);
-}
+++ /dev/null
-#include "string.h"
-
-/* $Header $ */
-
-_intswap(i1,i2)
-int *i1,*i2;
-{
- int i3;
- i3= *i1;
- *i1= *i2;
- *i2=i3;
-}
-
-_fltswap(i1,i2)
-double *i1,*i2;
-{
- double i3;
- i3= *i1;
- *i1= *i2;
- *i2=i3;
-}
-
-_strswap(s1,s2)
-String *s1,*s2;
-{
- String s;
- s= *s1;
- *s1= *s2;
- *s2 = s;
-}
+++ /dev/null
-/* $Header $ */
-
-_trace()
-{
-int i;
-printf("[%d]",i);
-}
+++ /dev/null
-#include <signal.h>
-#include <setjmp.h>
-
-/* $Header $ */
-
-/* Trap handling */
-int _trpline; /* BASIC return label */
-jmp_buf trpbuf;
-
-_trpset(nr)
-int nr;
-{
- /*debug printf("trap set to %d\n",nr);*/
- _trpline=nr;
-}
-_trpfatal(i)
-int i;
-{
- extern int _errsym,_erlsym;
-
- _errsym= i;
- _setline();
- if( _trpline == 0)
- printf("LINE %d: FATAL ERROR: trap %d\n",_erlsym,i);
-#ifdef DEBUG
- printf("trap occurred %d return %d\n",i,_trpline);
-#endif
- _trap();
-}
-
-_ini_trp()
-{
- /* initialize trap routines */
- int i, _trpfatal();
-
- for(i=0;i<NSIG;i++)
- signal(i,_trpfatal);
-}
-
-
-_settrap(nr)
-int nr;
-{
- _trpline=nr;
-}
-_trap()
-{
- int line;
-
- if( _trpline==0) exit(-1);
- line=_trpline;
- _trpline=0; /* should be reset by user */
- _ini_trp();
- longjmp(trpbuf,line);
-}
+++ /dev/null
-#include "string.h"
-#include "io.h"
-
-/* $Header $ */
-
-/* assume that the channel has been set */
-
-_wrnl()
-{
- if( fputc('\n',_chanwr) == EOF) error(29);
-}
-_wrcomma()
-{
- if( fputc(',',_chanwr) == EOF) error(29);
-}
-_wrint(i)
-int i;
-{
- if(i>0)
- if( fputc(' ',_chanwr)==EOF) error(29);
- fprintf(_chanwr,"%d",i);
-}
-_wrflt(f)
-double f;
-{
- if( fprintf(_chanwr,"%f",f)== EOF) error(29);
-}
-_wrstr(s)
-String *s;
-{
- if( fprintf(_chanwr,"\"%s\"",s->strval)== EOF) error(29);
-}
+++ /dev/null
-# $Header$
-
-d=../../..
-h=$d/h
-l=$d/lib
-INSTALL=$l/em_bem
-
-CFLAGS = -c -I$h
-
-FILES= bem.o y.tab.o symbols.o initialize.o compile.o \
- parsepar.o yywrap.o gencode.o util.o graph.o \
- eval.o func.o split.o
-
-SRC= bem.h symbols.h graph.h y.tab.h \
- bem.c basic.yacc symbols.c initialize.c compile.c \
- parsepar.c yywrap.c gencode.c util.c graph.c \
- eval.c func.c split.c
-
-first : bem
-
-cmp : bem
- cmp bem $(INSTALL)
-
-install: bem
- cp bem $(INSTALL)
-
-clean:
- rm -f *.[osmk] *.old bem
-
-opr:
- make pr ^ opr
-pr:
- @pr $(SRC)
-
-bem: $(FILES)
- cc -o bem $(FILES)
-
-y.tab.o : y.tab.c lex.c
- cc $(CFLAGS) y.tab.c
-
-y.tab.h y.tab.c : basic.yacc
- yacc -d basic.yacc
-
-$(FILES) : bem.h symbols.h graph.h y.tab.h
+++ /dev/null
-#ifndef NORSCID
-static char rcs_lex[] = "$Header$" ;
-#endif
-
-/* This file contains the new lexical analizer */
-typedef struct {
- char *name;
- int token, classvalue,length;
-} Key;
-
-Key keywords [] ={
-"abs", FUNCTION, ABSSYM, 0,
-"and", BOOLOP, ANDSYM, 0,
-"asc", FUNCTION, ASCSYM, 0,
-"as", ASSYM, 0, 0,
-"atn", FUNCTION, ATNSYM, 0,
-"auto", ILLEGAL, 0, 0,
-"base", BASESYM, 0, 0,
-"call", CALLSYM, 0, 0,
-"cdbl", FUNCTION, CDBLSYM, 0,
-"chain", ILLEGAL, 0, 0,
-"chr", FUNCTION, CHRSYM, 0,
-"cint", FUNCTION, CINTSYM, 0,
-"clear", CLEARSYM, 0, 0,
-"cload", ILLEGAL, 0, 0,
-"close", ILLEGAL, 0, 0,
-"common", ILLEGAL, 0, 0,
-"cont", ILLEGAL, 0, 0,
-"cos", FUNCTION, COSSYM, 0,
-"csng", FUNCTION, CSNGSYM, 0,
-"csave", ILLEGAL, 0, 0,
-"cvi", FUNCTION, CVISYM, 0,
-"cvs", FUNCTION, CVSSYM, 0,
-"cvd", FUNCTION, CVDSYM, 0,
-"data", DATASYM, 0, 0,
-"defint", DEFINTSYM, 0, 0,
-"defsng", DEFSNGSYM, 0, 0,
-"defdbl", DEFDBLSYM, 0, 0,
-"defstr", DEFSTRSYM, 0, 0,
-"def", DEFSYM, 0, 0,
-"delete", ILLEGAL, 0, 0,
-"dim", DIMSYM, 0, 0,
-"edit", ILLEGAL, 0, 0,
-"else", ELSESYM, 0, 0,
-"end", ENDSYM, 0, 0,
-"eof", FUNCTION, EOFSYM, 0,
-"erase", ILLEGAL, 0, 0,
-"error", ERRORSYM, 0, 0,
-"err", ERRSYM, 0, 0,
-"erl", ERLSYM, 0, 0,
-"else", ELSESYM, 0, 0,
-"eqv", BOOLOP, EQVSYM, 0,
-"exp", FUNCTION, EXPSYM, 0,
-"field", FIELDSYM, 0, 0,
-"fix", FUNCTION, FIXSYM, 0,
-"for", FORSYM, 0, 0,
-"fre", FUNCTION, FRESYM, 0,
-"get", GETSYM, 0, 0,
-"gosub", GOSUBSYM, 0, 0,
-"goto", GOTOSYM, 0, 0,
-"hex", FUNCTION, HEXSYM, 0,
-"if", IFSYM, 0, 0,
-"imp", BOOLOP, IMPSYM, 0,
-"inkey", INKEYSYM, 0, 0,
-"input", INPUTSYM, 0, 0,
-"inp", FUNCTION, INPSYM, 0,
-"instr", FUNCTION, INSTRSYM, 0,
-"int", FUNCTION, INTSYM, 0,
-"kill", ILLEGAL, 0, 0,
-"left", FUNCTION, LEFTSYM, 0,
-"len", FUNCTION, LENSYM, 0,
-"let", LETSYM, 0, 0,
-"line", LINESYM, 0, 0,
-"list", LISTSYM, 0, 0,
-"llist", ILLEGAL, 0, 0,
-"load", LOADSYM, 0, 0,
-"loc", FUNCTION, LOCSYM, 0,
-"log", FUNCTION, LOGSYM, 0,
-"lpos", FUNCTION, LPOSSYM, 0,
-"lprint", ILLEGAL, 0, 0,
-"lset", LSETSYM, 0, 0,
-"merge", MERGESYM, 0, 0,
-"mid", MIDSYM, 0, 0,
-"mki", FUNCTION, MKISYM, 0,
-"mks", FUNCTION, MKSSYM, 0,
-"mkd", FUNCTION, MKDSYM, 0,
-"mod", MODSYM, 0, 0,
-"name", ILLEGAL, 0, 0,
-"new", ILLEGAL, 0, 0,
-"next", NEXTSYM, 0, 0,
-"not", NOTSYM, 0, 0,
-"null", ILLEGAL, 0, 0,
-"on", ONSYM, 0, 0,
-"oct", FUNCTION, OCTSYM, 0,
-"open", OPENSYM, 0, 0,
-"option", OPTIONSYM, 0, 0,
-"or", BOOLOP, ORSYM, 0,
-"out", FUNCTION, OUTSYM, 0,
-"peek", PEEKSYM, 0, 0,
-"poke", POKESYM, 0, 0,
-"print", PRINTSYM, 0, 0,
-"pos", FUNCTION, POSSYM, 0,
-"put", PUTSYM, 0, 0,
-"randomize", RANDOMIZESYM, 0, 0,
-"read", READSYM, 0, 0,
-"rem", REMSYM, 0, 0,
-"renum", ILLEGAL, 0, 0,
-"ren", ILLEGAL, 0, 0,
-"restore", RESTORESYM, 0, 0,
-"resume", ILLEGAL, 0, 0,
-"return", RETURNSYM, 0, 0,
-"right", FUNCTION, RIGHTSYM, 0,
-"rnd", FUNCTION, RNDSYM, 0,
-"run", ILLEGAL, 0, 0,
-"save", ILLEGAL, 0, 0,
-"step", STEPSYM, 0, 0,
-"sgn", FUNCTION, SGNSYM, 0,
-"sin", FUNCTION, SINSYM, 0,
-"space", FUNCTION, SPACESYM, 0,
-"spc", FUNCTION, SPCSYM, 0,
-"sqr", FUNCTION, SQRSYM, 0,
-"stop", STOPSYM, 0, 0,
-"string", FUNCTION, STRINGSYM, 0,
-"str", FUNCTION, STRSYM, 0,
-"swap", SWAPSYM, 0, 0,
-"tab", FUNCTION, TABSYM, 0,
-"tan", FUNCTION, TANSYM, 0,
-"then", THENSYM, 0, 0,
-"to", TOSYM, 0, 0,
-"tron", TRONOFFSYM, TRONSYM, 0,
-"troff", TRONOFFSYM, TROFFSYM, 0,
-"using", USINGSYM, 0, 0,
-"usr", FUNCTION, USRSYM, 0,
-"val", FUNCTION, VALSYM, 0,
-"varptr", FUNCTION, VARPTRSYM, 0,
-"wait", ILLEGAL, 0, 0,
-"while", WHILESYM, 0, 0,
-"wend", WENDSYM, 0, 0,
-"width", ILLEGAL, 0, 0,
-"write", WRITESYM, 0, 0,
-"xor", BOOLOP, XORSYM, 0,
-0, 0, 0, 0
-};
-
-/* Keyword index table */
-
-int kex[27];
-
-/* Initialize the keyword table */
-fillkex()
-{
- Key *k;
- int i;
- for(k=keywords;k->name;k++)
- k->length= strlen(k->name);
- k=keywords;
- for(i=0;k->name && i<='z'-'a';i++)
- {
- for(;k->name && *k->name<i+'a';k++);
- if( *k->name!=i+'a') continue;
- kex[*k->name-'a']=k-keywords;
- for(;k->name && *k->name==i+'a';k++);
- kex[*(k-1)->name-'a'+1]=k-keywords;
- }
- if(debug)
- {
- for(i=0;i<27;i++)
- printf("%c:%d\n",'a'+i,kex[i]);
- }
-}
-
-#include <ctype.h>
-
-/* Get each line separately into the buffer */
-/* Lines too long are terminated and flagged illegal */
-
-#define MAXLINELENGTH 1024
-
-char inputline[MAXLINELENGTH]; /* current source line */
-char *cptr; /* next character to decode */
-int yylineno=0; /* source line counter */
-
-getline()
-{
- /* get next input line */
-
- if( fgets(inputline,MAXLINELENGTH,yyin) == NULL)
- return(FALSE);
- yylineno ++;
- if( index(inputline,'\n') == 0)
- error("source line too long");
- inputline[MAXLINELENGTH-1]=0;
- if( listing)
- fputs(inputline,stdout);
- cptr= inputline;
- return(TRUE);
-}
-yyerror(str)
-char *str;
-{
- error("Syntax error");
-}
-
-typechar()
-{
- switch(*cptr)
- {
- case '$':
- cptr++; return( STRINGTYPE);
- case '%':
- cptr++; return( INTTYPE);
- case '!':
- cptr++; return( FLOATTYPE);
- case '#':
- cptr++; return( DOUBLETYPE);
- }
- return(0);
-}
-
-/* symbols in Microsoft are significant for the first 40 characters */
-#define SIGNIFICANT 40
-char name[SIGNIFICANT+1];
-
-lookup()
-{
- Key *k;
- Symbol *s;
- char *c;
- int i, typech;
-
- sval= name;
- for(c=cptr; *c && isalnum(*c);c++)
- if( isupper(*c) )
- *c= tolower((*c));
- for(k= keywords+kex[*cptr-'a']; *(k->name)== *cptr;k++)
- if( strncmp(cptr,k->name,k->length)==0)
- {
- /* check functions first*/
- if( isalnum( *(cptr+k->length) ) &&
- k->token==FUNCTION) continue;
- cptr += k->length;
- yylval= k->classvalue;
- if(debug) printf("lookup:%d %d\n",
- k->classvalue,k->token);
- if( k->token == FUNCTION)
- {
- /* stripp type character */
- typech=typechar();
- }
- /* illegals + rem */
- if( k->token == REMSYM || k->token==ILLEGAL)
- while( *cptr && *cptr!=':' && *cptr!='\n')
- cptr++;
- return( k->token);
- }
- /* Is it a function name ? */
- c=cptr;
- /* Identifier found, update the symbol table */
- i=0;
- while( isalnum(*c) || *c == '.')
- if( i<SIGNIFICANT) name[i++]= *c++;
- name[i]=0;
- cptr=c;
- s= (Symbol *) srchsymbol(name);
- yylval = (YYSTYPE) s;
- typech= typechar();
- if(s->symtype!=DEFAULTTYPE)
- {
- if(typech && typech!=s->symtype && wflag)
- warning("type re-declared,ignored");
- }
- if( typech)
- s->symtype=typech;
- if(debug) printf("lookup:%d Identifier\n",s);
- if( (name[0]=='f' || name[0]=='F') &&
- (name[1]=='n' || name[1]=='N') )
- return(FUNCTID);
- return(IDENTIFIER);
-}
-
-/* Parsing unsigned numbers */
-readconstant()
-{
- /* read HEX and OCTAL numbers */
- char *c;
- cptr++;
- if( *cptr == 'H' || *cptr=='h')
- {
- /* HEX */
- cptr++;
- c=cptr;
- while( isdigit(*cptr) ||
- (*cptr>='a' && *cptr<='f' ) ||
- (*cptr>='A' && *cptr<='F' ) )cptr++;
- sscanf(c,"%x",&ival);
- } else
- if( *cptr == 'O' || *cptr == 'o')
- {
- /* OCTAL */
- cptr++;
- c=cptr;
- while( isdigit(*cptr) ) cptr++;
- sscanf(c,"%o",&ival);
- } else
- error("H or O expected");
- return(INTVALUE);
-}
-
-number()
-{
- long i1;
- double f,dec;
- int minflag;
- register char *c;
-
- i1=0;
- c=cptr;
- while(isdigit(*c)){
- i1= i1*10 + *c-'0';
- c++;
- }
- cptr=c;
- if( *c != '.'){
- if( i1> MAXINT || i1<MININT) {
- dval= i1;
- return(FLTVALUE);
- }
- ival= i1;
-#ifdef YYDEBUG
- if(yydebug) printf("number:INTVALUE %d",i1);
-#endif
- return(INTVALUE);
- }
- /* handle floats */
- f= i1; dec=0.1;
- c++;
- while( isdigit(*c)){
- f= f + dec * (*c - '0');
- dec /= 10.0;
- c++;
- }
- /* handle exponential part */
- if( *c =='e' || *c == 'E'){
- c++;
- minflag= (*c== '-')? -1: 1;
- if( *c=='-' || *c=='+') c++;
- while(isdigit(*c)){
- f *= 10.0;
- c++;
- }
- if(minflag== -1) f= 1.0/f;
- }
- dval= f;
- cptr=c;
-#ifdef YYDEBUG
- if(yydebug) printf("number:FLTVALUE %f",f);
-#endif
- return(FLTVALUE);
-}
-scanstring()
-{
- int i,length;
- char firstchar;
- /* skip this string value, you might as well copy it to
- the EM file as well, because it is not used internally
- */
- /* generate label here */
- yylval= genrom();
- length=0;
- if( fputc('"',emfile) == EOF) fatal("scanstring");
- sval= cptr;
- firstchar = *cptr;
- if( *cptr== '"') cptr++;
- while( *cptr !='"')
- {
- switch(*cptr)
- {
- case 0:
- case '\n':
-#ifdef YYDEBUG
- if(yydebug) printf("STRVALUE\n");
-#endif
- if( firstchar == '"')
- error("non-terminated string");
- return(STRVALUE);
- default:
- fputc(*cptr,emfile);
- }
- cptr++;
- length++;
- }
- *cptr=0;
- cptr++;
- fprintf(emfile,"\\000\"\n");
- i=yylval;
- yylval= genrom();
- fprintf(emfile,"l%d,1,%d\n",i,length);
-#ifdef YYDEBUG
- if(yydebug) printf("STRVALUE found\n");
-#endif
- return(STRVALUE);
-}
-yylex()
-{
- char *c;
-
- /* Here is the big switch */
- c= cptr;
- switch(*c){
- case 'a': case 'b': case 'c': case 'd': case 'e':
- case 'f': case 'g': case 'h': case 'i': case 'j':
- case 'k': case 'l': case 'm': case 'n': case 'o':
- case 'p': case 'q': case 'r': case 's': case 't':
- case 'u': case 'v': case 'w': case 'x': case 'y':
- case 'z': case 'A': case 'B': case 'C': case 'D':
- case 'E': case 'F': case 'G': case 'H': case 'I':
- case 'J': case 'K': case 'L': case 'M': case 'N':
- case 'O': case 'P': case 'Q': case 'R': case 'S':
- case 'T': case 'U': case 'V': case 'W': case 'X':
- case 'Y': case 'Z': case '_':
- return(lookup());
-
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9':
- case '.':
- return(number());
- case '\'':
- /* comment at end of line */
- while( *cptr != '\n' && *cptr) cptr++;
- case '\n':
- cptr++;
- return(EOLN);
- case 0:
-#ifdef YYDEBUG
- if( yydebug) printf("end of buffer");
-#endif
- return(0);
- case '"':
- return(scanstring());
- /* handle double operators */
- case ' ':
- case '\t':
- cptr++;
- return(yylex());
- case '&':
- return(readconstant());
- case '?': return(PRINTSYM);
- case '>':
- if( *(c+1)=='='){
- c++;c++;cptr=c; yylval= GESYM;return(RELOP);
- }
- yylval= '>';
- cptr++;
- return(RELOP);
- break;
- case '<':
- if( *(c+1)=='='){
- c++; c++; cptr=c; yylval=LESYM; return(RELOP);
- } else
- if( *(c+1)=='>'){
- c++; c++; cptr=c; yylval=NESYM; return(RELOP);
- }
- yylval= '<';
- cptr++;
- return(RELOP);
- }
- return(*cptr++);
-}
+++ /dev/null
-%token ILLEGAL
-%token ASSYM
-%token BASESYM
-%token CALLSYM
-%token CLEARSYM
-%token CLOSESYM
-%token DATASYM
-%token DEFINTSYM
-%token DEFSNGSYM
-%token DEFDBLSYM
-%token DEFSTRSYM
-%token DEFSYM
-%token DIMSYM
-%token ELSESYM
-%token ERRSYM
-%token ERLSYM
-%token ERRORSYM
-%token ELSESYM
-%token FIELDSYM
-%token FORSYM
-%token FUNCTION
-%token FUNCTID
-%token INKEYSYM
-%token GETSYM
-%token GOSUBSYM
-%token GOTOSYM
-%token IFSYM
-%token INPUTSYM
-%token LETSYM
-%token LINESYM
-%token LSETSYM
-%token MIDSYM
-%token NEXTSYM
-%token ONSYM
-%token OPENSYM
-%token OPTIONSYM
-%token PRINTSYM
-%token POKESYM
-%token PUTSYM
-%token RANDOMIZESYM
-%token READSYM
-%token REMSYM
-%token RESTORESYM
-%token RETURNSYM
-%token ENDSYM
-%token STOPSYM
-%token STEPSYM
-%token SWAPSYM
-%token THENSYM
-%token TOSYM
-%token TRONOFFSYM
-%token USINGSYM
-%token USRSYM
-%token WHILESYM
-%token WENDSYM
-%token WRITESYM
-/* special tokens */
-%token EOLN
-%token INTVALUE
-%token FLTVALUE
-%token DBLVALUE
-%token STRVALUE
-%token UNARYSYM
-%token IDENTIFIER
-%token ANDSYM
-%token ORSYM
-%token VARPTR
-
-%left BOOLOP
-%left NOTSYM
-%left RELOP '=' '<' '>' LESYM GESYM NESYM
-%left '+' '-'
-%left '*' '/' '\\' MODSYM
-%left '^'
-%left UNARYMINUS
-
-%{
-#define YYDEBUG
-#include "bem.h"
-
-int ival; /* parser temporary values */
-double dval;
-char *sval;
-int e1,e2;
-int chann; /* input/output channel */
-
-char *formatstring; /* formatstring used for printing */
-Symbol *s; /* Symbol dummy */
-%}
-%%
-programline : INTVALUE {newblock(ival); newemblock(ival);} stmts EOLN
- | '#' INTVALUE STRVALUE EOLN
- | EOLN
- ;
-
-
-stmts : singlestmt
- | stmts ':' singlestmt
- ;
-
-singlestmt : callstmt
- | clearstmt
- | closestmt
- | datastmt
- | deffnstmt
- | defvarstmt
- | defusrstmt
- | dimstmt
- | ERRORSYM expression {errorstmt($2);}
- | fieldstmt
- | forstmt
- | getstmt
- | gosubstmt
- | ongotostmt
- | ifstmt
- | illegalstmt
- | inputstmt
- | letstmt
- | lineinputstmt
- | lsetstmt
- | midstmt
- | exceptionstmt
- | nextstmt
- | GOTOSYM INTVALUE {gotostmt(ival);}
- | openstmt
- | optionstmt
- | pokestmt
- | printstmt
- | randomizestmt
- | readstmt
- | REMSYM
- | restorestmt
- | returnstmt
- | ENDSYM { emcode("loc","0");
- emcode("cal","$_hlt");
- emcode("asp",EMINTSIZE);}
- | STOPSYM { emcode("cal","$_stop");}
- | swapstmt
- | TRONOFFSYM { tronoff=$1;}
- | whilestmt
- | wendstmt
- | writestmt
- | /* EMPTY STATEMENT */
- ;
-
-illegalstmt: ILLEGAL {illegalcmd();}
-
-callstmt: CALLSYM IDENTIFIER parmlist ')'
- {
- emcode("cal",proclabel(((Symbol *) $2)->symname));
- while($3 -- >0) emcode("asp",EMPTRSIZE);
- }
- | CALLSYM IDENTIFIER
- { emcode("cal",proclabel(((Symbol *) $2)->symname));}
-
-parmlist: '(' variable { $$=1;}
- | parmlist ',' variable { $$= $1+1;}
-
-clearstmt: CLEARSYM {warning("statement ignored");}
- | CLEARSYM ',' expression {warning("statement ignored");}
- | CLEARSYM ',' expression ',' expression {warning("statement ignored");}
-closestmt: CLOSESYM filelist
- | CLOSESYM {emcode("cal","$_close");}
-
-filelist: cross intvalue { emcode("loc",$2);
- emcode("cal","$_clochn");
- emcode("asp",EMINTSIZE);}
- | filelist ',' cross intvalue { emcode("loc",$4);
- emcode("cal","$_clochn");
- emcode("asp",EMINTSIZE);}
-
-datastmt: DATASYM {datastmt();} datalist {fprintf(datfile,"\n");}
-
-dataelm : INTVALUE {fprintf(datfile,"%d",ival);}
- | '-' INTVALUE {fprintf(datfile,"%d",-ival);}
- | FLTVALUE {fprintf(datfile,"%f",dval);}
- | '-' FLTVALUE {fprintf(datfile,"%f",-dval);}
- | STRVALUE {fprintf(datfile,"\"%s\"",sval);}
- | IDENTIFIER {fprintf(datfile,"\"%s\"",sval);}
- ;
-
-datalist: dataelm
- | datalist ',' {fputc(',',datfile);} dataelm
- ;
-
-deffnstmt: DEFSYM heading '=' expression {endscope($4);}
-
-heading : FUNCTID { newscope($1); heading();}
- | FUNCTID {newscope($1);} '(' idlist ')' { heading();}
-
-idlist : IDENTIFIER { dclparm($1);}
- | idlist ',' IDENTIFIER { dclparm($3);}
- ;
-
-defvarstmt: DEFINTSYM { setdefaulttype( INTTYPE);}
- | DEFSNGSYM { setdefaulttype( FLOATTYPE);}
- | DEFDBLSYM { setdefaulttype( DOUBLETYPE);}
- | DEFSTRSYM { setdefaulttype( STRINGTYPE);}
-
-defusrstmt: DEFSYM USRSYM error ':' {illegalcmd();}
-
-dimstmt: DIMSYM arraydcl ')' {dclarray($2);}
- | dimstmt ',' arraydcl ')' {dclarray($3);}
- ;
-
-arraydcl : IDENTIFIER '(' INTVALUE {$$=$1; s= (Symbol *) $1;
- s->dimlimit[s->dimensions]=ival;
- s->dimensions++;
- }
- | arraydcl ',' INTVALUE {$$=$1; s=(Symbol *) $1;
- if(s->dimensions<MAXDIMENSIONS)
- {
- s->dimlimit[s->dimensions]=ival;
- s->dimensions++;
- } else
- error("too many dimensions");
- }
-
-
-
-fieldstmt: FIELDSYM cross intvalue {setchannel(ival);} ',' fieldlist {notyetimpl();}
-
-fieldlist: intvalue ASSYM variable
- | fieldlist ',' intvalue ASSYM variable
- ;
-
-forstmt: FORSYM IDENTIFIER {forinit($2);} '=' expression {forexpr($5);}
- TOSYM expression {forlimit($8);} step
- ;
-
-step : STEPSYM expression {forstep($2);}
- | /*EMPTY*/ {emcode("loc","1"); forstep(INTTYPE);}
- ;
-
-nextstmt: NEXTSYM IDENTIFIER {nextstmt($2);}
- | NEXTSYM { nextstmt(0);}
- | nextstmt ',' IDENTIFIER { nextstmt($3);}
-
-getstmt: getput {emcode("loc",itoa(0));
- emcode("cal",$1);
- emcode("asp",EMINTSIZE);}
- | getput ',' intvalue
- { /* position seek pointer first*/
- emcode("loc",itoa(ival));
- emcode("cal",$1);
- emcode("asp",EMINTSIZE);
- }
-getput: GETSYM cross intvalue { setchannel(ival); $$= (YYSTYPE)"$_getrec";}
- | PUTSYM cross intvalue { setchannel(ival); $$= (YYSTYPE)"$_putsym";}
-
-gosubstmt: GOSUBSYM INTVALUE {gosubstmt(ival);}
-
-returnstmt: RETURNSYM {returnstmt();}
-
-ifstmt: IFSYM expression {$1=ifstmt($2);} thenpart
- {$1=thenpart($1);} elsepart {elsepart($1);}
- ;
-
-thenpart: THENSYM INTVALUE {gotostmt(ival);}
- | THENSYM stmts
- | GOTOSYM INTVALUE {gotostmt(ival);}
- ;
-elsepart: ELSESYM INTVALUE {gotostmt(ival);}
- | ELSESYM stmts
- | /* empty */
- ;
-
-inputstmt: INPUTSYM semiprompt readlist
- | INPUTSYM '#' intvalue {setchannel(ival);}',' readlist
- ;
-
-semiprompt : semi STRVALUE ';' { loadstr($2); prompt(1);}
- | semi STRVALUE ',' { loadstr($2); prompt(0);}
- | /*EMPTY*/ { setchannel(-1);
- emcode("cal","$_qstmark");}
-
-semi : ';' | /* empty */ ;
-
-letstmt: LETSYM {e1=where();} variable {e2=where();}
- '=' expression {assign($3,$6);}
- | {e1=where();} variable {e2=where();}
- '=' expression {assign($2,$5);}
-
-lineinputstmt: LINESYM INPUTSYM semiprompt {setchannel(-1);} variable {linestmt($5);}
- | LINESYM '#' intvalue {setchannel(ival);} ',' variable {linestmt($6);}
- ;
-
-readlist: readelm
- | readlist ',' readelm
- ;
-readelm: variable {readelm($1);}
-
-lsetstmt: LSETSYM variable '=' expression {notyetimpl();}
-
-midstmt: MIDSYM '$' midparms '=' expression
- { emcode("cal","$_midstmt");
- emcode("asp",EMINTSIZE);
- emcode("asp",EMINTSIZE);
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMPTRSIZE);}
-
-midparms: '(' midfirst midsec midthird ')'
-
-midfirst: expression { conversion($1,STRINGTYPE); }
-midsec: ',' expression { conversion($2,INTTYPE); }
-midthird: ',' expression { conversion($2,INTTYPE); }
- | /* empty */ { emcode("loc","-1");}
-
-exceptionstmt: ONSYM ERRORSYM GOTOSYM INTVALUE {exceptstmt(ival);}
-
-ongotostmt: ONSYM expression
- GOSUBSYM constantlist {ongosubstmt($2);}
- | ONSYM expression
- GOTOSYM constantlist {ongotostmt($2);}
-
-constantlist: INTVALUE {jumpelm(ival);}
- | constantlist ',' INTVALUE { jumpelm(ival);}
-
-openstmt: OPENSYM mode openchannel expression
- { conversion($4,STRINGTYPE); openstmt(0);}
- | OPENSYM mode openchannel
- expression {conversion($4,STRINGTYPE);}
- INTVALUE { openstmt(ival);}
-
-openchannel: cross INTVALUE ',' { setchannel(ival);}
-
-mode : expression ',' {conversion($1,STRINGTYPE);}
- | ',' { emcode("lae","_iomode");}
- ;
-
-optionstmt: OPTIONSYM BASESYM intvalue { optionbase($3);}
-
-printstmt: PRINTSYM {setchannel(-1);emcode("cal","$_nl");}
- | PRINTSYM file format printlist
- { if( $4) emcode("cal","$_nl");}
-file : '#' intvalue ',' {setchannel(ival);}
- | /* empty */ {setchannel(-1);}
- ;
-format : USINGSYM STRVALUE ';' { loadstr($2);}
- | USINGSYM variable ';' {
- if($2!=STRINGTYPE) error("string variable expected");}
- | /* empty */ {formatstring=0;}
-
-printlist: expression { printstmt($1); $$=1;}
- | ',' { zone(0); $$=0;}
- | ';' { zone(1); $$=0;}
- | printlist expression { printstmt($2); $$=1;}
- | printlist ',' { zone(1);$$=0;}
- | printlist ';' { zone(0);$$=0;}
- ;
-pokestmt: POKESYM expression ',' expression {pokestmt($2,$4);}
- ;
-randomizestmt: RANDOMIZESYM
- { emcode("cal","$_randomize");}
- | RANDOMIZESYM expression
- { conversion($2,INTTYPE);
- emcode("cal","$_setrandom");
- emcode("asp",EMINTSIZE);}
-
-readstmt: READSYM {setchannel(0);} variable { readelm($3);}
- | readstmt ',' variable { readelm($3);}
-
-restorestmt: RESTORESYM INTVALUE { restore(ival);}
- | RESTORESYM { restore(0);}
-
-swapstmt: SWAPSYM variable ',' variable { swapstmt($2,$4);}
-
-whilestmt: WHILESYM {whilestart();} expression {whiletst($3);}
- ;
-
-wendstmt : WENDSYM {wend();}
-
-writestmt: WRITESYM {setchannel(-1);emcode("cal","$_wrnl");}
- | WRITESYM file writelist {emcode("cal","$_wrnl");}
- ;
-
-writelist: expression {writestmt($1,0);}
- | writelist ',' expression {writestmt($3,1);}
- ;
-
-cross: '#' | /* empty */
-
-intvalue: INTVALUE
- ;
-
-variable: identifier { $$=loadaddr($1);}
- | indexed ')' {$$=endarrayload();}
- | ERRSYM {emcode("lae","_errsym"); $$= INTTYPE;}
- | ERLSYM {emcode("lae","_erlsym"); $$= INTTYPE;}
- ;
-indexed : identifier '(' {newarrayload($1);}
- expression {loadarray($4); $$=$1;}
- | indexed ',' expression {loadarray($3); $$=$1;}
- ;
-
-
-expression: negation
- | negation BOOLOP expression {$$=boolop($1,$3,$2);}
-
-negation: NOTSYM compare {$$=boolop($2,0,NOTSYM);}
- | compare
- ;
-compare : sum
- | sum RELOP sum {$$=relop($1,$3,$2);}
- | sum '=' sum {$$=relop($1,$3,'=');}
-
-sum : term
- | term '-' sum {$$=plusmin($1,$3,'-');}
- | term '+' sum {$$=plusmin($1,$3,'+');}
-term : factor
- | factor '^' factor {$$=power($1,$3);}
- | factor '*' term {$$=muldiv($1,$3,'*');}
- | factor '\\' term {$$=muldiv($1,$3,'\\');}
- | factor '/' term {$$=muldiv($1,$3,'/');}
- | factor MODSYM term {$$=muldiv($1,$3,MODSYM);}
-factor : INTVALUE {$$=loadint(ival);}
- | '(' expression ')' {$$=$2;}
- | '-' factor { $$=negate($2);}
- | FLTVALUE {$$=loaddbl(dval);}
- | STRVALUE {$$=loadstr($1);}
- | variable {$$=loadvar($1);}
- | INKEYSYM '$' { emcode("cal","$_inkey");
- emcode("lfr",EMPTRSIZE);
- $$= STRINGTYPE;
- }
- | VARPTR '(' '#' intvalue ')' { warning("Not supported"); $$=INTTYPE;}
- | FUNCTION {$$= callfcn($1,0);}
- | FUNCTION '(' cross exprlist')' {$$=callfcn($1,$4);}
- | funcname { $$=fcnend($1);}
- | funcname funccall ')' { $$=fcnend($1,$2);}
- | MIDSYM '$' midparms
- { emcode("cal","$_mid");
- emcode("asp",itoa($3));
- emcode("lfr",EMPTRSIZE);
- $$= STRINGTYPE;
- }
- | INPUTSYM '$' '(' expression inputtail
- {
- emcode("cal","$_inpfcn");
- emcode("asp",EMINTSIZE);
- emcode("asp",EMINTSIZE);
- emcode("asp",EMPTRSIZE);
- $$= STRINGTYPE;
- }
-inputtail: ',' expression ')' { conversion($2,INTTYPE); $$= INTTYPE;}
- | ',' '#' expression ')' { conversion($3,INTTYPE); $$= INTTYPE;}
- | ')' { emcode("loc","-1"); $$= INTTYPE;}
-
-funcname: FUNCTID {$$=fcncall($1);}
-
-funccall: '(' expression { callparm(0,$2); $$=1;}
- | funccall ',' expression { callparm($1,$3); $$=$1+1;}
-
-identifier: IDENTIFIER { dcltype($1); $$=$1;}
-
-exprlist: expression { typetable[0]= $1; $$=1;}
- | exprlist ',' expression { typetable[$1]=$3;$$=$1+1;}
-
-%%
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-#include "lex.c"
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-static char rcs_bem[] = RCS_BEM ;
-static char rcs_symb[] = RCS_SYMB ;
-static char rcs_graph[] = RCS_GRAPH ;
-#endif
-
-/* Author: M.L. Kersten
-**
-** This is the main routine for the BASIC-EM frontend.
-** Program parameters are decoded, the BASIC program is parsed
-** and compiled to an executable program
-**
-** Bem expects at least three parameters. One ending with '.i' is considered
-** the input to the compiler, '.e' denotes the file to be generated,
-** and the last name denotes the name of the user supplied file name.
-** The latter is used to store the data entries.
-** Additional flags may be supplied, see parseparms.
-*/
-
-char *program;
-
-char datfname[MAXFILENAME] ;
-char tmpfname[MAXFILENAME] ;
-
-char *inpfile, *outfile;
-main(argc,argv)
-int argc;
-char **argv;
-{
- extern int errorcnt;
-
- /* parseparams */
- parseparams(argc,argv);
- /* initialize the system */
- initialize();
- /* compile source programs */
- compileprogram(program);
- linewarnings();
- if( errorcnt) exit(-1);
- /* process em object files */
- simpleprogram();
-}
+++ /dev/null
-#include <stdio.h>
-#include <ctype.h>
-#include <signal.h>
-
-/* Author: M.L. Kersten
-** Here all the global objects are defined.
-*/
-#include "symbols.h"
-#include "graph.h"
-#include "y.tab.h"
-
-#ifndef NORCSID
-# define RCS_BEM "$Header$"
-#endif
-
-#define POINTERSIZE 4
-#define MAXINT 32768
-#define MININT -32767
-#define EMINTSIZE "EM_WSIZE"
-#define EMPTRSIZE "EM_PSIZE"
-#define EMFLTSIZE "EM_DSIZE"
-
-#define MAXPIECES 100
-#define MAXFILENAME 200
-
-#define CHANNEL 0
-#define THRESHOLD 40 /* for splitting blocks */
-
-extern char *program; /* name of source program */
-extern char *inpfile; /* input tko compiler */
-extern char *outfile; /* output from compiler */
-
-extern char datfname[MAXFILENAME]; /* data statements file */
-extern char tmpfname[MAXFILENAME]; /* temporary statements file */
-
-extern FILE *emfile; /* EM output file */
-extern FILE *datfile; /* data file */
-extern FILE *tmpfile; /* compiler temporary */
-extern FILE *yyin; /* Compiler input */
-
-extern int endofinput;
-extern int wflag;
-extern int hflag;
-extern int traceflag;
-extern int yydebug;
-extern int yylineno;
-extern int listing;
-extern int nolins;
-extern int threshold;
-extern int debug;
-extern int tronoff;
-
-extern int emlinecount; /* counts lines on tmpfile */
-extern int dataused;
-extern int typetable[10]; /* parameters to standard functions */
-
-extern Linerecord *currline;
-
-
-extern char *itoa();
-extern char *datalabel();
-extern char *instrlabel();
-extern char *typesize();
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-
-/* compile the next program in the list */
-
-FILE *yyin;
-
-compileprogram()
-{
-
- while( getline())
- yyparse();
- fclose(yyin);
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-
-/* Here you find all routines to evaluate expressions and
- generate code for assignment statements
-*/
-
-exprtype(ltype,rtype)
-int ltype,rtype;
-{
- /* determine the result type of an expression */
- if( ltype== STRINGTYPE || rtype==STRINGTYPE)
- {
- if( ltype!=rtype)
- error("type conflict, string expected");
- return( STRINGTYPE);
- }
- /* take maximum */
- if( ltype<rtype) return(rtype);
- return(ltype);
-}
-
-conversion(oldtype,newtype)
-int oldtype,newtype;
-{
- /* the value on top of the stack should be converted */
- if( oldtype==newtype) return;
- switch( oldtype)
- {
- case INTTYPE:
- if( newtype==FLOATTYPE || newtype==DOUBLETYPE)
- {
- emcode("loc",EMINTSIZE);
- emcode("loc",EMFLTSIZE);
- emcode("cif","");
- }else{
- if(debug)
- printf("type n=%d o=%d\n",newtype,oldtype);
- error("conversion error");
- }
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- if( newtype==INTTYPE)
- {
- /* rounded ! */
- emcode("cal","$_cint");
- emcode("asp",EMFLTSIZE);
- emcode("lfr",EMINTSIZE);
- break;
- }else
- if( newtype== FLOATTYPE || newtype==DOUBLETYPE)
- break;
- default:
- if(debug)
- printf("type n=%d o=%d\n",newtype,oldtype);
- error("conversion error");
- }
-}
-extraconvert(oldtype,newtype,topstack)
-int oldtype,newtype,topstack;
-{
- /* the value below the top of the stack should be converted */
- if( oldtype==newtype ) return;
- if( debug) printf("extra convert %d %d %d\n",oldtype,newtype,topstack);
- /* save top in dummy */
- switch( topstack)
- {
- case INTTYPE:
- emcode("ste","dummy1");
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- /* rounded ! */
- emcode("lae","dummy1");
- emcode("sti",EMFLTSIZE);
- break;
- default:
- error("conversion error");
- return;
- }
- /* now its on top of the stack */
- conversion(oldtype,newtype);
- /* restore top */
- switch( topstack)
- {
- case INTTYPE:
- emcode("loe","dummy1");
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- /* rounded ! */
- emcode("lae","dummy1");
- emcode("loi",EMFLTSIZE);
- }
-}
-
-boolop(ltype,rtype,operator)
-int ltype,rtype,operator;
-{
- if( operator != NOTSYM)
- {
- extraconvert(ltype,INTTYPE,rtype);
- conversion(rtype,INTTYPE);
- } else conversion(ltype,INTTYPE);
- switch( operator)
- {
- case NOTSYM: emcode("com",EMINTSIZE); break;
- case ANDSYM: emcode("and",EMINTSIZE); break;
- case ORSYM: emcode("ior",EMINTSIZE); break;
- case XORSYM: emcode("xor",EMINTSIZE); break;
- case EQVSYM:
- emcode("xor",EMINTSIZE);
- emcode("com",EMINTSIZE);
- break;
- case IMPSYM:
- /* implies */
- emcode("com",EMINTSIZE);
- emcode("and",EMINTSIZE);
- emcode("com",EMINTSIZE);
- break;
- default: error("boolop:unexpected");
- }
- return(INTTYPE);
-}
-genbool(opcode)
-char *opcode;
-{
- int l1,l2;
- l1= genlabel();
- l2= genlabel();
- emcode(opcode,instrlabel(l1));
- emcode("loc",itoa(0));
- emcode("bra",instrlabel(l2));
- fprintf(tmpfile,"%d\n",l1); emlinecount++;
- emcode("loc",itoa(-1));
- fprintf(tmpfile,"%d\n",l2); emlinecount++;
-}
-relop( ltype,rtype,operator)
-int ltype,rtype,operator;
-{
- int result;
- if(debug) printf("relop %d %d op=%d\n",ltype,rtype,operator);
- result= exprtype(ltype,rtype);
- extraconvert(ltype,result,rtype);
- conversion(rtype,result);
- /* compare the objects */
- if( result== INTTYPE)
- emcode("cmi", EMINTSIZE);
- else
- if( result==FLOATTYPE || result==DOUBLETYPE)
- emcode("cmf",EMFLTSIZE);
- else
- if( result==STRINGTYPE)
- {
- emcode("cal","$_strcompare");
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMPTRSIZE);
- emcode("lfr",EMINTSIZE);
- } else error("relop:unexpected");
- /* handle the relational operators */
- switch(operator)
- {
- case '<': genbool("zlt"); break;
- case '>': genbool("zgt"); break;
- case '=': genbool("zeq"); break;
- case NESYM: genbool("zne"); break;
- case LESYM: genbool("zle"); break;
- case GESYM: genbool("zge"); break;
- default: error("relop:unexpected operator");
- }
- return(INTTYPE);
-}
-plusmin(ltype,rtype,operator)
-int ltype,rtype,operator;
-{
- int result;
- result= exprtype(ltype,rtype);
-
- if( result== STRINGTYPE)
- {
- if( operator== '+')
- {
- emcode("cal","$_concat");
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMPTRSIZE);
- emcode("lfr",EMPTRSIZE);
- } else error("illegal operator");
- } else {
- extraconvert(ltype,result,rtype);
- conversion(rtype,result);
- if( result== INTTYPE)
- {
- if( operator=='+')
- emcode("adi",EMINTSIZE);
- else emcode("sbi",EMINTSIZE);
- } else{
- if( operator=='+')
- emcode("adf",EMFLTSIZE);
- else emcode("sbf",EMFLTSIZE);
- }
- }
- return(result);
-}
-muldiv(ltype,rtype,operator)
-int ltype,rtype,operator;
-{
- int result;
-
- result= exprtype(ltype,rtype);
- if(operator==MODSYM || operator== '\\') result=INTTYPE;
- extraconvert(ltype,result,rtype);
- conversion(rtype,result);
- if( result== INTTYPE)
- {
- if( operator=='/')
- {
- result= DOUBLETYPE;
- extraconvert(ltype,result,rtype);
- conversion(rtype,result);
- emcode("dvf",EMFLTSIZE);
- } else
- if( operator=='\\')
- emcode("dvi",EMINTSIZE);
- else
- if( operator=='*')
- emcode("mli",EMINTSIZE);
- else
- if( operator==MODSYM)
- emcode("rmi",EMINTSIZE);
- else error("illegal operator");
- } else{
- if( operator=='/')
- emcode("dvf",EMFLTSIZE);
- else
- if( operator=='*')
- emcode("mlf",EMFLTSIZE);
- else error("illegal operator");
- }
- return(result);
-}
-negate(type)
-int type;
-{
- switch(type)
- {
- case INTTYPE:
- emcode("ngi",EMINTSIZE); break;
- case DOUBLETYPE:
- case FLOATTYPE:
- emcode("ngf",EMFLTSIZE); break;
- default:
- error("Illegal operator");
- }
- return(type);
-}
-power(ltype,rtype)
-int ltype,rtype;
-{
- extraconvert(ltype,DOUBLETYPE,rtype);
- conversion(rtype,DOUBLETYPE);
- emcode("cal","$_power");
- emcode("asp",EMFLTSIZE);
- emcode("asp",EMFLTSIZE);
- emcode("lfr",EMFLTSIZE);
- return(DOUBLETYPE);
-}
-char *typesize(ltype)
-int ltype;
-{
- switch( ltype)
- {
- case INTTYPE:
- return(EMINTSIZE);
- case FLOATTYPE:
- case DOUBLETYPE:
- return(EMFLTSIZE);
- case STRINGTYPE:
- return(EMPTRSIZE);
- default:
- error("typesize:unexpected");
- if(debug) printf("type received %d\n",ltype);
- }
- return(EMINTSIZE);
-}
-/*
-loadptr(s)
-Symbol *s;
-{
- if( POINTERSIZE==WORDSIZE)
- fprintf(tmpfile," loe l%d\n",s->symalias);
- else
- if( POINTERSIZE== 2*WORDSIZE)
- fprintf(tmpfile," lde l%d\n",s->symalias);
- else error("loadptr:unexpected pointersize");
-}
-*/
-char *typestring(type)
-int type;
-{
- switch(type)
- {
- case INTTYPE:
- return(EMINTSIZE);
- case FLOATTYPE:
- case DOUBLETYPE:
- return(EMFLTSIZE);
- case STRINGTYPE:
- return(EMPTRSIZE);
- default:
- error("typestring: unexpected type");
- }
- return("0");
-}
-loadvar(type)
-int type;
-{
- /* load a simple variable its address is on the stack*/
- emcode("loi",typestring(type));
- return(type);
-}
-loadint(value)
-int value;
-{
- emcode("loc",itoa(value));
- return(INTTYPE);
-}
-loaddbl(value)
-double value;
-{
- int index;
- index= genlabel();
- fprintf(emfile,"l%d\n bss 8,%fF8,1\n",index,value);
- emcode("lae",datalabel(index));
- emcode("loi",EMFLTSIZE);
- return(DOUBLETYPE);
-}
-loadstr(value)
-int value;
-{
- emcode("lae",datalabel(value));
- return(STRINGTYPE);
-}
-loadaddr(s)
-Symbol *s;
-{
- extern Symbol *fcn;
- int i,j;
-
- if(debug) printf("load %s %d\n",s->symname,s->symtype);
- if( s->symalias>0)
- emcode("lae",datalabel(s->symalias));
- else{
- j= -s->symalias;
- if(debug) printf("load parm %d\n",j);
- fprintf(tmpfile," lal ");
- for(i=fcn->dimensions;i>j;i--)
- fprintf(tmpfile,"%s+",typesize(fcn->dimlimit[i-1]));
- fprintf(tmpfile,"0\n");
- emlinecount++;
- /*
- emcode("lal",datalabel(fcn->dimalias[-s->symalias]));
- */
- }
- return(s->symtype);
-}
-assign(type,lt)
-int type,lt;
-{
- extern int e1,e2;
- conversion(lt,type);
- exchange(e1,e2);
- /* address is on stack already */
- emcode("sti",typestring(type) );
-}
-storevar(lab,type)
-int lab,type;
-{
- /*store value back */
- emcode("lae",datalabel(lab));
- emcode("sti",typestring(type));
-}
-
-/* maintain a stack of array references */
-int dimstk[MAXDIMENSIONS], dimtop= -1;
-Symbol *arraystk[MAXDIMENSIONS];
-
-newarrayload(s)
-Symbol *s;
-{
- if( dimtop<MAXDIMENSIONS) dimtop++;
- if( s->dimensions==0)
- {
- s->dimensions=1;
- defarray(s);
- }
- dimstk[dimtop]= s->dimensions;
- arraystk[dimtop]= s;
- emcode("lae",datalabel(s->symalias));
-}
-endarrayload()
-{
- return(arraystk[dimtop--]->symtype);
-}
-loadarray(type)
-int type;
-{
- int dim;
- Symbol *s;
-
- if( dimtop<0 || dimtop>=MAXDIMENSIONS)
- fatal("too many nested array references");
- /* index expression is on top of stack */
- s=arraystk[dimtop];
- dim= dimstk[dimtop];
- if( dim==0)
- {
- error("too many indices");
- dimstk[dim--]=0;
- return;
- }
- conversion(type,INTTYPE);
- dim--;
- /* first check index range */
- fprintf(tmpfile," lae r%d\n",s->dimalias[dim]);
- emlinecount++;
- emcode("rck",EMINTSIZE);
- emcode("lae",datalabel(s->dimalias[dim]));
- emcode("aar",EMINTSIZE);
- dimstk[dimtop]--;
-}
-storearray(type)
-{
- /* used only in let statement */
- extern int e1,e2;
- exchange(e1,e2);
- emcode("sti",typestring(type));
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-
-/* expression types for predefined functions are assembled */
-int typetable[10];
-int exprlimit;
-
-/* handle all predefined functions */
-#define cv(X) conversion(type,X); pop=X
-#define cl(X) emcode("cal",X);
-
-parm(cnt)
-int cnt;
-{
- if( cnt> exprlimit)
- error("Not enough arguments");
- if( cnt < exprlimit)
- error("Too many arguments");
-}
-
-callfcn(fcnnr,cnt)
-int fcnnr,cnt;
-{
- int pop=DOUBLETYPE;
- int res=DOUBLETYPE;
- int type;
-
-
- type= typetable[0];
- exprlimit=cnt;
- if(debug) printf("fcn=%d\n",fcnnr);
- switch(fcnnr)
- {
- case ABSSYM: cv(DOUBLETYPE);
- cl("$_abr");
- parm(1);
- break;
- case ASCSYM: cv(STRINGTYPE);
- cl("$_asc"); res=INTTYPE;
- parm(1);
- break;
- case ATNSYM: cv(DOUBLETYPE);
- cl("$_atn");
- parm(1);
- break;
- case CDBLSYM: cv(DOUBLETYPE); return(DOUBLETYPE);;
- case CHRSYM: cv(INTTYPE);
- cl("$_chr"); res=STRINGTYPE;
- parm(1);
- break;
- case CSNGSYM:
- cv(DOUBLETYPE); return(DOUBLETYPE);
- case CINTSYM: cv(INTTYPE); return(INTTYPE);
- case COSSYM: cv(DOUBLETYPE);
- cl("$_cos");
- parm(1);
- break;
- case CVISYM: cv(STRINGTYPE);
- cl("$_cvi"); res=INTTYPE;
- parm(1);
- break;
- case CVSSYM: cv(STRINGTYPE);
- cl("$_cvd"); res=DOUBLETYPE;
- parm(1);
- break;
- case CVDSYM: cv(STRINGTYPE);
- cl("$_cvd"); res=DOUBLETYPE;
- parm(1);
- break;
- case EOFSYM:
- if( cnt==0)
- {
- res= INTTYPE;
- pop= INTTYPE;
- emcode("loc","-1");
- } else cv(INTTYPE);
- cl("$_ioeof"); res=INTTYPE;
- break;
- case EXPSYM: cv(DOUBLETYPE);
- cl("$_exp");
- parm(1);
- break;
- case FIXSYM: cv(DOUBLETYPE);
- cl("$_fix"); res=INTTYPE;
- parm(1);
- break;
- case INPSYM:
- case LPOSSYM:
- case FRESYM: pop=0;
- warning("function not supported");
- parm(1);
- break;
- case HEXSYM: cv(INTTYPE);
- cl("$_hex"); res=STRINGTYPE;
- parm(1);
- break;
- case OUTSYM:
- case INSTRSYM: cv(DOUBLETYPE);
- cl("$_instr"); res=STRINGTYPE;
- parm(1);
- break;
- case INTSYM: cv(DOUBLETYPE);
- cl("$_fcint");
- parm(1);
- break;
- case LEFTSYM: parm(2);
- extraconvert(type, STRINGTYPE,typetable[1]);
- type= typetable[1];
- cv(INTTYPE);
- cl("$_left"); res=STRINGTYPE;
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMINTSIZE);
- emcode("lfr",EMPTRSIZE);
- return(STRINGTYPE);
- case LENSYM: cv(STRINGTYPE);
- cl("$_len"); res=INTTYPE;
- parm(1);
- break;
- case LOCSYM: cv(INTTYPE);
- cl("$_loc"); res=INTTYPE;
- parm(1);
- break;
- case LOGSYM: cv(DOUBLETYPE);
- cl("$_log");
- parm(1);
- break;
- case MKISYM: cv(INTTYPE);
- cl("$_mki"); res=STRINGTYPE;
- parm(1);
- break;
- case MKSSYM: cv(DOUBLETYPE);
- cl("$_mkd"); res=STRINGTYPE;
- parm(1);
- break;
- case MKDSYM: cv(DOUBLETYPE);
- cl("$_mkd"); res=STRINGTYPE;
- parm(1);
- break;
- case OCTSYM: cv(INTTYPE);
- cl("$_oct"); res=STRINGTYPE;
- parm(1);
- break;
- case PEEKSYM: cv(INTTYPE);
- cl("$_peek"); res=INTTYPE;
- parm(1);
- break;
- case POSSYM: emcode("asp",typestring(type));
- emcode("exa","_pos");
- emcode("loe","_pos");
- return(INTTYPE);
- case RIGHTSYM: parm(2);
- extraconvert(type, STRINGTYPE,typetable[1]);
- type= typetable[1];
- cv(INTTYPE);
- cl("$_right"); res=STRINGTYPE;
- emcode("asp",EMINTSIZE);
- emcode("asp",EMPTRSIZE);
- emcode("lfr",EMPTRSIZE);
- return(STRINGTYPE);
- case RNDSYM: if( cnt==1) pop=type; else pop=0;
- cl("$_rnd"); res= DOUBLETYPE;
- break;
- case SGNSYM: cv(DOUBLETYPE);
- cl("$_sgn"); res=INTTYPE;
- parm(1);
- break;
- case SINSYM: cv(DOUBLETYPE);
- cl("$_sin");
- parm(1);
- break;
- case SPACESYM: cv(INTTYPE);
- cl("$_space"); res=STRINGTYPE;
- parm(1);
- break;
- case SPCSYM: cv(INTTYPE);
- cl("$_spc"); res=0;
- parm(1);
- break;
- case SQRSYM: cv(DOUBLETYPE);
- cl("$_sqt");
- parm(1);
- break;
- case STRSYM: cv(DOUBLETYPE);
- cl("$_str");
- parm(1);
- break;
- case STRINGSYM: cv(STRINGTYPE);
- cl("$_string"); res=STRINGTYPE;
- parm(1);
- break;
- case TABSYM: cv(INTTYPE);
- cl("$_tab"); res=0;
- parm(1);
- break;
- case TANSYM: cv(DOUBLETYPE);
- cl("$_tan");
- parm(1);
- break;
- case VALSYM: cv(STRINGTYPE);
- cl("$atol"); res=INTTYPE;
- parm(1);
- break;
- case VARPTRSYM: cv(DOUBLETYPE);
- cl("$_valptr");
- parm(1);
- break;
- default: error("unknown function");
- }
- if(pop)
- emcode("asp",typestring(pop));
- if(res)
- emcode("lfr",typestring(res));
- return(res);
-}
-
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-
-/* Here we find all routines dealing with pure EM code generation */
-
-static int emlabel=1;
-genlabel() { return(emlabel++);}
-
-
-genemlabel()
-{
- int l;
-
- l=genlabel();
- fprintf( emfile,"l%d\n",l);
- return(l);
-}
-genrom()
-{
- int l;
- l= genemlabel();
- fprintf(emfile," rom ");
- return(l);
-}
-
-where()
-{
- return(emlinecount);
-}
-exchange(blk1,blk2)
-int blk1,blk2;
-{
- /* exchange assembler blocks */
- if(debug) printf("exchange %d %d %d\n",blk1,blk2,emlinecount);
- fprintf(tmpfile," exc %d,%d\n",blk2-blk1,emlinecount-blk2);
- emlinecount++;
-}
-
-/* routines to manipulate the tmpfile */
-int emlinecount; /* count number of lines generated */
- /* this value can be used to generate EXC */
-int tronoff=0;
-newemblock(nr)
-int nr;
-{
- /* save location on tmpfile */
- currline->offset= ftell(tmpfile);
- fprintf(tmpfile,"%d\n",currline->emlabel);
- fprintf(tmpfile," lin %d\n",nr);
- emlinecount += 2;
- if( tronoff || traceflag) emcode("cal","$_trace");
-}
-
-emcode(operation,params)
-char *operation,*params;
-{
- fprintf(tmpfile," %s %s\n",operation,params);
- emlinecount++;
-}
-/* Handle data statements */
-int dataused=0;
-List *datalist=0;
-datastmt()
-{
- List *l,*l1;
- l= (List *) salloc(sizeof(List));
- l->linenr= currline->linenr;
- l->emlabel= (long) ftell(datfile);
- if( datalist==0)
- {
- datalist=l;
- datfile= fopen(datfname,"w");
- if( datfile==NULL) fatal("improper file creation permission");
- }else{
- l1= datalist;
- while(l1->nextlist) l1= l1->nextlist;
- l1->nextlist=l;
- }
-
- dataused=1;
-}
-datatable()
-{
- List *l;
- int line=0;
-
- /* called at end to generate the data seek table */
- fprintf(emfile," exa _seektable\n");
- fprintf(emfile,"_seektable\n");
- l= datalist;
- while(l)
- {
- fprintf(emfile," rom %d,%d\n", l->linenr,line++);
- l= l->nextlist;
- }
- fprintf(emfile," rom 0,0\n");
-}
-
-/* ERROR and exception handling */
-exceptstmt(lab)
-int lab;
-{
- /* exceptions to subroutines are supported only */
- extern int gosubcnt;
- List *l;
-
- emcode("loc",itoa(gosubcnt));
- l= (List *) gosublabel();
- l->emlabel= gotolabel(lab);
- emcode("cal","$_trpset");
- emcode("asp",EMINTSIZE);
-}
-
-errorstmt(exprtype)
-int exprtype;
-{
- /* convert expression to a valid error number */
- /* obtain the message and print it */
- emcode("cal","$error");
- emcode("asp",typesize(exprtype));
-}
-
-/* BASIC IO */
-openstmt(recsize)
-int recsize;
-{
- emcode("loc",itoa(recsize));
- emcode("cal","$_opnchn");
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMINTSIZE);
-}
-
-
-printstmt(exprtype)
-int exprtype;
-{
- switch(exprtype)
- {
- case INTTYPE:
- emcode("cal","$_prinum");
- emcode("asp",typestring(INTTYPE));
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- emcode("cal","$_prfnum");
- emcode("asp",typestring(DOUBLETYPE));
- break;
- case STRINGTYPE:
- emcode("cal","$_prstr");
- emcode("asp",EMPTRSIZE);
- break;
- case 0: /* result of tab function etc */
- break;
- default:
- error("printstmt:unexpected");
- }
-}
-zone(i)
-int i;
-{
- if( i)emcode("cal","$_zone");
-}
-writestmt(exprtype,comma)
-int exprtype,comma;
-{
- if( comma) emcode("cal","$_wrcomma");
- switch(exprtype)
- {
- case INTTYPE:
- emcode("cal","$_wrint");
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- emcode("cal","$_wrint");
- break;
- case STRINGTYPE:
- emcode("cal","$_wrstr");
- break;
- default:
- error("printstmt:unexpected");
- }
- emcode("asp",EMPTRSIZE);
-}
-restore(lab)
-int lab;
-{
- /* save this information too */
-
- emcode("loc",itoa(0));
- emcode("cal","$_setchannel");
- emcode("asp",EMINTSIZE);
- emcode("loc",itoa(lab));
- emcode("cal","$_restore");
- emcode("asp",EMINTSIZE);
-}
-prompt(qst)
-int qst;
-{
- setchannel(-1);
- emcode("cal","$_prstr");
- emcode("asp",EMPTRSIZE);
- if(qst) emcode("cal","$_qstmark");
-}
-linestmt(type)
-int type;
-{
- if( type!= STRINGTYPE)
- error("String variable expected");
- emcode("cal","$_rdline");
- emcode("asp",EMPTRSIZE);
-}
-readelm(type)
-int type;
-{
- switch(type)
- {
- case INTTYPE:
- emcode("cal","$_readint");
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- emcode("cal","$_readflt");
- break;
- case STRINGTYPE:
- emcode("cal","$_readstr");
- break;
- default:
- error("readelm:unexpected type");
- }
- emcode("asp",EMPTRSIZE);
-}
-
-/* Swap exchanges the variable values */
-swapstmt(ltype,rtype)
-int ltype, rtype;
-{
- if( ltype!= rtype)
- error("Type mismatch");
- else
- switch(ltype)
- {
- case INTTYPE:
- emcode("cal","$_intswap");
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- emcode("cal","$_fltswap");
- break;
- case STRINGTYPE:
- emcode("cal","$_strswap");
- break;
- default:
- error("swap:unexpected");
- }
- emcode("asp",EMPTRSIZE);
- emcode("asp",EMPTRSIZE);
-}
-
-/* input/output handling */
-setchannel(val)
-int val;
-{ /* obtain file descroption */
- emcode("loc",itoa(val));
- emcode("cal","$_setchannel");
- emcode("asp",EMINTSIZE);
-}
-/* The if-then-else statements */
-ifstmt(type)
-int type;
-{
- /* This BASIC follows the True= -1 rule */
- int nr;
-
- nr= genlabel();
- if( type == INTTYPE)
- emcode("zeq",instrlabel(nr));
- else
- if( type == FLOATTYPE)
- {
- emcode("lae","fltnull");
- emcode("loi",EMFLTSIZE);
- emcode("cmf",EMFLTSIZE);
- emcode("zeq",instrlabel(nr));
- }
- else error("Integer or Float expected");
- return(nr);
-}
-thenpart( elselab)
-int elselab;
-{
- int nr;
-
- nr=genlabel();
- emcode("bra",instrlabel(nr));
- fprintf(tmpfile,"%d\n",elselab);
- emlinecount++;
- return(nr);
-}
-elsepart(lab)int lab;
-{
- fprintf(tmpfile,"%d\n",lab); emlinecount++;
-}
-/* generate code for the for-statement */
-#define MAXFORDEPTH 20
-struct FORSTRUCT{
- Symbol *loopvar; /* loop variable */
- int initaddress;
- int limitaddress;
- int stepaddress;
- int fortst; /* variable limit test */
- int forinc; /* variable increment code */
- int forout; /* end of loop */
-} fortable[MAXFORDEPTH];
-int forcnt= -1;
-
-forinit(s)
-Symbol *s;
-{
- int type;
- struct FORSTRUCT *f;
-
- dcltype(s);
- type= s->symtype;
- forcnt++;
- if( (type!=INTTYPE && type!=FLOATTYPE && type!=DOUBLETYPE) ||
- s->dimensions)
- error("Illegal loop variable");
- if( forcnt >=MAXFORDEPTH)
- error("too many for statements");
- else{
- f=fortable+forcnt;
- f->loopvar=s;
- f->fortst=genlabel();
- f->forinc=genlabel();
- f->forout=genlabel();
- /* generate space for temporary objects */
- f->initaddress= dclspace(type);
- f->limitaddress= dclspace(type);
- f->stepaddress= dclspace(type);
- }
-}
-forexpr(type)
-int type;
-{
- /* save start value of loop variable in a save place*/
- /* to avoid clashing with final value and step expression */
- int result;
- result= fortable[forcnt].loopvar->symtype;
- conversion(type,result);
- storevar(fortable[forcnt].initaddress, result);
-}
-forlimit(type)
-int type;
-{
- /* save the limit value too*/
- int result;
- result= fortable[forcnt].loopvar->symtype;
- conversion(type,result);
- storevar(fortable[forcnt].limitaddress, result);
-}
-forskipped(f)
-struct FORSTRUCT *f;
-{
- int type;
- type= f->loopvar->symtype;
- /* evaluate lower bound times sign of step */
- emcode("lae",datalabel(f->initaddress));
- loadvar(type);
- conversion(type,DOUBLETYPE);
- emcode("lae",datalabel(f->stepaddress));
- loadvar(type);
- conversion(type,DOUBLETYPE);
- emcode("cal","$_sgn");
- emcode("asp",EMFLTSIZE);
- emcode("lfr",EMINTSIZE);
- conversion(INTTYPE,DOUBLETYPE);
- emcode("mlf",EMFLTSIZE);
- /* evaluate higher bound times sign of step */
- emcode("lae",datalabel(f->limitaddress));
- loadvar(type);
- conversion(type,DOUBLETYPE);
- emcode("lae",datalabel(f->stepaddress));
- loadvar(type);
- conversion(type,DOUBLETYPE);
- emcode("cal","$_sgn");
- emcode("asp",EMFLTSIZE);
- emcode("lfr",EMINTSIZE);
- conversion(INTTYPE,DOUBLETYPE);
- emcode("mlf",EMFLTSIZE);
- /* skip condition */
- emcode("cmf",EMFLTSIZE);
- emcode("zgt",instrlabel(f->forout));
-}
-forstep(type)
-int type;
-{
- int result;
- int varaddress;
- struct FORSTRUCT *f;
-
- f= fortable+forcnt;
- result= f->loopvar->symtype;
- varaddress= f->loopvar->symalias;
- conversion(type,result);
- storevar(f->stepaddress, result);
- /* all information available, generate for-loop head */
- /* test for ingoring loop */
- forskipped(f);
- /* set initial value */
- emcode("lae",datalabel(f->initaddress));
- loadvar(result);
- emcode("lae",datalabel(varaddress));
- emcode("sti",typestring(result));
- emcode("bra",instrlabel(f->fortst));
- /* increment loop variable */
- fprintf(tmpfile,"%d\n",f->forinc);
- emlinecount++;
- emcode("lae",datalabel(varaddress));
- loadvar(result);
- emcode("lae",datalabel(f->stepaddress));
- loadvar(result);
- if(result == INTTYPE)
- emcode("adi",EMINTSIZE);
- else emcode("adf",EMFLTSIZE);
- emcode("lae",datalabel(varaddress));
- emcode("sti",typestring(result));
- /* test boundary */
- fprintf(tmpfile,"%d\n",f->fortst);
- emlinecount++;
- emcode("lae",datalabel(varaddress));
- loadvar(result);
- emcode("lae",datalabel(f->limitaddress));
- loadvar(result);
- if(result == INTTYPE)
- emcode("cmi",EMINTSIZE);
- else emcode("cmf",EMFLTSIZE);
- emcode("zgt",instrlabel(f->forout));
-}
-nextstmt(s)
-Symbol *s;
-{
- if(forcnt>MAXFORDEPTH || forcnt<0 ||
- ( s && s!= fortable[forcnt].loopvar))
- error("NEXT without FOR");
- else{
- /* address of variable is on top of stack ! */
- emcode("bra",instrlabel(fortable[forcnt].forinc));
- fprintf(tmpfile,"%d\n",fortable[forcnt].forout);
- forcnt--;
- }
-}
-
-pokestmt(type1,type2)
-int type1,type2;
-{
- conversion(type1,INTTYPE);
- conversion(type2,INTTYPE);
- emcode("cal","$_poke");
- emcode("asp",EMINTSIZE);
- emcode("asp",EMINTSIZE);
-}
-
-/* generate code for the while statement */
-#define MAXDEPTH 20
-
-int whilecnt, whilelabels[MAXDEPTH][2]; /*0=head,1=out */
-
-whilestart()
-{
- whilecnt++;
- if( whilecnt==MAXDEPTH)
- fatal("too many nestings");
- /* gendummy label in graph */
- newblock(-1);
- whilelabels[whilecnt][0]= currline->emlabel;
- whilelabels[whilecnt][1]= genlabel();
- fprintf(tmpfile,"%d\n", whilelabels[whilecnt][0]);
- emlinecount++;
-}
-whiletst(exprtype)
-int exprtype;
-{
- /* test expression type */
- conversion(exprtype,INTTYPE);
- fprintf(tmpfile," zeq *%d\n",whilelabels[whilecnt][1]);
- emlinecount++;
-}
-wend()
-{
- if( whilecnt<1)
- error("not part of while statement");
- else{
- fprintf(tmpfile," bra *%d\n",whilelabels[whilecnt][0]);
- fprintf(tmpfile,"%d\n",whilelabels[whilecnt][1]);
- emlinecount++;
- emlinecount++;
- whilecnt--;
- }
-}
-
-/* generate code for the final version */
-prologcode()
-{
- /* generate the EM prolog code */
- fprintf(emfile,"fltnull\n con 0,0,0,0\n");
- fprintf(emfile,"dummy2\n con 0,0,0,0\n");
- fprintf(emfile,"tronoff\n con 0\n");
- fprintf(emfile,"dummy1\n con 0,0,0,0\n");
- fprintf(emfile," exa _iomode\n_iomode\n rom \"O\"\n");
- fprintf(emfile," exa _errsym\n");
- fprintf(emfile,"_errsym\n bss 2,0,1\n");
- fprintf(emfile," exa _erlsym\n");
- fprintf(emfile,"_erlsym\n bss 2,0,1\n");
-}
-
-prolog2()
-{
- fprintf(emfile," exp $main\n");
- fprintf(emfile," pro $main,0\n");
- fprintf(emfile," mes 3\n");
- fprintf(emfile," mes 9,0\n");
- /* Trap handling */
- fprintf(emfile," cal $_ini_trp\n");
- fprintf(emfile," exa trpbuf\n");
- fprintf(emfile," lae trpbuf\n");
- fprintf(emfile," cal $setjmp\n");
- fprintf(emfile," asp 4\n");
- fprintf(emfile," lfr %s\n",EMINTSIZE);
- fprintf(emfile," dup %s\n",EMINTSIZE);
- fprintf(emfile," zeq *0\n");
- fprintf(emfile," lae returns\n");
- fprintf(emfile," csa %s\n",EMINTSIZE);
- fprintf(emfile,"0\n");
- fprintf(emfile," asp EM_WSIZE\n");
- /* when data lists are used open its file */
- if( dataused)
- {
- fprintf(emfile," loc 0\n");
- fprintf(emfile," cal $_setchannel\n");
- fprintf(emfile," asp EM_WSIZE\n");
- fprintf(emfile,"datfname\n rom \"%s\"\n", datfname);
- fprintf(emfile," lae datfname\n");
- fprintf(emfile," cal $_opnchn\n");
- fprintf(emfile," asp EM_PSIZE\n");
- }
- datatable();
-}
-
-epilogcode()
-{
- /* finalization code */
- int nr;
- nr= genlabel();
- fprintf(emfile," bra *%d\n",nr);
- genreturns();
- fprintf(emfile,"%d\n",nr);
- fprintf(emfile," loc 0\n");
- fprintf(emfile," cal $_hlt\n");
- fprintf(emfile," end 0\n");
- fprintf(emfile," mes 4,4\n");
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-
-List *forwardlabel=0;
-
-Linerecord *firstline,
- *currline,
- *lastline;
-
-/* Line management is handled here */
-
-Linerecord *srchline(nr)
-int nr;
-{
- Linerecord *l;
- for(l=firstline;l && l->linenr<=nr;l= l->nextline)
- if( l->linenr== nr) return(l);
- return(0);
-}
-List *srchforward(nr)
-int nr;
-{
- List *l;
- for(l=forwardlabel;l ;l=l->nextlist)
- if( l->linenr== nr) return(l);
- return(0);
-}
-linewarnings()
-{
- List *l;
- extern int errorcnt;
- l= forwardlabel;
- while(l)
- {
- if( !srchline(l->linenr))
- {
- printf("ERROR: line %d not defined\n",l->linenr);
- errorcnt++;
- }
- l=l->nextlist;
- }
-}
-
-newblock(nr)
-int nr;
-{
- Linerecord *l;
- List *frwrd;
-
- if( debug) printf("newblock at %d\n",nr);
- if( nr>0 && currline && currline->linenr>= nr)
- {
- if( debug) printf("old line:%d\n",currline->linenr);
- error("Lines out of sequence");
- }
-
- frwrd=srchforward(nr);
- if( frwrd && debug) printf("forward found %d\n",frwrd->emlabel);
- l= srchline(nr);
- if( l)
- {
- error("Line redefined");
- nr= -genlabel();
- }
-
- /* make new EM block structure */
- l= (Linerecord *) salloc(sizeof(*l));
- l->emlabel= frwrd? frwrd->emlabel: genlabel();
- l->linenr= nr;
- /* save offset into tmpfile too */
- l->offset = (long) ftell(tmpfile);
- l->codelines= emlinecount;
-
- /* insert this record */
- if( firstline)
- {
- currline->nextline=l;
- l->prevline= currline;
- lastline= currline=l;
- } else
- firstline = lastline =currline=l;
-}
-
-gotolabel(nr)
-int nr;
-{
- /* simulate a goto statement in the line record table */
- Linerecord *l1;
- List *ll;
-
- if(debug) printf("goto label %d\n",nr);
- /* update currline */
- ll= (List *) salloc( sizeof(*ll));
- ll-> linenr=nr;
- ll-> nextlist= currline->gotos;
- currline->gotos= ll;
-
- /* try to generate code */
- l1= srchline(nr);
- if( (ll=srchforward(nr))!=0)
- nr= ll->emlabel;
- else
- if( l1==0)
- {
- /* declare forward label */
- if(debug) printf("declare forward %d\n",nr);
- ll= (List *) salloc( sizeof(*ll));
- ll->emlabel= genlabel();
- ll-> linenr=nr;
- ll->nextlist= forwardlabel;
- forwardlabel= ll;
- nr= ll->emlabel;
- } else
- nr= l1->emlabel;
- return(nr);
-}
-gotostmt(nr)
-int nr;
-{
- emcode("bra",instrlabel(gotolabel(nr)));
-}
-/* GOSUB-return, assume that proper entries are made to subroutines
- only. The return statement is triggered by a fake constant label */
-
-List *gosubhead, *gotail;
-int gosubcnt=1;
-
-List *gosublabel()
-{
- List *l;
- int n;
-
- l= (List *) salloc(sizeof(List));
- l->nextlist=0;
- l->emlabel=genlabel();
- if( gotail){
- gotail->nextlist=l;
- gotail=l;
- } else gotail= gosubhead=l;
- gosubcnt++;
- return(l);
-}
-gosubstmt(lab)
-int lab;
-{
- List *l;
- int nr,n;
-
- n=gosubcnt;
- l= gosublabel();
- nr=gotolabel(lab);
- emcode("loc",itoa(n)); /*return index */
- emcode("cal","$_gosub"); /* administer legal return */
- emcode("asp",EMINTSIZE);
- emcode("bra",instrlabel(nr));
- fprintf(tmpfile,"%d\n",l->emlabel);
- emlinecount++;
-}
-genreturns()
-{
- int nr;
- nr= genlabel();
- fprintf(emfile,"returns\n");
- fprintf(emfile," rom *%d,1,%d\n",nr,gosubcnt-1);
- while( gosubhead)
- {
- fprintf(emfile," rom *%d\n",gosubhead->emlabel);
- gosubhead= gosubhead->nextlist;
- }
- fprintf(emfile,"%d\n",nr);
- fprintf(emfile," loc 1\n");
- fprintf(emfile," cal $error\n");
-}
-returnstmt()
-{
- emcode("cal","$_retstmt"); /* ensure legal return*/
- emcode("lfr",EMINTSIZE);
- fprintf(tmpfile," lae returns\n");
- emlinecount++;
- emcode("csa",EMINTSIZE);
-}
-/* compound goto-gosub statements */
-List *jumphead,*jumptail;
-int jumpcnt;
-
-jumpelm(nr)
-int nr;
-{
- List *l;
-
- l= (List *) salloc(sizeof(List));
- l->emlabel= gotolabel(nr);
- l->nextlist=0;
- if( jumphead==0) jumphead= jumptail= l;
- else {
- jumptail->nextlist=l;
- jumptail=l;
- }
- jumpcnt++;
-}
-ongotostmt(type)
-int type;
-{
- /* generate the code itself, index in on top of the stack */
- /* blurh, store the number of entries in the descriptor */
- int firstlabel;
- int descr;
- List *l;
- /* create descriptor first */
- descr= genlabel();
- firstlabel=genlabel();
- fprintf(tmpfile,"l%d\n",descr); emlinecount++;
- fprintf(tmpfile," rom *%d,1,%d\n",firstlabel,jumpcnt); emlinecount++;
- l= jumphead;
- while( l)
- {
- fprintf(tmpfile," rom *%d\n",l->emlabel); emlinecount++;
- l= l->nextlist;
- }
- jumphead= jumptail=0; jumpcnt=0;
- if(debug) printf("ongotst:%d labels\n", jumpcnt);
- conversion(type,INTTYPE);
- emcode("lae",datalabel(descr));
- emcode("csa",EMINTSIZE);
- fprintf(tmpfile,"%d\n",firstlabel); emlinecount++;
-}
-ongosubstmt(type)
-int type;
-{
- List *l;
- int firstlabel;
- int descr;
- /* create descriptor first */
- descr= genlabel();
- firstlabel=genlabel();
- fprintf(tmpfile,"l%d\n",descr); emlinecount++;
- fprintf(tmpfile," rom *%d,1,%d\n",firstlabel,jumpcnt); emlinecount++;
- l= jumphead;
- while( l)
- {
- fprintf(tmpfile," rom *%d\n",l->emlabel); emlinecount++;
- l= l->nextlist;
- }
- jumphead= jumptail=0; jumpcnt=0;
-
- l= (List *) salloc(sizeof(List));
- l->nextlist=0;
- l->emlabel=firstlabel;
- if( gotail){
- gotail->nextlist=l;
- gotail=l;
- } else gotail= gosubhead=l;
- /* save the return point of the gosub */
- emcode("loc",itoa(gosubcnt));
- emcode("cal","$_gosub");
- emcode("asp",EMINTSIZE);
- gosubcnt++;
- /* generate gosub */
- conversion(type,INTTYPE);
- emcode("lae",datalabel(descr));
- emcode("csa",EMINTSIZE);
- fprintf(tmpfile,"%d\n",firstlabel);
- emlinecount++;
-}
-
-/* REGION ANALYSIS and FINAL VERSION GENERATION */
-
-simpleprogram()
-{
- char buf[512];
- int length;
-
- /* a small EM programs has been found */
- prologcode();
- prolog2();
- fclose(tmpfile);
- tmpfile= fopen(tmpfname,"r");
- if( tmpfile==NULL)
- fatal("tmp file disappeared");
- while( (length=fread(buf,1,512,tmpfile)) != 0)
- fwrite(buf,1,length,emfile);
- epilogcode();
- unlink(tmpfname);
-}
+++ /dev/null
-#
-
-#ifndef NORCSID
-# define RCS_GRAPH "$Header$"
-#endif
-
-/*
-** The control graph is represented by a multi-list structure.
-** The em code is stored on the em intermediate file already
-** The offset and length is saved only.
-** Although this makes code generation mode involved, it allows
-** rather large BASIC programs to be processed.
-*/
-typedef struct LIST {
- int emlabel; /* em label used with forwards */
- int linenr; /* BASIC line number */
- struct LIST *nextlist;
-} List;
-
-typedef struct LINERECORD{
- int emlabel; /* target label */
- int linenr; /* BASIC line number */
- long offset; /* file offset in em file */
- long codelines; /* number of em code lines */
- List *callers; /* used from where ? */
- List *gotos; /* fanout labels */
- struct LINERECORD *nextline, *prevline;
- int fixed; /* fixation of block */
-} Linerecord;
-
-extern Linerecord *firstline,
- *currline,
- *lastline;
-extern List *forwardlabel;
+++ /dev/null
-#include "bem.h"
-#include <em_path.h>
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* generate temporary files etc */
-
-FILE *emfile;
-FILE *tmpfile;
-FILE *datfile;
-
-initialize()
-{
- sprintf(tmpfname,"%s/abc%d",TMP_DIR,getpid());
- strcpy(datfname,program);
- strcat(datfname,".d");
- yyin= fopen(inpfile,"r");
- emfile= fopen(outfile,"w");
- tmpfile= fopen(tmpfname,"w");
- if( yyin==NULL || emfile== NULL || tmpfile== NULL )
- fatal("Improper file permissions");
- fillkex(); /* initialize symbol table */
- fprintf(emfile,"#\n");
- fprintf(emfile," mes 2,EM_WSIZE,EM_PSIZE\n");
- initdeftype(); /* set default symbol declarers */
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-int listing; /* -l listing required */
-int debug; /* -d compiler debugging */
-int wflag=1; /* -w no warnings */
-int hflag=0; /* -h<number> to split EM program */
-int traceflag=0; /* generate line tracing code */
-int nolins=0; /* generate no LIN statements */
-
-parseparams(argc,argv)
-int argc;
-char **argv;
-{
- int i,j,k;
- char *ext;
-
- j=k=0;
- if(argc< 4)
- {
- fprintf(stderr,"usage %s <flags> <file>.i <file>.e <source>\n", argv[0]);
- exit(-1);
- }
- for(i=1;i<argc;i++)
- if( argv[i][0]=='-')
- switch(argv[i][1])
- {
- case 'D': yydebug++; break; /* parser debugging */
- case 't': traceflag++; break; /* line tracing */
- case 'h':/* split EM file */
- hflag=0;
- threshold= (long) atol(argv[i][2]);
- if( threshold==0)
- threshold= THRESHOLD;
- break;
- case 'd': debug++; break;
- case 'l': nolins++; break; /* no EM lin statements */
- case 'E': listing++; break; /* generate full listing */
- } else {
- /* new input file */
- ext= argv[i]+strlen(argv[i])-1;
- if( *(ext-1) != '.')
- /* should be the source file name */
- program= argv[i];
- else
- if( *ext == 'i')
- inpfile= argv[i];
- else
- if( *ext == 'e')
- outfile= argv[i];
- }
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* Split the intermediate code into procedures.
- This is necessary to make the EM code fit on
- smaller machines. (for the Peephole optimizer!)
-*/
-
-/* Heuristic is to collect all basic blocks of more then THRESHOLD
- em instructions into a procedure
-*/
-
-int procnum;
-int threshold; /* can be set by the user */
-
-
-fix(lnr)
-int lnr;
-{
- /* this block may not be moved to a procedure */
- Linerecord *lr;
-
- if(debug) printf("fixate %d\n",lnr);
- for(lr= firstline;lr; lr=lr->nextline)
- if( lr->linenr == lnr)
- lr->fixed=1;
-}
-
-fixblock(l)
-List *l;
-{
- while(l)
- {
- fix(l->linenr);
- l=l->nextlist;
- }
-}
-phase1()
-{
- /* copy all offloaded blocks */
- Linerecord *lr, *lf,*lr2;
- int blksize;
-
- lf= lr= firstline;
- blksize= lr->codelines;
- while( lr)
- {
- if( lr->fixed){
- if( !lf->fixed && blksize>threshold)
- {
- /*move block */
- if(debug) printf("%d %d->%d moved\n",
- blksize,lf->linenr, lr->linenr);
- }
- lf= lr;
- blksize= lr->codelines;
- }
- lr= lr->nextline;
- }
-}
-phase2()
-{
- /* copy main procedure */
- prolog2();
- epilogcode();
-}
-split()
-{
- /* selectively copy the intermediate code to procedures */
- Linerecord *lr;
-
- if( debug) printf("split EM code using %d\n",threshold);
-
- /* First consolidate the goto's and caller's */
- lr= firstline;
- while(lr)
- {
- fixblock(lr->callers);
- fixblock(lr->gotos);
- lr= lr->nextline;
- }
-
- /* Copy the temporary file piecewise */
- prologcode();
- phase1();
- phase2();
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* Symboltable management module */
-
-int deftype[128]; /* default type declarer */
- /* which may be set by OPTION BASE */
-
-initdeftype()
-{
- int i;
- for(i='a';i<='z';i++) deftype[i]= DOUBLETYPE;
- for(i='A';i<='Z';i++) deftype[i]= DOUBLETYPE;
-}
-
-int indexbase=0; /* start of array subscripting */
-
-Symbol *firstsym = NIL;
-Symbol *alternate = NIL;
-
-Symbol *srchsymbol(str)
-char *str;
-{
- Symbol *s;
- /* search symbol table entry or create it */
- if(debug) printf("srchsymbol %s\n",str);
- s=firstsym;
- while(s)
- {
- if( strcmp(s->symname,str)==0) return(s);
- s= s->nextsym;
- }
- /* search alternate list */
- s=alternate;
- while(s)
- {
- if( strcmp(s->symname,str)==0) return(s);
- s= s->nextsym;
- }
- /* not found, create an emty slot */
- s= (Symbol *) salloc(sizeof(Symbol));
- s->symtype= DEFAULTTYPE;
- s->nextsym= firstsym;
- s->symname= (char *) salloc(strlen(str)+1);
- strcpy(s->symname,str);
- firstsym= s;
- if(debug) printf("%s allocated\n",str);
- return(s);
-}
-
-dcltype(s)
-Symbol *s;
-{
- /* type declarer */
- int type;
- if( s->isparam) return;
- type=s->symtype;
- if(type==DEFAULTTYPE)
- /* use the default rule */
- type= deftype[*s->symname];
- /* generate the emlabel too */
- if( s->symalias==0)
- s->symalias= dclspace(type);
- s->symtype= type;
- if(debug) printf("symbol set to %d\n",type);
-}
-dclarray(s)
-Symbol *s;
-{
- int i; int size;
-
- if( s->symtype==DEFAULTTYPE) s->symtype= DOUBLETYPE;
- if(debug) printf("generate space and descriptors for %d\n",s->symtype);
- if(debug) printf("dim %d\n",s->dimensions);
- s->symalias= genlabel();
- /* generate descriptors */
- size=1;
- for(i=0;i<s->dimensions;i++)
- s->dimalias[i]= genlabel();
- for(i=s->dimensions-1;i>=0;i--)
- {
- fprintf(emfile,"l%d\n rom %d,%d,%d*%s\n",
- s->dimalias[i],
- indexbase,
- s->dimlimit[i]-indexbase,
- size, typesize(s->symtype));
- size = size* (s->dimlimit[i]+1-indexbase);
- }
- if(debug) printf("size=%d\n",size);
- /* size of stuff */
- fprintf(emfile,"l%d\n bss %d*%s,0,1\n",
- s->symalias,size,typesize(s->symtype));
- /* Generate the range check descriptors */
- for( i= 0; i<s->dimensions;i++)
- fprintf(emfile,"r%d\n rom %d,%d\n",
- s->dimalias[i],
- indexbase,
- s->dimlimit[i]);
-
-}
-defarray(s)
-Symbol *s;
-{
- /* array is used without dim statement, set default limits */
- int i;
- for(i=0;i<s->dimensions;i++) s->dimlimit[i]=10;
- dclarray(s);
-}
-dclspace(type)
-{
- int nr;
- nr= genemlabel();
- switch( type)
- {
- case STRINGTYPE:
- fprintf(emfile," bss %s,0,1\n",EMPTRSIZE);
- break;
- case INTTYPE:
- fprintf(emfile," bss %s,0,1\n",EMINTSIZE);
- break;
- case FLOATTYPE:
- case DOUBLETYPE:
- fprintf(emfile," bss 8,0.0F %s,1\n",EMFLTSIZE);
- break;
- }
- return(nr);
-}
-
-/* SOME COMPILE TIME OPTIONS */
-optionbase(ival)
-int ival;
-{
- if( ival<0 || ival>1)
- error("illegal option base value");
- else indexbase=ival;
-}
-
-setdefaulttype(type)
-int type;
-{
- extern char *cptr;
- char first,last,i;
-
- /* handcrafted parser for letter ranges */
- if(debug) printf("deftype:%s\n",cptr);
- while( isspace(*cptr)) cptr++;
- if( !isalpha(*cptr))
- error("letter expected");
- first= *cptr++;
- if(*cptr=='-')
- {
- /* letter range */
- cptr++;
- last= *cptr;
- if( !isalpha(last))
- error("letter expected");
- else for(i=first;i<=last;i++) deftype[i]= type;
- cptr++;
- } else deftype[first]=type;
- if( *cptr== ',')
- {
- cptr++;
- setdefaulttype(type); /* try again */
- }
-}
-
-Symbol *fcn;
-
-newscope(s)
-Symbol *s;
-{
- if(debug) printf("new scope for %s\n",s->symname);
- alternate= firstsym;
- firstsym = NIL;
- fcn=s;
- s->isfunction=1;
- if( fcn->dimensions)
- error("Array redeclared");
- if( fcn->symtype== DEFAULTTYPE)
- fcn->symtype=DOUBLETYPE;
-}
-/* User defined functions */
-heading( )
-{
- char procname[50];
- sprintf(procname,"$_%s",fcn->symname);
- emcode("pro",procname);
- if( fcn->symtype== DEFAULTTYPE)
- fcn->symtype= DOUBLETYPE;
-}
-fcnsize(s)
-Symbol *s;
-{
- /* generate portable function size */
- int i;
- for(i=0;i<fcn->dimensions;i++)
- fprintf(tmpfile,"%s+",typesize(fcn->dimlimit[i]));
- fprintf(tmpfile,"0\n"); emlinecount++;
-}
-endscope(type)
-int type;
-{
- Symbol *s;
-
- if( debug) printf("endscope");
- conversion(type,fcn->symtype);
- emcode("ret", typestring(fcn->symtype));
- /* generate portable EM code */
- fprintf(tmpfile," end ");
- fcnsize(fcn);
- s= firstsym;
- while(s)
- {
- firstsym = s->nextsym;
- free(s);
- s= firstsym;
- }
- firstsym= alternate;
- alternate = NIL;
- fcn=NIL;
-}
-
-dclparm(s)
-Symbol *s;
-{
- int i,size=0;
- if( s->symtype== DEFAULTTYPE)
- s->symtype= DOUBLETYPE;
- s->isparam=1;
- fcn->dimlimit[fcn->dimensions]= s->symtype;
- fcn->dimensions++;
- /*
- OLD STUFF
- for(i=fcn->dimensions;i>0;i--)
- fcn->dimalias[i]= fcn->dimalias[i-1];
- */
- /*fcn->parmsize += typesize(s->symtype);*/
- /* fcn->dimalias[0]= -typesize(s->symtype)-fcn->dimalias[1];*/
- s->symalias= -fcn->dimensions;
- if( debug) printf("parameter %d offset %d\n",fcn->dimensions-1,-size);
-}
-/* unfortunately function calls have to be stacked as well */
-#define MAXNESTING 50
-Symbol *fcntable[MAXNESTING];
-int fcnindex= -1;
-
-fcncall(s)
-Symbol *s;
-{
- if( !s->isfunction)
- error("Function not declared");
- else{
- fcn= s;
- fcnindex++;
- fcntable[fcnindex]=s;
- }
-}
-fcnend(fcntype, parmcount)
-int fcntype, parmcount;
-{
- int type;
- /* check number of arguments */
- if( parmcount <fcn->dimensions)
- error("not enough parameters");
- if( parmcount >fcn->dimensions)
- error("too many parameters");
- fprintf(tmpfile," cal $_%s\n",fcn->symname);
- emlinecount++;
- fprintf(tmpfile," asp ");
- fcnsize(fcn);
- emcode("lfr",typestring(fcn->symtype));
- type= fcn->symtype;
- fcnindex--;
- if( fcnindex>=0)
- fcn= fcntable[fcnindex];
- return(type);
-}
-callparm(ind,type)
-int ind,type;
-{
- if( fcnindex<0) error("unexpected parameter");
-
- if( ind >= fcn->dimensions)
- error("too many parameters");
- else
- conversion(type,fcn->dimlimit[ind]);
-}
+++ /dev/null
-#ifndef NORCSID
-# define RCS_SYMB "$Header$"
-#endif
-
-#define NIL 0
-#define TRUE 1
-#define FALSE 0
-
-#define DEFAULTTYPE 500
-#define INTTYPE 501
-#define FLOATTYPE 502
-#define DOUBLETYPE 503
-#define STRINGTYPE 504
-
-#define ABSSYM 520
-#define ASCSYM 521
-#define ATNSYM 522
-#define CDBLSYM 524
-#define CHRSYM 525
-#define CINTSYM 526
-#define COSSYM 527
-#define CSNGSYM 528
-#define CVISYM 529
-#define CVSSYM 530
-#define CVDSYM 531
-#define EOFSYM 532
-#define EXPSYM 533
-#define FIXSYM 534
-#define FRESYM 535
-#define HEXSYM 536
-#define INPSYM 538
-#define INSTRSYM 539
-#define LEFTSYM 540
-#define LENSYM 541
-#define LOCSYM 542
-#define LOGSYM 543
-#define LPOSSYM 544
-#define MKISYM 546
-#define MKSSYM 547
-#define MKDSYM 548
-#define OCTSYM 549
-#define PEEKSYM 550
-#define POSSYM 551
-#define RIGHTSYM 552
-#define RNDSYM 553
-#define SGNSYM 554
-#define SINSYM 555
-#define SPACESYM 556
-#define SPCSYM 557
-#define SQRSYM 558
-#define STRSYM 559
-#define STRINGSYM 560
-#define TABSYM 561
-#define TANSYM 562
-#define VALSYM 564
-#define VARPTRSYM 565
-/* some stuff forgotten */
-#define INTSYM 567
-#define AUTOSYM 568
-#define LISTSYM 569
-#define LOADSYM 570
-#define MERGESYM 571
-#define TRONSYM 572
-#define TROFFSYM 573
-#define XORSYM 574
-#define EQVSYM 575
-#define IMPSYM 576
-#define OUTSYM 577
-
-#define MAXDIMENSIONS 10
-
-typedef struct SYMBOL{
- char *symname;
- int symalias;
- int symtype;
- int dimensions; /* dimension array/function */
- int dimlimit[MAXDIMENSIONS]; /* type of parameter */
- int dimalias[MAXDIMENSIONS];
- struct SYMBOL *nextsym;
- int isfunction;
- int parmsize;
- int isparam;
-} Symbol;
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#define abs(X) (X>=0?X:-X)
-/* Miscelaneous routines can be found here */
-
-int errorcnt;
-
-warning(str)
-char *str;
-{
- printf("WARNING:%s\n",str);
-}
-error(str)
-char *str;
-{
- extern int listing,yylineno;
- if( !listing) printf("LINE %d:",yylineno);
- printf("ERROR:%s\n",str);
- errorcnt++;
-}
-fatal(str)
-char *str;
-{
- printf("FATAL:%s\n",str);
- exit(-1);
-}
-notyetimpl()
-{
- printf("WARNING: not yet implemented\n");
-}
-illegalcmd()
-{
- printf("WARNING: illegal command\n");
-}
-char *itoa(i)
-int i;
-{
- static char buf[30];
- sprintf(buf,"%d",i);
- return(buf);
-}
-char *instrlabel(i)
-int i;
-{
- static char buf[30];
- sprintf(buf,"*%d",i);
- return(buf);
-}
-char *datalabel(i)
-int i;
-{
- static char buf[30];
- if( i>0)
- sprintf(buf,"l%d",i);
- else sprintf(buf,"%d",-i);
- return(buf);
-}
-
-char *salloc(length)
-int length;
-{
- char *s,*c;
- extern char *malloc() ;
- s=c= malloc(length);
- while(length-->0)*c++ =0;
- return(s);
-}
-
-char * proclabel(str)
-char *str;
-{
- static char buf[50];
- sprintf(buf,"$%s",str);
- return(buf);
-}
+++ /dev/null
-#include "bem.h"
-
-#ifndef NORSCID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* Author: M.L. Kersten
-** yywrap is called upon encountering endoffile on yyin.
-** when more input files are present, it moves to the next
-** otherwise -1 is returned and simultaneous endofinput is set
-*/
-int endofinput =0;
-
-
-yywrap()
-{
- if( fclose(yyin) == EOF)
- fatal("fclose problems ");
- /* check for next input file */
- return(-1);
-}
+++ /dev/null
-tail_pc.a
-abi.c
-abl.c
-abr.c
-arg.c
-ass.c
-asz.c
-atn.c
-bcp.c
-bts.e
-buff.c
-clock.c
-diag.c
-dis.c
-efl.c
-eln.c
-encaps.e
-exp.c
-get.c
-gto.e
-hlt.c
-ini.c
-catch.c
-log.c
-mdi.c
-mdl.c
-new.c
-nobuff.c
-notext.c
-opn.c
-hol0.e
-pac.c
-pclose.c
-pcreat.c
-pentry.c
-perrno.c
-pexit.c
-popen.c
-cls.c
-put.c
-rdc.c
-rdl.c
-rdr.c
-rdi.c
-rln.c
-rf.c
-rnd.c
-sav.e
-sig.e
-sin.c
-sqt.c
-fef.e
-string.c
-trap.e
-unp.c
-uread.c
-uwrite.c
-wdw.c
-incpt.c
-wrc.c
-wrf.c
-wri.c
-wrl.c
-wrr.c
-cvt.c
-fif.e
-wrz.c
-wrs.c
-outcpt.c
-wf.c
-trp.e
+++ /dev/null
-# $Header$
-
-head:
- echo This Makefile needs arguments
-
-distr:
- rm `head -1 LIST`; arch cr `head -1 LIST` `tail +2 LIST`
-
-clean:
- rm -f *.old
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile *.[ec]
+++ /dev/null
-problems:
-- names of system call routines may clash with user routines
-- some modules in Pascal?
-- ttyio, stdio, pasio, unixio
-- mention all external references
-- list of routines and partitioning
-- size of sizes in asz,bcp,dis,new,opn,pac,unp: int or long ?
-
-NOTE:
-The run files in mach/*/libpc show the actual usage of this
-library.
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-int _abi(i) int i; {
- return(i>=0 ? i : -i);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-long _abl(i) long i; {
- return(i>=0 ? i : -i);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-double _abr(r) double r; {
- return(r>=0 ? r : -r);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-/*
-/* function argc:integer; extern; */
-/* function argv(i:integer):string; extern; */
-/* procedure argshift; extern; */
-/* function environ(i:integer):string; extern; */
-
-extern int _pargc;
-extern char **_pargv;
-extern char **_penvp;
-
-int argc() {
- return(_pargc);
-}
-
-char *argv(i) {
- if (i >= _pargc)
- return(0);
- return(_pargv[i]);
-}
-
-argshift() {
-
- if (_pargc > 1) {
- --_pargc;
- _pargv++;
- }
-}
-
-char *environ(i) {
- char **p; char *q;
-
- if (p = _penvp)
- while (q = *p++)
- if (i-- < 0)
- return(q);
- return(0);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <em_abs.h>
-#include <pc_err.h>
-
-extern char *_hol0();
-extern _trp();
-
-_ass(line,bool) int line,bool; {
-
- if (bool==0) {
- LINO = line;
- _trp(EASS);
- }
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-struct descr {
- int low;
- int diff;
- int size;
-};
-
-int _asz(dp) struct descr *dp; {
- return(dp->size * (dp->diff + 1));
-}
+++ /dev/null
-/* $Header$ */
-
-/*
- floating-point arctangent
-
- atan returns the value of the arctangent of its
- argument in the range [-pi/2,pi/2].
-
- there are no error returns.
-
- coefficients are #5077 from Hart & Cheney. (19.56D)
-*/
-
-
-static double sq2p1 = 2.414213562373095048802e0;
-static double sq2m1 = .414213562373095048802e0;
-static double pio2 = 1.570796326794896619231e0;
-static double pio4 = .785398163397448309615e0;
-static double p4 = .161536412982230228262e2;
-static double p3 = .26842548195503973794141e3;
-static double p2 = .11530293515404850115428136e4;
-static double p1 = .178040631643319697105464587e4;
-static double p0 = .89678597403663861959987488e3;
-static double q4 = .5895697050844462222791e2;
-static double q3 = .536265374031215315104235e3;
-static double q2 = .16667838148816337184521798e4;
-static double q1 = .207933497444540981287275926e4;
-static double q0 = .89678597403663861962481162e3;
-
-/*
- xatan evaluates a series valid in the
- range [-0.414...,+0.414...].
-*/
-
-static double
-xatan(arg)
-double arg;
-{
- double argsq;
- double value;
-
- argsq = arg*arg;
- value = ((((p4*argsq + p3)*argsq + p2)*argsq + p1)*argsq + p0);
- value = value/(((((argsq + q4)*argsq + q3)*argsq + q2)*argsq + q1)*argsq + q0);
- return(value*arg);
-}
-
-static double
-satan(arg)
-double arg;
-{
- if(arg < sq2m1)
- return(xatan(arg));
- else if(arg > sq2p1)
- return(pio2 - xatan(1/arg));
- else
- return(pio4 + xatan((arg-1)/(arg+1)));
-}
-
-
-/*
- atan makes its argument positive and
- calls the inner routine satan.
-*/
-
-double
-_atn(arg)
-double arg;
-{
- if(arg>0)
- return(satan(arg));
- else
- return(-satan(-arg));
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-int _bcp(sz,y,x) int sz; char *y,*x; {
-
- while (--sz >= 0) {
- if (*x < *y)
- return(-1);
- if (*x++ > *y++)
- return(1);
- }
- return(0);
-}
+++ /dev/null
-#
-; $Header$
-;
-; (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: J.W. Stevenson */
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define SIZE 0
-#define HIGH EM_WSIZE
-#define LOWB 2*EM_WSIZE
-#define BASE 3*EM_WSIZE
-
-; _bts is called with four parameters:
-; - the initial set (BASE)
-; - low bound of range of bits (LOWB)
-; - high bound of range of bits (HIGH)
-; - set size in bytes (SIZE)
-
- exp $_bts
- pro $_bts,0
- lal BASE ; address of initial set
- lol SIZE
- los EM_WSIZE ; load initial set
-1
- lol LOWB ; low bound
- lol HIGH ; high bound
- bgt *2 ; while low <= high
- lol LOWB
- lol SIZE
- set ? ; create [low]
- lol SIZE
- ior ? ; merge with initial set
- inl LOWB ; increment low bound
- bra *1 ; loop back
-2
- lal BASE
- lol SIZE
- sts EM_WSIZE ; store result over initial set
- ret 0
- end ?
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _flush();
-
-/* procedure buff(var f:file of ?); */
-
-buff(f) struct file *f; {
- int sz;
-
- if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
- return;
- _flush(f);
- sz = f->size;
- f->count = f->buflen = (sz>512 ? sz : 512-512%sz);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <em_abs.h>
-#include <em_path.h>
-#include <pc_file.h>
-
-#define MESLEN 30
-#define PATHLEN 100
-
-extern struct file *_curfil;
-
-extern int _pargc;
-extern char **_pargv;
-extern char **_penvp;
-
-extern char *_hol0();
-extern _trp();
-extern exit();
-extern int open();
-extern int read();
-extern int write();
-
-/* Modified not to use a table of indices any more. This circumvents yet
- another point where byte order in words would make you lose.
- */
-
-_catch(erno) unsigned erno; {
- char *p,*q,**qq;
- unsigned i;
- int fd;
- char *pp[8];
- char mes[MESLEN];
- char filename[PATHLEN];
- char c;
-
- qq = pp;
- if (p = FILN)
- *qq++ = p;
- else
- *qq++ = _pargv[0];
- p = &("xxxxx: "[5]);
- if (i = LINO) {
- *qq++ = ", ";
- do
- *--p = i % 10 + '0';
- while (i /= 10);
- }
- *qq++ = p;
- if ((erno & ~037) == 0140 && (_curfil->flags&0377)==MAGIC) {
- /* file error */
- *qq++ = "file ";
- *qq++ = _curfil->fname;
- *qq++ = ": ";
- }
- if ( (i=strtobuf(EM_DIR,filename,PATHLEN)) >= PATHLEN-1 ||
- (filename[i]='/' ,
- strtobuf(RTERR_PATH,filename+i+1,PATHLEN-i-1) >= PATHLEN-i-1
- ) )
- goto error;
- if ((fd=open(filename,0))<0)
- goto error;
- /* skip to correct message */
- for(i=0;i<erno;i++)
- do if (read(fd,&c,1)!=1)
- goto error;
- while (c!= '\n');
- if(read(fd,mes,MESLEN-1)<=0)
- goto error;
- mes[MESLEN-1]=0;
- for(i=0;i<MESLEN-1;i++)
- if(mes[i]=='\n')
- mes[i+1]=0;
- *qq++ = mes;
- *qq = 0;
- qq = pp;
- while (q = *qq++) {
- p = q;
- while (*p)
- p++;
- if (write(2,q,p-q) < 0)
- ;
- }
- exit(erno);
-error:
- _trp(erno);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-/* function clock:integer; extern; */
-
-extern int times();
-
-struct tbuf {
- long utime;
- long stime;
- long cutime;
- long cstime;
-};
-
-int clock() {
- struct tbuf t;
-
- times(&t);
- return( (t.utime + t.stime) & 077777);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern struct file *_curfil;
-extern _trp();
-extern _flush();
-extern _outcpt();
-extern int close();
-
-_xcls(f) struct file *f; {
-
- if ((f->flags & WRBIT) == 0)
- return;
- if ((f->flags & (TXTBIT|ELNBIT)) == TXTBIT) {
-#ifdef CPM
- *f->ptr = '\r';
- _outcpt(f);
-#endif
- *f->ptr = '\n';
- _outcpt(f);
- }
- _flush(f);
-}
-
-_cls(f) struct file *f; {
-#ifdef MAYBE
- char *p;
-#endif
-
- _curfil = f;
- if ((f->flags&0377) != MAGIC)
- return;
-#ifdef MAYBE
- p = f->bufadr;
- if (f->ptr < p)
- return;
- if (f->buflen <= 0)
- return;
- p += f->buflen;
- if (f->ptr >= p)
- return;
-#endif
- _xcls(f);
- if (close(f->ufd) != 0)
- _trp(ECLOSE);
- f->flags = 0;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-extern double _fif();
-
-/*
- * _ecvt converts to decimal
- * the number of digits is specified by ndigit
- * decpt is set to the position of the decimal point
- * sign is set to 0 for positive, 1 for negative
- */
-
-#define NDIG 80
-
-static char*
-cvt(arg, ndigits, decpt, sign, eflag)
-double arg;
-int ndigits, *decpt, *sign, eflag;
-{
- register int r2;
- double fi, fj;
- register char *p, *p1;
- static char buf[NDIG];
- int i; /*!*/
-
- if (ndigits<0)
- ndigits = 0;
- if (ndigits>=NDIG-1)
- ndigits = NDIG-2;
- r2 = 0;
- *sign = 0;
- p = &buf[0];
- if (arg<0) {
- *sign = 1;
- arg = -arg;
- }
- arg = _fif(arg, 1.0, &fi);
- /*
- * Do integer part
- */
- if (fi != 0) {
- p1 = &buf[NDIG];
- while (fi != 0) {
- i = (_fif(fi, 0.1, &fi) + 0.03) * 10;
- *--p1 = i + '0';
- r2++;
- }
- while (p1 < &buf[NDIG])
- *p++ = *p1++;
- } else if (arg > 0) {
- while ((fj = arg*10) < 1) {
- arg = fj;
- r2--;
- }
- }
- p1 = &buf[ndigits];
- if (eflag==0)
- p1 += r2;
- *decpt = r2;
- if (p1 < &buf[0]) {
- buf[0] = '\0';
- return(buf);
- }
- while (p<=p1 && p<&buf[NDIG]) {
- arg = _fif(arg, 10.0, &fj);
- i = fj;
- *p++ = i + '0';
- }
- if (p1 >= &buf[NDIG]) {
- buf[NDIG-1] = '\0';
- return(buf);
- }
- p = p1;
- *p1 += 5;
- while (*p1 > '9') {
- *p1 = '0';
- if (p1>buf) {
- p1--; *p1 += 1;
- } else {
- *p1 = '1';
- (*decpt)++;
- if (eflag==0) {
- if (p>buf)
- *p = '0';
- p++;
- }
- }
- }
- *p = '\0';
- return(buf);
-}
-
-char*
-_ecvt(arg, ndigits, decpt, sign)
-double arg;
-int ndigits, *decpt, *sign;
-{
- return(cvt(arg, ndigits, decpt, sign, 1));
-}
-
-char*
-_fcvt(arg, ndigits, decpt, sign)
-double arg;
-int ndigits, *decpt, *sign;
-{
- return(cvt(arg, ndigits, decpt, sign, 0));
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-/* procedure diag(var f:text); */
-
-diag(f) struct file *f; {
-
- f->ptr = f->bufadr;
- f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
- f->fname = "DIAG";
- f->ufd = 2;
- f->size = 1;
- f->count = 1;
- f->buflen = 1;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_err.h>
-
-#define assert() /* nothing */
-
-/*
- * use circular list of free blocks from low to high addresses
- * _highp points to free block with highest address
- */
-struct adm {
- struct adm *next;
- int size;
-};
-
-extern struct adm *_lastp;
-extern struct adm *_highp;
-extern _trp();
-
-static int merge(p1,p2) struct adm *p1,*p2; {
- struct adm *p;
-
- p = (struct adm *)((char *)p1 + p1->size);
- if (p > p2)
- _trp(EFREE);
- if (p != p2)
- return(0);
- p1->size += p2->size;
- p1->next = p2->next;
- return(1);
-}
-
-_dis(n,pp) int n; struct adm **pp; {
- struct adm *p1,*p2;
-
- /*
- * NOTE: dispose only objects whose size is a multiple of sizeof(*pp).
- * this is always true for objects allocated by _new()
- */
- n = ((n+sizeof(*p1)-1) / sizeof(*p1)) * sizeof(*p1);
- if (n == 0)
- return;
- if ((p1= *pp) == (struct adm *) 0)
- _trp(EFREE);
- p1->size = n;
- if ((p2 = _highp) == 0) /*p1 is the only free block*/
- p1->next = p1;
- else {
- if (p2 > p1) {
- /*search for the preceding free block*/
- if (_lastp < p1) /*reduce search*/
- p2 = _lastp;
- while (p2->next < p1)
- p2 = p2->next;
- }
- /* if p2 preceeds p1 in the circular list,
- * try to merge them */
- p1->next = p2->next; p2->next = p1;
- if (p2 <= p1 && merge(p2,p1))
- p1 = p2;
- p2 = p1->next;
- /* p1 preceeds p2 in the circular list */
- if (p2 > p1) merge(p1,p2);
- }
- if (p1 >= p1->next)
- _highp = p1;
- _lastp = p1;
- *pp = (struct adm *) 0;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern struct file *_curfil;
-extern _trp();
-extern _incpt();
-
-int _efl(f) struct file *f; {
-
- _curfil = f;
- if ((f->flags & 0377) != MAGIC)
- _trp(EBADF);
- if ((f->flags & (WINDOW|WRBIT|EOFBIT)) == 0)
- _incpt(f);
- return((f->flags & EOFBIT) != 0);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern _trp();
-extern _rf();
-
-int _eln(f) struct file *f; {
-
- _rf(f);
- if (f->flags & EOFBIT)
- _trp(EEOF);
- return((f->flags & ELNBIT) != 0);
-}
+++ /dev/null
-#
-
-
-; $Header$
-; (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
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-; procedure encaps(procedure p; procedure(q(n:integer));
-; {call q if a trap occurs during the execution of p}
-; {if q returns, continue execution of p}
-
-
- inp $handler
-
-#define PIISZ 2*EM_PSIZE
-
-#define PARG 0
-#define QARG PIISZ
-#define E_ELB -EM_PSIZE
-#define E_EHA -2*EM_PSIZE
-
-; encaps is called with two parameters:
-; - procedure instance identifier of q (QARG)
-; - procedure instance identifier of p (PARG)
-; and two local variables:
-; - the lb of the previous encaps (E_ELB)
-; - the procedure identifier of the previous handler (E_EHA)
-;
-; One static variable:
-; - the lb of the currently active encaps (enc_lb)
-
-enc_lb
- bss EM_PSIZE,0,0
-
- exp $encaps
- pro $encaps,PIISZ
- ; save lb of previous encaps
- lae enc_lb
- loi EM_PSIZE
- lal E_ELB
- sti EM_PSIZE
- ; set new lb
- lxl 0
- lae enc_lb
- sti EM_PSIZE
- ; save old handler id while setting up the new handler
- lpi $handler
- sig
- lal E_EHA
- sti EM_PSIZE
- ; handler is ready, p can be called
- ; p doesn't expect parameters except possibly the static link
- ; always passing the link won't hurt
- lal PARG
- loi PIISZ
- cai
- asp EM_PSIZE
- ; reinstate old handler
- lal E_ELB
- loi EM_PSIZE
- lae enc_lb
- sti EM_PSIZE
- lal E_EHA
- loi EM_PSIZE
- sig
- asp EM_PSIZE
- ret 0
- end ?
-
-#define TRAP 0
-#define H_ELB -EM_PSIZE
-
-; handler is called with one parameter:
-; - trap number (TRAP)
-; one local variable
-; - the current LB of the enclosing encaps (H_ELB)
-
-
- pro $handler,EM_PSIZE
- ; save LB of nearest encaps
- lae enc_lb
- loi EM_PSIZE
- lal H_ELB
- sti EM_PSIZE
- ; fetch setting for previous encaps via LB of nearest
- lal H_ELB
- loi EM_PSIZE
- adp E_ELB
- loi EM_PSIZE ; LB of previous encaps
- lae enc_lb
- sti EM_PSIZE
- lal H_ELB
- loi EM_PSIZE
- adp E_EHA
- loi EM_PSIZE ; previous handler
- sig
- asp EM_PSIZE
- ; previous handler is re-instated, time to call Q
- lol TRAP ; the one and only real parameter
- lal H_ELB
- loi EM_PSIZE
- lpb ; argument base of enclosing encaps
- adp QARG
- loi PIISZ
- exg EM_PSIZE
- dup EM_PSIZE ; The static link is now on top
- zer EM_PSIZE
- cmp
- zeq *1
- ; non-zero LB
- exg EM_PSIZE
- cai
- asp EM_WSIZE+EM_PSIZE
- bra *2
-1
- ; zero LB
- asp EM_PSIZE
- cai
- asp EM_WSIZE
-2
- ; now reinstate handler for continued execution of p
- lal H_ELB
- loi EM_PSIZE
- lae enc_lb
- sti EM_PSIZE
- lpi $handler
- sig
- asp EM_PSIZE
- rtt
- end ?
+++ /dev/null
-/* $Header$ */
-
-#include <pc_err.h>
-
-extern double _fif();
-extern double _fef();
-extern _trp();
-
-/*
- exp returns the exponential function of its
- floating-point argument.
-
- The coefficients are #1069 from Hart and Cheney. (22.35D)
-*/
-
-#define HUGE 1.701411733192644270e38
-
-static double p0 = .2080384346694663001443843411e7;
-static double p1 = .3028697169744036299076048876e5;
-static double p2 = .6061485330061080841615584556e2;
-static double q0 = .6002720360238832528230907598e7;
-static double q1 = .3277251518082914423057964422e6;
-static double q2 = .1749287689093076403844945335e4;
-static double log2e = 1.4426950408889634073599247;
-static double sqrt2 = 1.4142135623730950488016887;
-static double maxf = 10000.0;
-
-static double
-floor(d)
-double d;
-{
- if (d<0) {
- d = -d;
- if (_fif(d, 1.0, &d) != 0)
- d += 1;
- d = -d;
- } else
- _fif(d, 1.0, &d);
- return(d);
-}
-
-static double
-ldexp(fr,exp)
-double fr;
-int exp;
-{
- int neg,i;
-
- neg = 1;
- if (fr < 0) {
- fr = -fr;
- neg = -1;
- }
- fr = _fef(fr, &i);
- /*
- while (fr < 0.5) {
- fr *= 2;
- exp--;
- }
- */
- exp += i;
- if (exp > 127) {
- _trp(EEXP);
- return(neg * HUGE);
- }
- if (exp < -127)
- return(0);
- while (exp > 14) {
- fr *= (1<<14);
- exp -= 14;
- }
- while (exp < -14) {
- fr /= (1<<14);
- exp += 14;
- }
- if (exp > 0)
- fr *= (1<<exp);
- if (exp < 0)
- fr /= (1<<(-exp));
- return(neg * fr);
-}
-
-double
-_exp(arg)
-double arg;
-{
- double fract;
- double temp1, temp2, xsq;
- int ent;
-
- if(arg == 0)
- return(1);
- if(arg < -maxf)
- return(0);
- if(arg > maxf) {
- _trp(EEXP);
- return(HUGE);
- }
- arg *= log2e;
- ent = floor(arg);
- fract = (arg-ent) - 0.5;
- xsq = fract*fract;
- temp1 = ((p2*xsq+p1)*xsq+p0)*fract;
- temp2 = ((xsq+q2)*xsq+q1)*xsq + q0;
- return(ldexp(sqrt2*(temp2+temp1)/(temp2-temp1), ent));
-}
+++ /dev/null
-#
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define FARG 0
-#define ERES EM_DSIZE
-
-; _fef is called with two parameters:
-; - address of exponent result (ERES)
-; - floating point number to be split (FARG)
-; and returns an EM_DSIZE-byte floating point number
-
- exp $_fef
- pro $_fef,0
- lal FARG
- loi EM_DSIZE
- fef EM_DSIZE
- lal ERES
- loi EM_PSIZE
- sti EM_WSIZE
- ret EM_DSIZE
- end ?
+++ /dev/null
-#
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define ARG1 0
-#define ARG2 EM_DSIZE
-#define IRES 2*EM_DSIZE
-
-; _fif is called with three parameters:
-; - address of integer part result (IRES)
-; - float two (ARG2)
-; - float one (ARG1)
-; and returns an EM_DSIZE-byte floating point number
-
- exp $_fif
- pro $_fif,0
- lal 0
- loi 2*EM_DSIZE
- fif EM_DSIZE
- lal IRES
- loi EM_PSIZE
- sti EM_DSIZE
- ret EM_DSIZE
- end ?
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-#include <pc_err.h>
-
-extern _rf();
-extern _trp();
-
-_get(f) struct file *f; {
-
- _rf(f);
- if (f->flags&EOFBIT)
- _trp(EEOF);
- f->flags &= ~WINDOW;
-}
+++ /dev/null
-#
-; $Header$
-; (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: J.W. Stevenson */
-
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define TARLB 0
-#define DESCR EM_PSIZE
-
-#define NEWPC 0
-#define SAVSP EM_PSIZE
-
-#define D_PC 0
-#define D_SP EM_PSIZE
-#define D_LB EM_PSIZE+EM_PSIZE
-
-#define LOCLB -EM_PSIZE
-
-; _gto is called with two arguments:
-; - pointer to the label descriptor (DESCR)
-; - local base (LB) of target procedure (TARLB)
-; the label descriptor contains two items:
-; - label address i.e. new PC (NEWPC)
-; - offset in target procedure frame (SAVSP)
-; using this offset and the LB of the target procedure, the address of
-; of local variable of the target procedure is constructed.
-; the target procedure must have stored the correct target SP there.
-
-descr
- bss 3*EM_PSIZE,0,0
-
- exp $_gto
- pro $_gto,EM_PSIZE
- lal DESCR
- loi EM_PSIZE
- adp NEWPC
- loi EM_PSIZE
- lae descr+D_PC
- sti EM_PSIZE
- lal TARLB
- loi EM_PSIZE
- zer EM_PSIZE
- cmp
- zeq *1
- lal TARLB
- loi EM_PSIZE
- bra *2
-1
- lae _m_lb
- loi EM_PSIZE
-2
- lal LOCLB
- sti EM_PSIZE
- lal LOCLB
- loi EM_PSIZE
- lal DESCR
- loi EM_PSIZE
- adp SAVSP
- loi EM_WSIZE ; or EM_PSIZE ?
- ads EM_WSIZE ; or EM_PSIZE ?
- loi EM_PSIZE
- lae descr+D_SP
- sti EM_PSIZE
- lal LOCLB
- loi EM_PSIZE
- lae descr+D_LB
- sti EM_PSIZE
- gto descr
- end ?
+++ /dev/null
-#
-; $Header$
- mes 2,EM_WSIZE,EM_PSIZE
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern char *_hbase;
-extern int *_extfl;
-extern _cls();
-extern exit();
-
-_hlt(ecode) int ecode; {
- int i;
-
- for (i = 1; i <= _extfl[0]; i++)
- if (_extfl[i] != -1)
- _cls(EXTFL(i));
- exit(ecode);
-}
+++ /dev/null
-#
-
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-; _hol0 return the address of the ABS block (hol0)
-
- exp $_hol0
- pro $_hol0,0
- lae 0
- ret EM_PSIZE
- end ?
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-#define EINTR 4
-
-extern int errno;
-extern _trp();
-extern int read();
-
-_incpt(f) struct file *f; {
-
- if (f->flags & EOFBIT)
- _trp(EEOF);
- f->flags |= WINDOW;
- f->flags &= ~ELNBIT;
-#ifdef CPM
- do {
-#endif
- f->ptr += f->size;
- if (f->count == 0) {
- f->ptr = f->bufadr;
- for(;;) {
- f->count=read(f->ufd,f->bufadr,f->buflen);
- if ( f->count<0 ) {
- if (errno != EINTR) _trp(EREAD) ;
- continue ;
- }
- break ;
- }
- if (f->count == 0) {
- f->flags |= EOFBIT;
- *f->ptr = '\0';
- return;
- }
- }
- if ((f->count -= f->size) < 0)
- _trp(EFTRUNC);
-#ifdef CPM
- } while ((f->flags&TXTBIT) && *f->ptr == '\r');
-#endif
- if (f->flags & TXTBIT) {
- if (*f->ptr & 0200)
- _trp(EASCII);
- if (*f->ptr == '\n') {
- f->flags |= ELNBIT;
- *f->ptr = ' ';
- }
-#ifdef CPM
- if (*f->ptr == 26) {
- f->flags |= EOFBIT;
- *f->ptr = 0;
- }
-#endif
- }
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern (*_sig())();
-extern _catch();
-#ifndef CPM
-extern int ioctl();
-#endif
-
-char *_hbase;
-int *_extfl;
-char *_m_lb; /* LB of m_a_i_n */
-struct file *_curfil; /* points to file struct in case of errors */
-int _pargc;
-char **_pargv;
-char **_penvp;
-
-_ini(args,hb,p,mainlb) char *args,*hb,*mainlb; int *p; {
- struct file *f;
- char buf[6];
-
- _pargc= *(int *)args; args += sizeof (int);
- _pargv= *(char ***)args; args += sizeof (char **);
- _penvp= *(char ***)args;
- _sig(_catch);
- _extfl = p;
- _hbase = hb;
- _m_lb = mainlb;
- if (_extfl[1] != -1) {
- f = EXTFL(1);
- f->ptr = f->bufadr;
- f->flags = MAGIC|TXTBIT;
- f->fname = "INPUT";
- f->ufd = 0;
- f->size = 1;
- f->count = 0;
- f->buflen = 512;
- }
- if (_extfl[2] != -1) {
- f = EXTFL(2);
- f->ptr = f->bufadr;
- f->flags = MAGIC|TXTBIT|WRBIT|EOFBIT|ELNBIT;
- f->fname = "OUTPUT";
- f->ufd = 1;
- f->size = 1;
-#ifdef CPM
- f->count = 1;
-#else
- f->count = (ioctl(1,(('t'<<8)|8),buf) == 0 ? 1 : 512);
-#endif
- f->buflen = f->count;
- }
-}
+++ /dev/null
-/* $Header$ */
-
-#include <pc_err.h>
-
-extern double _fef();
-extern _trp();
-
-/*
- log returns the natural logarithm of its floating
- point argument.
-
- The coefficients are #2705 from Hart & Cheney. (19.38D)
-
- It calls _fef.
-*/
-
-#define HUGE 1.701411733192644270e38
-
-static double log2 = 0.693147180559945309e0;
-static double sqrto2 = 0.707106781186547524e0;
-static double p0 = -.240139179559210510e2;
-static double p1 = 0.309572928215376501e2;
-static double p2 = -.963769093368686593e1;
-static double p3 = 0.421087371217979714e0;
-static double q0 = -.120069589779605255e2;
-static double q1 = 0.194809660700889731e2;
-static double q2 = -.891110902798312337e1;
-
-double
-_log(arg)
-double arg;
-{
- double x,z, zsq, temp;
- int exp;
-
- if(arg <= 0) {
- _trp(ELOG);
- return(-HUGE);
- }
- x = _fef(arg,&exp);
- /*
- while(x < 0.5) {
- x =* 2;
- exp--;
- }
- */
- if(x<sqrto2) {
- x *= 2;
- exp--;
- }
-
- z = (x-1)/(x+1);
- zsq = z*z;
-
- temp = ((p3*zsq + p2)*zsq + p1)*zsq + p0;
- temp = temp/(((zsq + q2)*zsq + q1)*zsq + q0);
- temp = temp*z + exp*log2;
- return(temp);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_err.h>
-
-extern _trp();
-
-int _mdi(j,i) int j,i; {
-
- if (j <= 0)
- _trp(EMOD);
- i = i % j;
- if (i < 0)
- i += j;
- return(i);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_err.h>
-
-extern _trp();
-
-long _mdl(j,i) long j,i; {
-
- if (j <= 0)
- _trp(EMOD);
- i = i % j;
- if (i < 0)
- i += j;
- return(i);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-extern _sav();
-extern _rst();
-
-#define assert() /* nothing */
-#define UNDEF 0x8000
-
-struct adm {
- struct adm *next;
- int size;
-};
-
-struct adm *_lastp = 0;
-struct adm *_highp = 0;
-
-_new(n,pp) int n; struct adm **pp; {
- struct adm *p,*q;
-
- n = ((n+sizeof(*p)-1) / sizeof(*p)) * sizeof(*p);
- if ((p = _lastp) != 0)
- do {
- q = p->next;
- if (q->size >= n) {
- assert(q->size%sizeof(adm) == 0);
- if ((q->size -= n) == 0) {
- if (p == q)
- p = 0;
- else
- p->next = q->next;
- if (q == _highp)
- _highp = p;
- }
- _lastp = p;
- p = (struct adm *)((char *)q + q->size);
- q = (struct adm *)((char *)p + n);
- goto initialize;
- }
- p = q;
- } while (p != _lastp);
- /*no free block big enough*/
- _sav(&p);
- q = (struct adm *)((char *)p + n);
- _rst(&q);
-initialize:
- *pp = p;
- while (p < q)
- *((int *)p)++ = UNDEF;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _flush();
-
-/* procedure nobuff(var f:file of ?); */
-
-nobuff(f) struct file *f; {
-
- if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT))
- return;
- _flush(f);
- f->count = f->buflen = f->size;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-notext(f) struct file *f; {
- f->flags &= ~TXTBIT;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern char *_hbase;
-extern int *_extfl;
-extern struct file *_curfil;
-extern int _pargc;
-extern char **_pargv;
-extern char **_penvp;
-
-extern _cls();
-extern _xcls();
-extern _trp();
-extern int getpid();
-extern int creat();
-extern int open();
-extern int close();
-extern int unlink();
-extern long lseek();
-
-static int tmpfil() {
- int i; char *p,*q;
-
- i = getpid();
- p = "/usr/tmp/plf.xxxxx";
- q = p + 13;
- do
- *q++ = (i & 07) + '0';
- while (i >>= 3);
- *q = '\0';
- if ((i = creat(p,0644)) < 0)
- if ((i = creat(p += 4,0644)) < 0)
- if ((i = creat(p += 5,0644)) < 0)
- goto error;
- if (close(i) != 0)
- goto error;
- if ((i = open(p,2)) < 0)
- goto error;
- if (unlink(p) != 0)
-error: _trp(EREWR);
- return(i);
-}
-
-static int initfl(descr,sz,f) int descr; int sz; struct file *f; {
- int i;
-
- _curfil = f;
- if (sz == 0) {
- sz++;
- descr |= TXTBIT;
- }
- for (i=1; i<=_extfl[0]; i++)
- if (f == EXTFL(i))
- break;
- if (i > _extfl[0]) { /* local file */
- f->fname = "LOCAL";
- if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC) {
- _xcls(f);
- if (lseek(f->ufd,(long)0,0) == -1)
- _trp(ERESET);
- } else {
- _cls(f);
- f->ufd = tmpfil();
- }
- } else { /* external file */
- if ((i -= 2) <= 0)
- return(0);
- if (i >= _pargc)
- _trp(EARGC);
- f->fname = _pargv[i];
- _cls(f);
- if ((descr & WRBIT) == 0) {
- if ((f->ufd = open(f->fname,0)) < 0)
- _trp(ERESET);
- } else {
- if ((f->ufd = creat(f->fname,0644)) < 0)
- _trp(EREWR);
- }
- }
- f->buflen = (sz>512 ? sz : 512-512%sz);
- f->size = sz;
- f->ptr = f->bufadr;
- f->flags = descr;
- return(1);
-}
-
-_opn(sz,f) int sz; struct file *f; {
-
- if (initfl(MAGIC,sz,f))
- f->count = 0;
-}
-
-_cre(sz,f) int sz; struct file *f; {
-
- if (initfl(WRBIT|EOFBIT|ELNBIT|MAGIC,sz,f))
- f->count = f->buflen;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-#define EINTR 4
-
-extern int errno;
-extern _trp();
-extern int write();
-
-_flush(f) struct file *f; {
- int i,n;
-
- f->ptr = f->bufadr;
- n = f->buflen - f->count;
- if (n <= 0)
- return;
- f->count = f->buflen;
- if ((i = write(f->ufd,f->bufadr,n)) < 0 && errno == EINTR)
- return;
- if (i != n)
- _trp(EWRITE);
-}
-
-_outcpt(f) struct file *f; {
-
- f->flags &= ~ELNBIT;
- f->ptr += f->size;
- if ((f->count -= f->size) <= 0)
- _flush(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_err.h>
-
-extern _trp();
-
-#define assert() /* nothing */
-
-struct descr {
- int low;
- int diff;
- int size;
-};
-
-_pac(ad,zd,zp,i,ap) int i; struct descr *ad,*zd; char *zp,*ap; {
-
- if (zd->diff > ad->diff ||
- (i -= ad->low) < 0 ||
- (i+zd->diff) > ad->diff)
- _trp(EPACK);
- ap += (i * ad->size);
- i = (zd->diff + 1) * zd->size;
- if (zd->size == 1) {
- assert(ad->size == 2);
- while (--i >= 0)
- *zp++ = *((int *)ap)++;
- } else {
- assert(ad->size == zd->size);
- while (--i >= 0)
- *zp++ = *ap++;
- }
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _cls();
-
-/* procedure pclose(var f:file of ??); */
-
-pclose(f) struct file *f; {
- _cls(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern _cls();
-extern _trp();
-extern int creat();
-
-/* procedure pcreat(var f:text; s:string); */
-
-pcreat(f,s) struct file *f; char *s; {
-
- _cls(f); /* initializes _curfil */
- f->ptr = f->bufadr;
- f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC;
- f->fname = s;
- f->size = 1;
- f->count = 512;
- f->buflen = 512;
- if ((f->ufd = creat(s,0644)) < 0)
- _trp(EREWR);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern int *_extfl;
-extern char *_hbase;
-extern _wrs();
-extern _wln();
-
-procentry(name) char *name; {
- struct file *f;
-
- f = EXTFL(2);
- _wrs(5,"call ",f);
- _wrs(8,name,f);
- _wln(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-/* function perrno:integer; extern; */
-
-extern int errno;
-
-int perrno() {
- return(errno);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern int *_extfl;
-extern char *_hbase;
-extern _wrs();
-extern _wln();
-
-procexit(name) char *name; {
- struct file *f;
-
- f = EXTFL(2);
- _wrs(5,"exit ",f);
- _wrs(8,name,f);
- _wln(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern _cls();
-extern _trp();
-extern int open();
-
-/* procedure popen(var f:text; s:string); */
-
-popen(f,s) struct file *f; char *s; {
-
- _cls(f); /* initializes _curfil */
- f->ptr = f->bufadr;
- f->flags = TXTBIT|MAGIC;
- f->fname = s;
- f->size = 1;
- f->count = 0;
- f->buflen = 512;
- if ((f->ufd = open(s,0)) < 0)
- _trp(ERESET);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _wf();
-extern _outcpt();
-
-_put(f) struct file *f; {
- _wf(f);
- _outcpt(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _rf();
-extern _incpt();
-
-int _rdc(f) struct file *f; {
- int c;
-
- _rf(f);
- c = *f->ptr;
- _incpt(f);
- return(c);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-#include <pc_err.h>
-
-extern _trp();
-extern _rf();
-extern _incpt();
-
-_skipsp(f) struct file *f; {
- while ((*f->ptr == ' ') || (*f->ptr == '\t'))
- _incpt(f);
-}
-
-int _getsig(f) struct file *f; {
- int sign;
-
- if ((sign = (*f->ptr == '-')) || *f->ptr == '+')
- _incpt(f);
- return(sign);
-}
-
-int _fstdig(f) struct file *f; {
- int ch;
-
- ch = *f->ptr - '0';
- if ((unsigned) ch > 9) {
- _trp(EDIGIT);
- ch = 0;
- }
- return(ch);
-}
-
-int _nxtdig(f) struct file *f; {
- int ch;
-
- _incpt(f);
- ch = *f->ptr - '0';
- if ((unsigned) ch > 9)
- return(-1);
- return(ch);
-}
-
-int _getint(f) struct file *f; {
- int signed,i,ch;
-
- signed = _getsig(f);
- ch = _fstdig(f);
- i = 0;
- do
- i = i*10 - ch;
- while ((ch = _nxtdig(f)) >= 0);
- return(signed ? i : -i);
-}
-
-int _rdi(f) struct file *f; {
- _rf(f);
- _skipsp(f);
- return(_getint(f));
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _rf();
-extern _skipsp();
-extern int _getsig();
-extern int _fstdig();
-extern int _nxtdig();
-
-long _rdl(f) struct file *f; {
- int signed,ch; long l;
-
- _rf(f);
- _skipsp(f);
- signed = _getsig(f);
- ch = _fstdig(f);
- l = 0;
- do
- l = l*10 - ch;
- while ((ch = _nxtdig(f)) >= 0);
- return(signed ? l : -l);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-#define BIG 1e17
-
-extern _rf();
-extern _incpt();
-extern _skipsp();
-extern int _getsig();
-extern int _getint();
-extern int _fstdig();
-extern int _nxtdig();
-
-static double r;
-static int pow10;
-
-static dig(ch) int ch; {
-
- if (r>BIG)
- pow10++;
- else
- r = r*10.0 + ch;
-}
-
-double _rdr(f) struct file *f; {
- int i; double e; int signed,ch;
-
- r = 0;
- pow10 = 0;
- _rf(f);
- _skipsp(f);
- signed = _getsig(f);
- ch = _fstdig(f);
- do
- dig(ch);
- while ((ch = _nxtdig(f)) >= 0);
- if (*f->ptr == '.') {
- _incpt(f);
- ch = _fstdig(f);
- do {
- dig(ch);
- pow10--;
- } while ((ch = _nxtdig(f)) >= 0);
- }
- if ((*f->ptr == 'e') || (*f->ptr == 'E')) {
- _incpt(f);
- pow10 += _getint(f);
- }
- if ((i = pow10) < 0)
- i = -i;
- e = 1.0;
- while (--i >= 0)
- e *= 10.0;
- if (pow10<0)
- r /= e;
- else
- r *= e;
- return(signed? -r : r);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-#include <pc_err.h>
-
-extern struct file *_curfil;
-extern _trp();
-extern _incpt();
-
-_rf(f) struct file *f; {
-
- _curfil = f;
- if ((f->flags&0377) != MAGIC)
- _trp(EBADF);
- if (f->flags & WRBIT)
- _trp(EREADF);
- if ((f->flags & WINDOW) == 0)
- _incpt(f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _rf();
-extern _incpt();
-
-_rln(f) struct file *f; {
-
- _rf(f);
- while ((f->flags & ELNBIT) == 0)
- _incpt(f);
- f->flags &= ~WINDOW;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-double _rnd(r) double r; {
- return(r + (r<0 ? -0.5 : 0.5));
-}
+++ /dev/null
-#
-; $Header$
-; (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: J.W. Stevenson */
-
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define PTRAD 0
-
-#define HP 2
-
-; _sav called with one parameter:
-; - address of pointer variable (PTRAD)
-
- exp $_sav
- pro $_sav,0
- lor HP
- lal PTRAD
- loi EM_PSIZE
- sti EM_PSIZE
- ret 0
- end ?
-
-; _rst is called with one parameter:
-; - address of pointer variable (PTRAD)
-
- exp $_rst
- pro $_rst,0
- lal PTRAD
- loi EM_PSIZE
- loi EM_PSIZE
- str HP
- ret 0
- end ?
+++ /dev/null
-#define PROC 0
-
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-; _sig is called with one parameter:
-; - procedure instance identifier (PROC)
-; and returns nothing.
-; only the procedure identifier inside the PROC is used.
-
- exp $_sig
- pro $_sig,0
- lal PROC
- loi EM_PSIZE
- sig
- ret 0 ; ignore the result of sig
- end ?
+++ /dev/null
-/* $Header$ */
-
-extern double _fif();
-
-/*
- C program for floating point sin/cos.
- Calls _fif.
- There are no error exits.
- Coefficients are #3370 from Hart & Cheney (18.80D).
-*/
-
-static double twoopi = 0.63661977236758134308;
-static double p0 = .1357884097877375669092680e8;
-static double p1 = -.4942908100902844161158627e7;
-static double p2 = .4401030535375266501944918e6;
-static double p3 = -.1384727249982452873054457e5;
-static double p4 = .1459688406665768722226959e3;
-static double q0 = .8644558652922534429915149e7;
-static double q1 = .4081792252343299749395779e6;
-static double q2 = .9463096101538208180571257e4;
-static double q3 = .1326534908786136358911494e3;
-
-static double
-sinus(arg, quad)
-double arg;
-int quad;
-{
- double e, f;
- double ysq;
- double x,y;
- int k;
- double temp1, temp2;
-
- x = arg;
- if(x<0) {
- x = -x;
- quad = quad + 2;
- }
- x = x*twoopi; /*underflow?*/
- if(x>32764){
- y = _fif(x, 10.0, &e);
- e = e + quad;
- _fif(0.25, e, &f);
- quad = e - 4*f;
- }else{
- k = x;
- y = x - k;
- quad = (quad + k) & 03;
- }
- if (quad & 01)
- y = 1-y;
- if(quad > 1)
- y = -y;
-
- ysq = y*y;
- temp1 = ((((p4*ysq+p3)*ysq+p2)*ysq+p1)*ysq+p0)*y;
- temp2 = ((((ysq+q3)*ysq+q2)*ysq+q1)*ysq+q0);
- return(temp1/temp2);
-}
-
-double
-_cos(arg)
-double arg;
-{
- if(arg<0)
- arg = -arg;
- return(sinus(arg, 1));
-}
-
-double
-_sin(arg)
-double arg;
-{
- return(sinus(arg, 0));
-}
+++ /dev/null
-/* $Header$ */
-
-#include <pc_err.h>
-
-extern double _fef();
-extern _trp();
-
-/*
- sqrt returns the square root of its floating
- point argument. Newton's method.
-
- calls _fef
-*/
-
-double
-_sqt(arg)
-double arg;
-{
- double x, temp;
- int exp;
- int i;
-
- if(arg <= 0) {
- if(arg < 0)
- _trp(ESQT);
- return(0);
- }
- x = _fef(arg,&exp);
- /*
- while(x < 0.5) {
- x =* 2;
- exp--;
- }
- */
- /*
- * NOTE
- * this wont work on 1's comp
- */
- if(exp & 1) {
- x *= 2;
- exp--;
- }
- temp = 0.5*(1 + x);
-
- while(exp > 28) {
- temp *= (1<<14);
- exp -= 28;
- }
- while(exp < -28) {
- temp /= (1<<14);
- exp += 28;
- }
- if(exp >= 0)
- temp *= 1 << (exp/2);
- else
- temp /= 1 << (-exp/2);
- for(i=0; i<=4; i++)
- temp = 0.5*(temp + arg/temp);
- return(temp);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-/* function strbuf(var b:charbuf):string; */
-
-char *strbuf(s) char *s; {
- return(s);
-}
-
-/* function strtobuf(s:string; var b:charbuf; blen:integer):integer; */
-
-int strtobuf(s,b,l) char *s,*b; {
- int i;
-
- i = 0;
- while (--l>=0) {
- if ((*b++ = *s++) == 0)
- break;
- i++;
- }
- return(i);
-}
-
-/* function strlen(s:string):integer; */
-
-int strlen(s) char *s; {
- int i;
-
- i = 0;
- while (*s++)
- i++;
- return(i);
-}
-
-/* function strfetch(s:string; i:integer):char; */
-
-int strfetch(s,i) char *s; {
- return(s[i-1]);
-}
-
-/* procedure strstore(s:string; i:integer; c:char); */
-
-strstore(s,i,c) char *s; {
- s[i-1] = c;
-}
+++ /dev/null
-#
-
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define TRAP 0
-
-; trap is called with one parameter:
-; - trap number (TRAP)
-
- exp $trap
- pro $trap,0
- lol TRAP
- trp
- ret 0
- end ?
+++ /dev/null
-#
-
-; $Header$
-;
-; (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
-;
-;
-
- mes 2,EM_WSIZE,EM_PSIZE
-
-#define TRAP 0
-
-; _trp() and trap() perform the same function,
-; but have to be separate. trap exists to facilitate the user.
-; _trp is there for the system, trap cannot be used for that purpose
-; because a user might define its own Pascal routine called trap.
-
-; _trp is called with one parameter:
-; - trap number (TRAP)
-
- exp $_trp
- pro $_trp,0
- lol TRAP
- trp
- ret 0
- end ?
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_err.h>
-
-extern _trp();
-
-#define assert() /* nothing */
-
-struct descr {
- int low;
- int diff;
- int size;
-};
-
-_unp(ad,zd,i,ap,zp) int i; struct descr *ad,*zd; char *ap,*zp; {
-
- if (zd->diff > ad->diff ||
- (i -= ad->low) < 0 ||
- (i+zd->diff) > ad->diff)
- _trp(EUNPACK);
- ap += (i * ad->size);
- i = (zd->diff + 1) * zd->size;
- if (zd->size == 1) {
- assert(ad->size == 2);
- while (--i >= 0)
- *((int *)ap)++ = *zp++;
- } else {
- assert(ad->size == zd->size);
- while (--i >= 0)
- *ap++ = *zp++;
- }
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-/* function uread(fd:integer; var b:buf; n:integer):integer; */
-
-extern int read();
-
-int uread(fd,b,n) char *b; int fd,n; {
- return(read(fd,b,n));
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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
- *
- */
-
-/* function uwrite(fd:integer; var b:buf; n:integer):integer; */
-
-extern int write();
-
-int uwrite(fd,b,n) char *b; int fd,n; {
- return(write(fd,b,n));
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern struct file *_curfil;
-extern _incpt();
-
-char *_wdw(f) struct file *f; {
-
- _curfil = f;
- if ((f->flags & (WINDOW|WRBIT|0377)) == MAGIC)
- _incpt(f);
- return(f->ptr);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-#include <pc_err.h>
-
-extern struct file *_curfil;
-extern _trp();
-
-_wf(f) struct file *f; {
-
- _curfil = f;
- if ((f->flags&0377) != MAGIC)
- _trp(EBADF);
- if ((f->flags & WRBIT) == 0)
- _trp(EWRITEF);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _wf();
-extern _outcpt();
-
-_wrc(c,f) int c; struct file *f; {
- *f->ptr = c;
- _wf(f);
- _outcpt(f);
-}
-
-_wln(f) struct file *f; {
-#ifdef CPM
- _wrc('\r',f);
-#endif
- _wrc('\n',f);
- f->flags |= ELNBIT;
-}
-
-_pag(f) struct file *f; {
- _wrc('\014',f);
- f->flags |= ELNBIT;
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _wstrin();
-extern char *_fcvt();
-
-#define assert() /* nothing */
-
-#define HUGE_DIG 39 /* log10(maxreal) */
-#define PREC_DIG 80 /* the maximum digits returned by _fcvt() */
-#define FILL_CHAR '0' /* char printed if all of _fcvt() used */
-#define BUFSIZE HUGE_DIG + PREC_DIG + 2
-
-_wrf(n,w,r,f) int n,w; double r; struct file *f; {
- char *p,*b; int s,d; char buf[BUFSIZE];
-
- p = buf;
- if (n > PREC_DIG)
- n = PREC_DIG;
- b = _fcvt(r,n,&d,&s);
- assert(abs(d) <= HUGE_DIG);
- if (s)
- *p++ = '-';
- if (d<=0)
- *p++ = '0';
- else
- do
- *p++ = (*b ? *b++ : FILL_CHAR);
- while (--d > 0);
- if (n > 0)
- *p++ = '.';
- while (++d <= 0) {
- if (--n < 0)
- break;
- *p++ = '0';
- }
- while (--n >= 0) {
- *p++ = (*b ? *b++ : FILL_CHAR);
- assert(p <= buf+BUFSIZE);
- }
- _wstrin(w,p-buf,buf,f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _wstrin();
-
-_wsi(w,i,f) int w,i; struct file *f; {
- char *p; int j; char buf[6];
-
- p = &buf[6];
- if ((j=i) < 0) {
- if (i == -32768) {
- _wstrin(w,6,"-32768",f);
- return;
- }
- j = -j;
- }
- do
- *--p = '0' + j%10;
- while (j /= 10);
- if (i<0)
- *--p = '-';
- _wstrin(w,&buf[6]-p,p,f);
-}
-
-_wri(i,f) int i; struct file *f; {
- _wsi(6,i,f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _wstrin();
-
-#define MAXNEGLONG -2147483648
-
-_wsl(w,l,f) int w; long l; struct file *f; {
- char *p,c; long j; char buf[11];
-
- p = &buf[11];
- if ((j=l) < 0) {
- if (l == MAXNEGLONG) {
- _wstrin(w,11,"-2147483648",f);
- return;
- }
- j = -j;
- }
- do {
- c = j%10;
- *--p = c + '0';
- } while (j /= 10);
- if (l<0)
- *--p = '-';
- _wstrin(w,&buf[11]-p,p,f);
-}
-
-_wrl(l,f) long l; struct file *f; {
- _wsl(11,l,f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _wstrin();
-extern char *_ecvt();
-
-#define PREC_DIG 80 /* maximum digits produced by _ecvt() */
-
-_wsr(w,r,f) int w; double r; struct file *f; {
- char *p,*b; int s,d,i; char buf[PREC_DIG+6];
-
- p = buf;
- if ((i = w-6) < 2)
- i = 2;
- b = _ecvt(r,i,&d,&s);
- *p++ = s? '-' : ' ';
- if (*b == '0')
- d++;
- *p++ = *b++;
- *p++ = '.';
- while (--i > 0)
- *p++ = *b++;
- *p++ = 'e';
- d--;
- if (d < 0) {
- d = -d;
- *p++ = '-';
- } else
- *p++ = '+';
- *p++ = '0' + (d/10);
- *p++ = '0' + (d%10);
- _wstrin(w,p-buf,buf,f);
-}
-
-_wrr(r,f) double r; struct file *f; {
- _wsr(13,r,f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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: J.W. Stevenson */
-
-#include <pc_file.h>
-
-extern _wf();
-extern _outcpt();
-
-_wstrin(width,len,buf,f) int width,len; char *buf; struct file *f; {
-
- _wf(f);
- for (width -= len; width>0; width--) {
- *f->ptr = ' ';
- _outcpt(f);
- }
- while (--len >= 0) {
- *f->ptr = *buf++;
- _outcpt(f);
- }
-}
-
-_wsc(w,c,f) int w; char c; struct file *f; {
- _wss(w,1,&c,f);
-}
-
-_wss(w,len,s,f) int w,len; char *s; struct file *f; {
- if (w < len)
- len = w;
- _wstrin(w,len,s,f);
-}
-
-_wrs(len,s,f) int len; char *s; struct file *f; {
- _wss(len,len,s,f);
-}
-
-_wsb(w,b,f) int w,b; struct file *f; {
- if (b)
- _wss(w,4,"true",f);
- else
- _wss(w,5,"false",f);
-}
-
-_wrb(b,f) int b; struct file *f; {
- _wsb(5,b,f);
-}
+++ /dev/null
-/* $Header$ */
-/*
- * (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 <pc_file.h>
-
-extern _wss();
-extern _wrs();
-
-_wsz(w,s,f) int w; char *s; struct file *f; {
- char *p;
-
- for (p=s; *p; p++);
- _wss(w,p-s,s,f);
-}
-
-_wrz(s,f) char *s; struct file *f; {
- char *p;
-
- for (p=s; *p; p++);
- _wrs(p-s,s,f);
-}
+++ /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 -f 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 -f pem22.p
- ln pem.p pem24.p ; apc -mvax2 -c.m -I$h pem24.p ; rm -f 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
-.TH PC_PEM VI
-.ad
-.SH NAME
-pc_pem \- Pascal to EM compiler
-.SH SYNOPSIS
-/usr/em/lib/pc_pem compact errors
-.SH DESCRIPTION
-Pem is a Pascal compiler producing compact EM assembly code.
-The EM machine is described in [1].
-The language Pascal is developed by N. Wirth and is described
-in the "Pascal User Manual and Report" [2].
-The compiler complies as much as possible with the ISO standard proposal [3].
-The language features as processed by this compiler are described in
-the Pascal reference manual [4].
-Normally the compiler is called by means of the user interface program
-\fIack\fP(I).
-.PP
-The first argument is the name of the file on which the produced
-compact EM code is written.
-The file is also used to pass the options to the compiler.
-These options include the -{xxx} flags given to \fIack\fP(I)
-and the size of Pascal objects, like pointers.
-.PP
-The second argument is the name of the error file.
-For each error found by the compiler a record is appended to this file.
-An error record contains several fields like error number, line number,
-column number and error parameter (identifier name or label number etc.).
-.SH "SEE ALSO"
-.IP [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson "Description of a machine architecture for use with
-block structured languages" Informatica report IR-81.
-.IP [2]
-K.Jensen & N.Wirth
-"PASCAL, User Manual and Report" Springer-Verlag.
-.IP [3]
-An improved version of the ISO standard proposal for the language Pascal,
-ISO/TC97/SC5-N462, received November 1979.
-.IP [4]
-J.W.Stevenson "The Amsterdam Compiler Kit Pascal reference manual".
-.br
-(try 'nroff /usr/em/doc/pcref.doc')
-.IP [5]
-\fIack\fP(I)
-.SH DIAGNOSTICS
-Compilation errors are written to the error file.
-Positive error numbers are used for irrecoverable errors, negative ones for warnings.
-\fIAck\fP searches the file /usr/em/etc/pc_errors to find
-the corresponding messages.
-.SH AUTHOR
-Johan Stevenson, Vrije Universiteit.
+++ /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 LINs 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 identifiers
- -->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 (refer in fip^.iflag) or 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; l1:=l0; sz:=0; nxt:=fip^.parhead;
- while moreargs do
- begin
- 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); l1:=lino; 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 does not 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
-# $Header$
-
-all: testC testI
-
-testI:
-# int t1.p; em
- int t2.p; em
- int t3.p; em e.out f1 f2 f3 f4 f5 f6
- int t4.p; em
- int t5.p; em
- int tstenc.p; em
- int tstgto.p; em
- rm -f e.out f?
-
-testC:
- apc t1.p; a.out
- apc t2.p; a.out
- apc t3.p; a.out f1 f2 f3 f4 f5 f6
- apc t4.p; a.out
- apc t5.p; a.out
- apc tstenc.p; a.out
- apc tstgto.p; a.out
- rm -f a.out f?
-
-install cmp:
-
-clean:
- -rm -f [ea].out f?
-
-opr:
- make pr | opr
-
-pr:
- @pr t[12345].p tstenc.p
+++ /dev/null
-{ $Header$ }
-
-procedure machar (var ibeta , it , irnd , ngrd , machep , negep , iexp,
- minexp , maxexp : integer ; var eps , epsneg , xmin , xmax : real ) ;
-var trapped:boolean;
-
-procedure encaps(procedure p; procedure q(i:integer)); extern;
-procedure trap(i:integer); extern;
-
-procedure catch(i:integer);
-const underflo=5;
-begin if i=underflo then trapped:=true else trap(i) end;
-
-procedure work;
-var
-
-
-{ This subroutine is intended to determine the characteristics
- of the floating-point arithmetic system that are specified
- below. The first three are determined according to an
- algorithm due to M. Malcolm, CACM 15 (1972), pp. 949-951,
- incorporating some, but not all, of the improvements
- suggested by M. Gentleman and S. Marovich, CACM 17 (1974),
- pp. 276-277. The version given here is for single precision.
-
- Latest revision - October 1, 1976.
-
- Author - W. J. Cody
- Argonne National Laboratory
-
- Revised for Pascal - R. A. Freak
- University of Tasmania
- Hobart
- Tasmania
-
- ibeta is the radix of the floating-point representation
- it is the number of base ibeta digits in the floating-point
- significand
- irnd = 0 if the arithmetic chops,
- 1 if the arithmetic rounds
- ngrd = 0 if irnd=1, or if irnd=0 and only it base ibeta
- digits participate in the post normalization shift
- of the floating-point significand in multiplication
- 1 if irnd=0 and more than it base ibeta digits
- participate in the post normalization shift of the
- floating-point significand in multiplication
- machep is the exponent on the smallest positive floating-point
- number eps such that 1.0+eps <> 1.0
- negeps is the exponent on the smallest positive fl. pt. no.
- negeps such that 1.0-negeps <> 1.0, except that
- negeps is bounded below by it-3
- iexp is the number of bits (decimal places if ibeta = 10)
- reserved for the representation of the exponent of
- a floating-point number
- minexp is the exponent of the smallest positive fl. pt. no.
- xmin
- maxexp is the exponent of the largest finite floating-point
- number xmax
- eps is the smallest positive floating-point number such
- that 1.0+eps <> 1.0. in particular,
- eps = ibeta**machep
- epsneg is the smallest positive floating-point number such
- that 1.0-eps <> 1.0 (except that the exponent
- negeps is bounded below by it-3). in particular
- epsneg = ibeta**negep
- xmin is the smallest positive floating-point number. in
- particular, xmin = ibeta ** minexp
- xmax is the largest finite floating-point number. in
- particular xmax = (1.0-epsneg) * ibeta ** maxexp
- note - on some machines xmax will be only the
- second, or perhaps third, largest number, being
- too small by 1 or 2 units in the last digit of
- the significand.
-
- }
-
- i , iz , j , k , mx : integer ;
- a , b , beta , betain , betam1 , one , y , z , zero : real ;
-
-begin
- irnd := 1 ;
- one := ( irnd );
- a := one + one ;
- b := a ;
- zero := 0.0 ;
-{
- determine ibeta,beta ala Malcolm
- }
- while ( ( ( a + one ) - a ) - one = zero ) do begin
- a := a + a ;
- end ;
- while ( ( a + b ) - a = zero ) do begin
- b := b + b ;
- end ;
- ibeta := trunc ( ( a + b ) - a );
- beta := ( ibeta );
- betam1 := beta - one ;
-{
- determine irnd,ngrd,it
- }
- if ( ( a + betam1 ) - a = zero ) then irnd := 0 ;
- it := 0 ;
- a := one ;
- repeat begin
- it := it + 1 ;
- a := a * beta ;
- end until ( ( ( a + one ) - a ) - one <> zero ) ;
-{
- determine negep, epsneg
- }
- negep := it + 3 ;
- a := one ;
-
- for i := 1 to negep do begin
- a := a / beta ;
- end ;
-
- while ( ( one - a ) - one = zero ) do begin
- a := a * beta ;
- negep := negep - 1 ;
- end ;
- negep := - negep ;
- epsneg := a ;
-{
- determine machep, eps
- }
- machep := negep ;
- while ( ( one + a ) - one = zero ) do begin
- a := a * beta ;
- machep := machep + 1 ;
- end ;
- eps := a ;
-{
- determine ngrd
- }
- ngrd := 0 ;
- if(( irnd = 0) and((( one + eps) * one - one) <> zero)) then
- ngrd := 1 ;
-{
- determine iexp, minexp, xmin
-
- loop to determine largest i such that
- (1/beta) ** (2**(i))
- does not underflow
- exit from loop is signall by an underflow
- }
- i := 0 ;
- betain := one / beta ;
- z := betain ;
- trapped:=false;
- repeat begin
- y := z ;
- z := y * y ;
-{
- check for underflow
- }
- i := i + 1 ;
- end until trapped;
- i := i - 1;
- k := 1 ;
-{
- determine k such that (1/beta)**k does not underflow
-
- first set k = 2 ** i
- }
-
- for j := 1 to i do begin
- k := k + k ;
- end ;
-
- iexp := i + 1 ;
- mx := k + k ;
- if ( ibeta = 10 ) then begin
-{
- for decimal machines only }
- iexp := 2 ;
- iz := ibeta ;
- while ( k >= iz ) do begin
- iz := iz * ibeta ;
- iexp := iexp + 1 ;
- end ;
- mx := iz + iz - 1 ;
- end;
- trapped:=false;
- repeat begin
-{
- loop to construct xmin
- exit from loop is signalled by an underflow
- }
- xmin := y ;
- y := y * betain ;
- k := k + 1 ;
- end until trapped;
- k := k - 1;
- minexp := - k ;
-{ determine maxexp, xmax
- }
- if ( ( mx <= k + k - 3 ) and ( ibeta <> 10 ) ) then begin
- mx := mx + mx ;
- iexp := iexp + 1 ;
- end;
- maxexp := mx + minexp ;
-{ adjust for machines with implicit leading
- bit in binary significand and machines with
- radix point at extreme right of significand
- }
- i := maxexp + minexp ;
- if ( ( ibeta = 2 ) and ( i = 0 ) ) then maxexp := maxexp - 1 ;
- if ( i > 20 ) then maxexp := maxexp - 3 ;
- xmax := one - epsneg ;
- if ( xmax * one <> xmax ) then xmax := one - beta * epsneg ;
- xmax := ( xmax * betain * betain * betain ) / xmin ;
- i := maxexp + minexp + 3 ;
- if ( i > 0 ) then begin
-
- for j := 1 to i do begin
- xmax := xmax * beta ;
- end ;
- end;
-
-end;
-
-begin
- trapped:=false;
- encaps(work,catch);
-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
-
-}
-
-program t1(input,output);
-
-{ This program can be used to test out PASCAL compilers }
-
-const
- rcsversion='$Header$';
- ONE=1; TWO=2; TEN=10; FIFTY=50; MINONE=-1;
-#ifndef NOFLOAT
- RR1=1.0; RR1H=1.5; RR2=2.0; RR3=3.0; RR4=4.0; RRMINONE=-1.0;
-#endif
- yes=true; no=false;
- kew='q';
-#ifndef NOFLOAT
- eps = 2.0e-7; { This constant is machine dependent }
-#endif
-
-type wavelength = (red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
- violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack);
- ww2= 1939..1945;
-#ifndef NOFLOAT
- tp2= record c1:char; i,j:integer; p:boolean; x:real end;
-#else
- tp2= record c1:char; i,j:integer; p:boolean end;
-#endif
- single= array [0..0] of integer;
- spectrum= set of wavelength;
- np = ^node;
- node = record val:integer; next: np end;
-
-var t,pct,ect:integer;
- i,j,k,l,m:integer;
-#ifndef NOFLOAT
- x,y,z:real;
-#endif
- p,q,r:boolean;
- c1,c2,c3:char;
- sr1,sr2,sr3: 1939..1945;
- bar: packed array[0..3] of 0..255;
- color,hue,tint: wavelength;
- grat:spectrum;
- a1: array [-10..+10] of integer;
-#ifndef NOFLOAT
- a2: array [ww2] of real;
-#endif
- a3: array[wavelength] of boolean;
- a4: array[(mouse,house)] of char;
- a5: array[50..52,(bat,cat),boolean,ww2] of integer;
- a6: packed array[0..10,0..3,0..3] of char;
- r1,r2: tp2;
-#ifndef NOFLOAT
- r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
-#else
- r3: packed record c1:char; i,j:integer; p:boolean end;
-#endif
- colors: set of wavelength;
- beasts: set of (pig,cow,chicken,farmersdaughter);
- bits: set of 0..1;
- p1: ^integer;
- p2: ^tp2;
- p3: ^single;
- p4: ^spectrum;
- head,tail: np;
-
-
-
-procedure e(n:integer);
-begin
- ect := ect + 1;
- writeln(' Error', n:3,' in test ', t)
-end;
-
-
-
-
-function inc(k:integer):integer; begin inc := k+1 end;
-
-
-
-{************************************************************************}
-procedure tst1;
-{ Arithmetic on constants }
-begin t:=1; pct := pct + 1;
- if 1+1 <> 2 then e(1);
- if ONE+ONE <> TWO then e(2);
- if ONE+MINONE <> 0 then e(3);
- if ONE-TWO <> MINONE then e(4);
- if TWO-MINONE <> 3 then e(5);
- if TWO*TWO <> 4 then e(6);
- if 100*MINONE <> -100 then e(7);
- if 50*ONE <> 50 then e(8);
- if 50*9 <> 450 then e(9);
- if 50*TEN <> 500 then e(10);
- if 60 div TWO <> 30 then e(11);
- if FIFTY div TWO <> 25 then e(12);
- if -2 div 1 <> -2 then e(13);
- if -3 div 1 <> -3 then e(14);
- if -3 div 2 <> -1 then e(15);
- if ((1+2+3) * (2+3+4) * (3+5+5)) div 2 <> ((3 * ((5+3+2)*10)+51)*6) div 6
- then e(16);
- if (1000*2 + 5*7 + 13) div 8 <> 2*2*2*2*4*4 then e(17);
- if (1 * 2 * 3 * 4 * 5 * 6 * 7) div 5040 <>
- 5040 div 7 div 6 div 5 div 4 div 3 div 2 then e(18);
- if -(-(-(-(-(-(-(-(-(1))))))))) <> -1 then e(19);
- if -1 -1 -1 -1 -1 <> -5 then e(20);
- if - 1 <> -(((((((((((((1))))))))))))) then e(21);
- if -4 * (-5) <> 20 then e(22);
- if (9999-8) mod 97 <> 309 mod 3 then e(23);
- if 2<1 then e(24);
- if 2 <= 1 then e(25);
- if 2 = 3 then e(26);
- if 2 <> 2 then e(27);
- if 2 >= 3 then e(28);
- if 2 > 3 then e(29);
- if 2+0 <> 2 then e(30);
- if 2-0 <> 2 then e(31);
- if 2*0 <> 0 then e(32);
- if 0+2 <> 2 then e(33);
- if 0-2 <> -2 then e(34);
- if 0*2 <> 0 then e(35);
- if 0 div 1 <> 0 then e(36);
- if -0 <> 0 then e(37);
- if 0 - 0 <> 0 then e(38);
- if 0 * 0 <> 0 then e(39);
-end;
-
-{************************************************************************}
-procedure tst2;
-{ Arithmetic on global integer variables }
-begin t:=2; pct := pct + 1;
- i:=1; j:=2; k:=3; l:=4; m:=10;
- if i+j <> k then e(1);
- if i+k <> l then e(2);
- if j-k <> -i then e(3);
- if j*(j+k) <> m then e(4);
- if -m <> -(k+k+l) then e(5);
- if i div i <> 1 then e(6);
- if m*m div m <> m then e(7);
- if 10*m <> 100 then e(8);
- if m*(-10) <> -100 then e(9);
- if j div k <> 0 then e(10);
- if 100 div k <> 33 then e(11);
- if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
- if j*k*m div 6 <> 10 then e(13);
- if (k>4) or (k>=4) or (k=4) then e(14);
- if (m<j) or (m<=j) or (m=j) then e(15);
- if k <> i+j then e(16);
- if j < i then e(17);
- if j <= i then e(18);
- if j = i then e(19);
- if j <> j then e(20);
- if i >= j then e(21);
- if i > j then e(22);
-end;
-
-#ifndef NOFLOAT
-
-{************************************************************************}
-procedure tst3;
-{ Real arithmetic }
-begin t:=3; pct := pct + 1;
- if abs(1.0+1.0-2.0) > eps then e(1);
- if abs(1e10-1e10) > eps then e(2);
- if abs(RR1+RR1H+RR2+RR3+RR4+RRMINONE-10.5) > eps then e(3);
- if abs(1.0e-1 * 1.0e1 - 100e-2) > eps then e(4);
- if abs(10.0/3.0*3.0/10.0-100e-2) > eps then e(5);
- if 0.0e0 <> 0 then e(6);
- if abs(32767.0-32767.0) > eps then e(7);
- if abs(1.0+2+5+3.0e0+5.0e+0+140e-1-30.000)/100 > eps then e(8);
- if abs(-1+(-1)+(-1.0)+(-1e0)+(-1e+0)+(-1e-0) + ((((6)))) ) > eps then e(9);
-
- x:=1.50; y:=3.00; z:= 0.10;
- if abs(5*y*z-x) > eps then e(10);
- if abs(y*y*y/z*x-405) > eps then e(11);
- x:=1.1; y:= 1.2;
- if y<x then e(12);
- if y <= x then e(13);
- if y = x then e(14);
- if x <> x then e(15);
- if x >= y then e(16);
- if x >y then e(17);
-end;
-
-#endif
-
-
-{************************************************************************}
-procedure tst4;
-{ Boolean expressions }
-begin t:=4; pct := pct + 1;
- if not yes = true then e(1);
- if not no = false then e(2);
- if yes = no then e(3);
- if not true = not false then e(4);
- if true and false then e(5);
- if false or false then e(6);
-
- p:=true; q:=true; r:=false;
- if not p then e(7);
- if r then e(8);
- if p and r then e(9);
- if p and not q then e(10);
- if not p or not q then e(11);
- if (p and r) or (q and r) then e(12);
- if p and q and r then e(13);
- if (p or q) = r then e(14);
-end;
-
-{************************************************************************}
-procedure tst5;
-{ Characters, Subranges, Enumerated types }
-begin t:=5; pct := pct + 1;
- if 'q' <> kew then e(1);
- c1 := 'a'; c2 := 'b'; c3 := 'a';
- if c1 = c2 then e(2);
- if c1 <> c3 then e(3);
-
- sr1:=1939; sr2:=1945; sr3:=1939;
- if sr1=sr2 then e(4);
- if sr1<>sr3 then e(5);
-
- color := yellow; hue := blue; tint := yellow;
- if color = hue then e(6);
- if color <> tint then e(7);
-end;
-
-
-{************************************************************************}
-procedure tst6;
-{ Global arrays }
-var i,j,k:integer;
-begin t:=6; pct := pct + 1;
- for i:= -10 to 10 do a1[i] := i*i;
- if (a1[-10]<>100) or (a1[9]<>81) then e(1);
-
-#ifndef NOFLOAT
- for i:=1939 to 1945 do a2[i]:=i-1938.5;
- if (abs(a2[1939]-0.5) > eps) or (abs(a2[1945]-6.5) > eps) then e(2);
-#endif
-
- color := yellow;
- a3[blue] := true; a3[yellow] := true;
- if (a3[blue]<>true) or (a3[yellow]<>true) then e(3);
- a3[blue] := false; a3[yellow] := false;
- if (a3[blue]<>false) or (a3[yellow]<>false) then e(4);
-
- a4[mouse]:='m'; a4[house]:='h';
- if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);
-
- for i:=1939 to 1945 do a5[51,bat,false,i]:=300+i;
- if a5[51,bat,false,1940] <> 2240 then e(6);
- for i:=50 to 52 do a5[i,cat,true,1943]:=200+i;
- if (a5[50,cat,true,1943] <> 250) or (a5[52,cat,true,1943] <> 252) then e(7);
-
- for i:= -10 to 10 do a1[i]:= 0;
- for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
- if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);
-
- for i:= 0 to 10 do
- for j:= 0 to 3 do
- for k:= 0 to 3 do
- if ( (i+j+k) div 2) * 2 = i+j+k then a6[i,j,k]:='e' else a6[i,j,k]:='o';
- if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
-end;
-
-
-#ifndef NOFLOAT
-
-{************************************************************************}
-procedure tst7;
-{ Global records }
-begin t:=7; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
- c1:='a'; i:=0; j:=0; p:=false; x:=100.0;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1; x:=r1.x;
- if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
-end;
-
-#else
-
-{************************************************************************}
-procedure tst7;
-{ Global records }
-begin t:=7; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
- c1:='a'; i:=0; j:=0; p:=false;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1;
- if (c1<>'x') or (i<>40) or (p<>true) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
-end;
-
-#endif
-
-
-{************************************************************************}
-procedure tst8;
-{ Global sets }
-begin t:=8; pct := pct + 1;
- colors := [];
- colors := colors + [];
- if colors <> [] then e(1);
- colors := colors + [red];
- if colors <> [red] then e(2);
- colors := colors + [blue];
- if colors <> [red,blue] then e(3);
- if colors <> [blue,red] then e(4);
- colors := colors - [red];
- if colors <> [blue] then e(5);
- beasts := [chicken] + [chicken,pig];
- if beasts <> [pig,chicken] then e(6);
- beasts := [] - [farmersdaughter] + [cow] - [cow];
- if beasts <> [] then e(7);
- bits := [0] + [1] - [0];
- if bits <> [1] then e(8);
- bits := [] + [] + [] -[] + [0] + [] + [] - [0];
- if bits <> [] then e(9);
- if not ([] <= [red]) then e(10);
- if [red] >= [blue] then e(11);
- if [red] <= [blue] then e(12);
- if [red] = [blue] then e(13);
- if not ([red] <= [red,blue]) then e(14);
- if not ([red,blue] <= [red,yellow,blue]) then e(15);
- if not ([blue,yellow] >= [blue] + [yellow]) then e(16);
- grat := [ red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,
- violet,darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack];
- if grat<>[red,blue,yellow,purple,white,gray,pink,black,fuchia,maple,violet,
- darkred,darkblue,darkyellow,darkwhite,darkpink,darkblack] then e(17);
- if not ([10] <= [10]) then e(18);
-end;
-
-
-{************************************************************************}
-procedure tst9;
-{ Global pointers }
-begin t:=9; pct := pct + 1;
- new(p1); new(p2); new(p3); new(p4);
- p1^ := 1066;
- if p1^ <> 1066 then e(1);
- p2^.i := 1215;
- if p2^.i <> 1215 then e(2);
- p3^[0]:= 1566;
- if p3^[0] <> 1566 then e(3);
- p4^ := [red];
- if p4^ <> [red] then e(4);
-end;
-
-
-{************************************************************************}
-procedure tst10;
-{ More global pointers }
-var i:integer;
-begin t:=10; pct := pct + 1;
- head := nil;
- for i:= 1 to 100 do
- begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
- if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
- if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
- tail^.next^.next^.next^.val := 30;
- if tail^.next^.next^.next^.val <> 30 then e(3);
-end;
-
-
-{************************************************************************}
- procedure tst11;
- { Arithmetic on local integer variables }
- var i,j,k,l,m:integer;
- begin t:=11; pct := pct + 1;
- i:=1; j:=2; k:=3; l:=4; m:=10;
- if i+j <> k then e(1);
- if i+k <> l then e(2);
- if j-k <> -i then e(3);
- if j*(j+k) <> m then e(4);
- if -m <> -(k+k+l) then e(5);
- if i div i <> 1 then e(6);
- if m*m div m <> m then e(7);
- if 10*m <> 100 then e(8);
- if m*(-10) <> -100 then e(9);
- if j div k <> 0 then e(10);
- if 100 div k <> 33 then e(11);
- if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
- if j*k*m div 6 <> 10 then e(13);
- if (k>4) or (k>=4) or (k=4) then e(14);
- if (m<j) or (m<=j) or (m=j) then e(15);
- if k <> i+j then e(16);
- end;
-
-#ifndef NOFLOAT
-
-{************************************************************************}
- procedure tst12;
- { Real arithmetic on locals }
- var x,y,z:real;
- begin t:=12; pct := pct + 1;
-
- x:=1.50; y:=3.00; z:= 0.10;
- if abs(5*y*z-x) > eps then e(10);
- if abs(y*y*y/z*x-405) > eps then e(11);
- x:=1.1; y:= 1.2;
- if y<x then e(12);
- if y <= x then e(13);
- if y = x then e(14);
- if x <> x then e(15);
- if x >= y then e(16);
- if x >y then e(17);
- end;
-
-#endif
-
-
-{************************************************************************}
- procedure tst13;
- { Boolean expressions using locals }
- var pp,qq,rr:boolean;
- begin t:=13; pct := pct + 1;
- if not yes = true then e(1);
- if not no = false then e(2);
- if yes = no then e(3);
- if not true = not false then e(4);
- if true and false then e(5);
- if false or false then e(6);
-
- pp:=true; qq:=true; rr:=false;
- if not pp then e(7);
- if rr then e(8);
- if pp and rr then e(9);
- if pp and not qq then e(10);
- if not pp or not qq then e(11);
- if (pp and rr) or (qq and rr) then e(12);
- if pp and qq and rr then e(13);
- if (pp or qq) = rr then e(14);
- end;
-
-{************************************************************************}
- procedure tst14;
- { Characters, Subranges, Enumerated types using locals }
- var cc1,cc2,cc3:char;
- sr1,sr2,sr3: 1939..1945;
- color,hue,tint: (ochre,magenta);
- begin t:=14; pct := pct + 1;
- if 'q' <> kew then e(1);
- cc1 := 'a'; cc2 := 'b'; cc3 := 'a';
- if cc1 = cc2 then e(2);
- if cc1 <> cc3 then e(3);
-
- sr1:=1939; sr2:=1945; sr3:=1939;
- if sr1=sr2 then e(4);
- if sr1<>sr3 then e(5);
- bar[0]:=200; bar[1]:=255; bar[2]:=255; bar[3]:=203;
- if (bar[0]<>200) or (bar[1]<>255) or (bar[2]<>255) or (bar[3]<>203) then e(6);
-
- color := ochre; hue:=magenta; tint := ochre;
- if color = hue then e(7);
- if color <> tint then e(8);
- end;
-
-
-{************************************************************************}
- procedure tst15;
- { Local arrays }
- type colour = (magenta,ochre);
- var aa1: array [-10..+10] of integer;
-#ifndef NOFLOAT
- aa2: array [ww2] of real;
-#endif
- aa3: array[colour] of boolean;
- aa4: array[(mouse,house,louse)] of char;
- aa5: array[50..52,(bat,cat),boolean,ww2] of integer;
- aa6: packed array[0..10,0..3,0..3] of char;
- i,j,k:integer;
- begin t:=15; pct := pct + 1;
- for i:= -10 to 10 do aa1[i] := i*i;
- if (aa1[-10]<>100) or (aa1[9]<>81) then e(1);
-
-#ifndef NOFLOAT
- for i:=1939 to 1945 do aa2[i]:=i-1938.5;
- if (abs(aa2[1939]-0.5) > eps) or (abs(aa2[1945]-6.5) > eps) then e(2);
-#endif
-
- aa3[magenta] := true; aa3[ochre] := true;
- if (aa3[magenta]<>true) or (aa3[ochre]<>true) then e(3);
- aa3[magenta] := false; aa3[ochre] := false;
- if (aa3[magenta]<>false) or (aa3[ochre]<>false) then e(4);
-
- aa4[mouse]:='m'; aa4[house]:='h'; aa4[louse]:='l';
- if (aa4[mouse] <> 'm') or (aa4[house]<>'h' ) or (aa4[louse]<>'l') then e(5);
-
- for i:=1939 to 1945 do aa5[51,bat,false,i]:=300+i;
- if aa5[51,bat,false,1940] <> 2240 then e(6);
- for i:=50 to 52 do aa5[i,cat,true,1943]:=200+i;
- if (aa5[50,cat,true,1943] <> 250) or (aa5[52,cat,true,1943] <> 252) then e(7);
-
- for i:= -10 to 10 do aa1[i]:= 0;
- for i:= 0 to 10 do aa1[i div 2 + i div 2]:= i+1;
- if(aa1[0]<>2) or (aa1[5]<>0) or (aa1[8]<>10) then e(8);
-
- for i:= 0 to 10 do
- for j:= 0 to 3 do
- for k:= 0 to 3 do
- if ( (i+j+k) div 2) * 2 = i+j+k then aa6[i,j,k]:='e' else aa6[i,j,k]:='o';
- if (aa6[2,2,2]<>'e') or (aa6[2,2,3]<>'o') or (aa6[0,3,1]<>'e') then e(9);
- end;
-
-
-#ifndef NOFLOAT
-
-{************************************************************************}
- procedure tst16;
- { Local records }
- var r1,r2: tp2;
- r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
- begin t:=16; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
- c1:='a'; i:=0; j:=0; p:=false; x:=100.0;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1; x:=r1.x;
- if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
- end;
-
-#else
-{************************************************************************}
- procedure tst16;
- { Local records }
- var r1,r2: tp2;
- r3: packed record c1:char; i,j:integer; p:boolean end;
- begin t:=16; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
- c1:='a'; i:=0; j:=0; p:=false;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1;
- if (c1<>'x') or (i<>40) or (p<>true) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
- end;
-
-#endif
-
-{************************************************************************}
- procedure tst17;
- { Local sets }
- var colors: set of (pink,green,orange,red);
- beasts: set of (pig,cow,chicken,farmersdaughter);
- bits: set of 0..1;
- begin t:=17; pct := pct + 1;
- colors := [];
- colors := colors + [];
- if colors <> [] then e(1);
- colors := colors + [pink];
- if colors <> [pink] then e(2);
- colors := colors + [green];
- if colors <> [pink,green] then e(3);
- if colors <> [green,pink] then e(4);
- colors := colors - [pink,orange];
- if colors <> [green] then e(5);
- beasts := [chicken] + [chicken,pig];
- if beasts <> [pig,chicken] then e(6);
- beasts := [] - [farmersdaughter] + [cow] - [cow];
- if beasts <> [] then e(7);
- bits := [0] + [1] - [0];
- if bits <> [1] then e(8);
- bits := [] + [] + [] + [0] + [] + [0];
- if bits <> [0] then e(9);
- if ord(red) <> 3 then e(10);
- end;
-
-
-{************************************************************************}
- procedure tst18;
- { Local pointers }
- type rainbow = set of (pink,purple,chartreuse);
- var p1: ^integer;
- p2: ^tp2;
- p3: ^single;
- p4: ^rainbow;
- begin t:=18; pct := pct + 1;
- new(p1); new(p2); new(p3); new(p4);
- p1^ := 1066;
- if p1^ <> 1066 then e(1);
- p2^.i := 1215;
- if p2^.i <> 1215 then e(2);
- p3^[0]:= 1566;
- if p3^[0] <> 1566 then e(3);
- p4^ := [pink] + [purple] + [purple,chartreuse] - [purple];
- if p4^ <> [pink,chartreuse] then e(4);
- end;
-
-
-{************************************************************************}
- procedure tst19;
- var head,tail: np; i:integer;
- begin t:=19; pct := pct + 1;
- head := nil;
- for i:= 1 to 100 do
- begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
- if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
- if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
- tail^.next^.next^.next^.val := 30;
- if tail^.next^.next^.next^.val <> 30 then e(3);
- end;
-
-#ifndef NOFLOAT
-
-{************************************************************************}
-procedure tst20;
-{ Mixed local and global }
-var li:integer;
- lx:real;
-begin t:=20; pct := pct + 1;
- li:=6; i:=li; if i<>6 then e(1);
- i:=6; li:=i; if li <> 6 then e(2);
- lx := 3.5; x:=lx; if x <> 3.5 then e(3);
- x:= 4.5; lx:= x; if lx <> 4.5 then e(4);
-end;
-
-#else
-{************************************************************************}
-procedure tst20;
-{ Mixed local and global }
-var li:integer;
-begin t:=20; pct := pct + 1;
- li:=6; i:=li; if i<>6 then e(1);
- i:=6; li:=i; if li <> 6 then e(2);
-end;
-
-#endif
-
-
-{************************************************************************}
-
-{ Main Program }
-begin ect := 0; pct := 0;
-#ifndef NOFLOAT
-tst1; tst2; tst3; tst4; tst5; tst6; tst7; tst8;
-tst9; tst10; tst11; tst12; tst13; tst14; tst15; tst16;
-tst17; tst18; tst19; tst20;
-
-#else
-
-tst1; tst2; tst4; tst5; tst6; tst7; tst8;
-tst9; tst10; tst11; tst13; tst14; tst15; tst16;
-tst17; tst18; tst19; tst20;
-
-#endif
-write('Program t1:',pct:3,' tests completed.');
-writeln('Number of errors = ',ect:0);
-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
-
-}
-program t2(input,output);
-
-{ This program can be used to test out PASCAL compilers }
-
-const
- rcsversion='$Header$';
- kew='q';
-#ifndef NOFLOAT
- eps = 2.0e-7; { This constant is machine dependent }
-#endif
-
-type wavelength = (red,blue,yellow);
- tp2= record c1:char; i,j:integer; p:boolean; x:real end;
- single= array [0..0] of integer;
- spectrum= set of wavelength;
- np= ^node;
- node = record val:integer; next: np end;
-
-var t,pct,ect:integer;
- i,j,k,l:integer;
-#ifndef NOFLOAT
- w,x,y,z:real;
-#endif
- p:boolean;
- d:char;
- color: wavelength;
- head: np;
-
-
-function twice(k:integer):integer; begin twice := 2*k end;
-function inc(k:integer):integer; begin inc := k+1 end;
-
-procedure e(n:integer);
-begin
- ect := ect + 1;
- writeln(' Error', n:3,' in test ', t)
-end;
-
-
-
-
-
-{************************************************************************}
-procedure tst21;
-{ Test things packed }
-var i:integer; c:char;
- r1: packed record c:char; b:boolean; i:integer end;
- r2: packed record c:char; i:integer; b:boolean; j:integer end;
-#ifndef NOFLOAT
- r3: packed record c:char; r:real end;
-#else
- r3: packed record c:char end;
-#endif
- r4: packed record i:0..10; j:integer end;
- r5: packed record x:array[1..3] of char; i:integer end;
- r6: packed record x: packed array[1..3] of char; i:integer end;
- r7: packed record c:char; x:packed array[1..3] of char end;
- r8: packed record c:char; x:packed array[1..3] of integer end;
- r9: record x:packed record c:char; i:integer end; i:integer; c:char end;
- r10:packed record a:0..100; b:0..100; c:char; d:char end;
-
- a1: packed array[1..3] of char;
- a2: packed array[1..3] of integer;
-#ifndef NOFLOAT
- a3: packed array[1..7] of real;
-#endif
- a4: packed array[1..7] of array[1..11] of char;
- a5: packed array[1..5] of array[1..11] of integer;
- a6: packed array[1..9] of packed array[1..11] of char;
- a7: packed array[1..3] of packed array[1..5] of integer;
-begin t:=21; pct := pct + 1;
-#ifndef NOFLOAT
- i:=4; x:=3.5; c:='x'; p:=true;
-#else
- i:=4; c:='x'; p:=true;
-#endif
-
- r1.c:='a'; r1.b:=true; r1.i:=i; p:=r1.b; j:=r1.i;
- r2.c:=c; r2.i:=i; r2.b:=p; r2.j:=i; j:=r2.i; j:=r2.j;
-#ifndef NOFLOAT
- r3.c:=c; r3.r:=x; y:=r3.r;
-#else
- r3.c:=c;
-#endif
- r4.i:=i; r4.j:=i; j:=r4.i; j:=r4.j;
- r5.x[i-2]:=c; r5.i:=i; j:=r5.i;
- r6.x[i-1]:=c; r6.i:=i; j:=r6.i;
- r7.c:=c; r7.x[i-1]:=c; d:=r7.c; d:=r7.x[i-1];
- r8.c:=c; r8.x[i-1]:=5; j:=r8.x[i-1];
- r9.x.c:=c; r9.x.i:=i; r9.c:=c; j:=r9.x.i;
-
- if (r1.c <> 'a') or (r1.b <> true) or (r1.i <> 4) then e(1);
- if (r2.c<>'x') or (r2.i<>4) or (r2.b<>p) or (r2.j<>4) then e(2);
-#ifndef NOFLOAT
- if (r3.c<>'x') or (r3.r<>3.5) then e(3);
-#else
- if (r3.c<>'x') then e(3);
-#endif
- if (r4.i<>4) or (r4.j<>4) then e(4);
- if (r5.x[2]<>'x') or (r5.i<>4) then e(5);
- if (r6.x[3]<>'x') or (r6.i<>4) then e(6);
- if (r7.c<>'x') or (r7.x[3]<>'x') or (c<>d) then e(7);
- if (r8.c<>'x') or (r8.x[3]<>5) then e(8);
- if (r9.x.c<>'x') or (r9.x.i<>4) or (r9.c<>'x') then e(9);
-
-#ifndef NOFLOAT
- i:=4; a1[i-1]:=c; a2[i-1]:=i; a3[i]:=x;
-#else
- i:=4; a1[i-1]:=c; a2[i-1]:=i;
-#endif
- a4[i][i+1]:=c;
- a5[i][i+1]:=i; j:=a5[i][i+1];
- a6[i][i+1]:=c;
- a7[i-1][i+1]:=i; j:=a7[i-1][i+1];
-
- if a1[i-1] <> 'x' then e(10);
- if a2[i-1] <> 4 then e(11);
-#ifndef NOFLOAT
- if a3[i] <> 3.5 then e(12);
-#endif
- if a4[i][i+1] <> 'x' then e(13);
- if a5[i][i+1] <> 4 then e(14);
- if a6[i][i+1] <> 'x' then e(15);
- if a7[i-1][i+1] <> 4 then e(16);
-
- i:=75; c:='s';
- r10.a:=i; r10.b:=i+1; r10.c:='x'; r10.d:=c;
- if (r10.a<>i) or (r10.b<>76) or (r10.c<>'x') or (r10.d<>'s') then e(17);
- i:=r10.a; if i<>75 then e(18);
- i:=r10.b; if i<>76 then e(19);
- c:=r10.c; if c<>'x'then e(20);
- c:=r10.d; if c<>'s'then e(21);
-end;
-
-
-{************************************************************************}
- procedure tst22;
-{ References to intermediate lexical levels }
- type wavelength = (pink,green,orange);
- ww2= 1939..1945;
-#ifndef NOFLOAT
- tp2= record c1:char; i,j:integer; p:boolean; x:real end;
-#else
- tp2= record c1:char; i,j:integer; p:boolean end;
-#endif
- single= array [0..0] of integer;
- spectrum= set of wavelength;
- pnode = ^node;
- node = record val:integer; next: pnode end;
- vec1 = array[-10..+10] of integer;
-
- var j,k,m:integer;
-#ifndef NOFLOAT
- x,y,z:real;
-#endif
- p,q,r:boolean;
- c1,c2,c3:char;
- sr1,sr2,sr3: 1939..1945;
- color,hue,tint: wavelength;
- a1: vec1;
-#ifndef NOFLOAT
- a2: array [ww2] of real;
-#endif
- a3: array[wavelength] of boolean;
- a4: array[(mouse,house)] of char;
- a5: array[50..52,(bat,cat,rat),boolean,ww2] of integer;
- a6: packed array[0..10,0..3,0..3] of char;
- r1,r2: tp2;
-#ifndef NOFLOAT
- r3: packed record c1:char; i,j:integer; p:boolean; x:real end;
-#else
- r3: packed record c1:char; i,j:integer; p:boolean end;
-#endif
- colors: spectrum;
- beasts: set of (pig,chicken,farmersdaughter);
- bits: set of 0..1;
- p1: ^integer;
- p2: ^tp2;
- p3: ^single;
- p4: ^spectrum;
- tail: np;
-
-
-
-
- procedure tst2201;
- { Arithmetic on intermediate level integer variables }
- begin t:=2201; pct := pct + 1;
- i:=1; j:=2; k:=3; l:=4; m:=10;
- if i+j <> k then e(1);
- if i+k <> l then e(2);
- if j-k <> -i then e(3);
- if j*(j+k) <> m then e(4);
- if -m <> -(k+k+l) then e(5);
- if i div i <> 1 then e(6);
- if m*m div m <> m then e(7);
- if 10*m <> 100 then e(8);
- if m*(-10) <> -100 then e(9);
- if j div k <> 0 then e(10);
- if 100 div k <> 33 then e(11);
- if i+j*k+l+m mod j + 50 div k <> 27 then e(12);
- if j*k*m div 6 <> 10 then e(13);
- if (k>4) or (k>=4) or (k=4) then e(14);
- if (m<j) or (m<=j) or (m=j) then e(15);
- if k <> i+j then e(16);
- end;
-
-#ifndef NOFLOAT
-
- procedure tst2202;
- { Real arithmetic using intermediate level variables }
- begin t:=2202; pct := pct + 1;
-
- x:=1.50; y:=3.00; z:= 0.10;
- if abs(5*y*z-x) > eps then e(10);
- if abs(y*y*y/z*x-405) > eps then e(11);
- x:=1.1; y:= 1.2;
- if y<x then e(12);
- if y <= x then e(13);
- if y = x then e(14);
- if x <> x then e(15);
- if x >= y then e(16);
- if x >y then e(17);
- end;
-
-#endif
- procedure tst2203;
- { Boolean expressions using intermediate level varibales }
- begin t:=2203; pct := pct + 1;
- p:=true; q:=true; r:=false;
- if not p then e(7);
- if r then e(8);
- if p and r then e(9);
- if p and not q then e(10);
- if not p or not q then e(11);
- if (p and r) or (q and r) then e(12);
- if p and q and r then e(13);
- if (p or q) = r then e(14);
- end;
-
- procedure tst2204;
- { Characters, Subranges, Enumerated types using intermediate level vars }
- begin t:=2204; pct := pct + 1;
- if 'q' <> kew then e(1);
- c1 := 'a'; c2 := 'b'; c3 := 'a';
- if c1 = c2 then e(2);
- if c1 <> c3 then e(3);
-
- sr1:=1939; sr2:=1945; sr3:=1939;
- if sr1=sr2 then e(4);
- if sr1<>sr3 then e(5);
-
- color := orange; hue := green; tint := orange;
- if color = hue then e(6);
- if color <> tint then e(7);
- end;
-
-
- procedure tst2205;
- { Intermediate level arrays }
- var i,l,o:integer;
- begin t:=2205; pct := pct + 1;
- for i:= -10 to 10 do a1[i] := i*i;
- if (a1[-10]<>100) or (a1[9]<>81) then e(1);
-
-#ifndef NOFLOAT
- for i:=1939 to 1945 do a2[i]:=i-1938.5;
- if (abs(a2[1939]-0.5) > eps) or (abs(a2[1945]-6.5) > eps) then e(2);
-#endif
-
- color := orange;
- a3[green] := true; a3[orange] := true;
- if (a3[green]<>true) or (a3[orange]<>true) then e(3);
- a3[green] := false; a3[orange] := false;
- if (a3[green]<>false) or (a3[orange]<>false) then e(4);
-
- a4[mouse]:='m'; a4[house]:='h';
- if (a4[mouse] <> 'm') or (a4[house]<>'h' ) then e(5);
-
- for i:=1939 to 1945 do a5[51,bat,false,i]:=300+i;
- if a5[51,bat,false,1940] <> 2240 then e(6);
- for i:=50 to 52 do a5[i,cat,true,1943]:=200+i;
- if (a5[50,cat,true,1943] <> 250) or (a5[52,cat,true,1943] <> 252) then e(7);
-
- for i:= -10 to 10 do a1[i]:= 0;
- for i:= 0 to 10 do a1[i div 2 + i div 2]:= i+1;
- if(a1[0]<>2) or (a1[5]<>0) or (a1[8]<>10) then e(8);
-
- for i:= 0 to 10 do
- for l:= 0 to 3 do
- for o:= 0 to 3 do
- if ( (i+l+o) div 2) * 2 = i+l+o then a6[i,l,o]:='e' else a6[i,l,o]:='o';
- if (a6[2,2,2]<>'e') or (a6[2,2,3]<>'o') or (a6[0,3,1]<>'e') then e(9);
- end;
-
-#ifndef NOFLOAT
-
- procedure tst2206;
- { Intermediate level records }
- begin t:=2206; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true; r1.x:=3.0;
- c1:='a'; i:=0; j:=0; p:=false; x:=100.0;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) or (r1.x<>3.0) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) or (r2.x<>3.0) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1; x:=r1.x;
- if (c1<>'x') or (i<>40) or (p<>true) or (x<>3.0) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true; r3.x:=3.0;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) or (r3.x<>3.0) then e(4);
- end;
-
-#else
-
- procedure tst2206;
- { Intermediate level records }
- begin t:=2206; pct := pct + 1;
- r1.c1:='x'; r1.i:=40; r1.j:=50; r1.p:=true;
- c1:='a'; i:=0; j:=0; p:=false;
- if (r1.c1<>'x') or (r1.i<>40) or (r1.p<>true) then e(1);
- r2:=r1;
- if (r2.c1<>'x') or (r2.i<>40) or (r2.p<>true) then e(2);
- i:=r1.i; p:=r1.p; c1:=r1.c1;
- if (c1<>'x') or (i<>40) or (p<>true) then e(3);
- r3.c1:='x'; r3.i:=40; r3.j:=50; r3.p:=true;
- if (r3.c1<>'x') or (r3.i<>40) or (r3.p<>true) then e(4);
- end;
-
-#endif
- procedure tst2207;
- { Intermediate level sets }
- begin t:=2207; pct := pct + 1;
- colors := [];
- colors := colors + [];
- if colors <> [] then e(1);
- colors := colors + [pink];
- if colors <> [pink] then e(2);
- colors := colors + [green];
- if colors <> [pink,green] then e(3);
- if colors <> [green,pink] then e(4);
- colors := colors - [pink];
- if colors <> [green] then e(5);
- beasts := [chicken] + [chicken,pig];
- if beasts <> [pig,chicken] then e(6);
- beasts := [] - [farmersdaughter];
- if beasts <> [] then e(7);
- bits := [0] + [1] - [0];
- if bits <> [1] then e(8);
- end;
-
-
- procedure tst2208;
- { Pointers }
- begin t:=2208; pct := pct + 1;
- new(p1); new(p2); new(p3); new(p4);
- p1^ := 1066;
- if p1^ <> 1066 then e(1);
- p2^.i := 1215;
- if p2^.i <> 1215 then e(2);
- p3^[0]:= 1566;
- if p3^[0] <> 1566 then e(3);
- p4^ := [pink];
- if p4^ <> [pink] then e(4);
- end;
-
-
- procedure tst2209;
- var i:integer;
- begin t:=2209; pct := pct + 1;
- head := nil;
- for i:= 1 to 100 do
- begin new(tail); tail^.val:=100+i; tail^.next :=head; head:= tail end;
- if (tail^.val<>200) or (tail^.next^.val<>199) then e(1);
- if tail^.next^.next^.next^.next^.next^.next^.next^.next^.val<> 192 then e(2);
- tail^.next^.next^.next^.val := 30;
- if tail^.next^.next^.next^.val <> 30 then e(3);
- end;
-begin t:=22; pct:=pct+1;
-#ifndef NOFLOAT
- tst2201; tst2202; tst2203; tst2204; tst2205; tst2206;
-#else
- tst2201; tst2203; tst2204; tst2205; tst2206;
-#endif
- tst2207; tst2208; tst2209;
-end;
-
-
-
-
-
-{************************************************************************}
-procedure tst25;
-{ Statement sequencing }
-label 0,1,2,3;
- procedure tst2501;
- begin t:=2501;
- goto 0;
- e(1);
- end;
-begin t:=25; pct:=pct+1;
- tst2501;
- e(1);
- 0:
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- i:=0;
-1: if i>10 then goto 3 else goto 2;
- e(2);
-2: i:=i+1; goto 1;
- e(3);
-3:
-end;
-
-
-
-
-{************************************************************************}
-procedure tst26;
-{ More data structures }
-type x = array[1..5] of integer;
- ta = array [1..5] of array [1..5] of x;
- tb = array [1..5] of record p1: ^x; p2: ^x end;
- tr = record c: record b: record a: integer end end end ;
-
-var low,i,j,k:integer; a:ta; b:tb; r:tr; hi:integer;
-
-procedure tst2601(w:ta; x:tb; y:tr);
-var i,j,k: integer;
-begin t:=2601; pct:=pct+1;
- for i:= 1 to 5 do for j:= 1 to 5 do for k:=1 to 5 do
- if w[i][j][k] <> i*i + 7*j + k then e(1);
- if (x[1].p1^[1] <> -9) or (x[2].p2^[4]<> -39) then e(2);
- if y.c.b.a <> 102 then e(3);
-end;
-
-begin t:=26; pct:=pct+1;
- low := 1000; hi := 1001;
- for i:= 1 to 5 do for j:=1 to 5 do for k:= 1 to 5 do a[i][j][k] :=i*i+7*j+k;
- new(b[1].p1); new(b[2].p2);
- b[1].p1^[1] := -9; b[2].p2^[4] := -39;
- r.c.b.a := 102;
- tst2601(a,b,r);
- t:=26;
- if(low <> 1000) or (hi <> 1001) then e(1);
-end;
-
-
-
-{************************************************************************}
-procedure tst27;
-{ Assignments }
-begin t:=27; pct := pct+1;
- i:=3; j:=2; k:= -100;
- l:= 1+(i*(j+(i*(j+(i*(j+(i*(3+j*(i*1+j*2)))))))));
- if l <> 1456 then e(1);
- l:= ((((((((((((((((((((((((((((((((0))))))))))))))))))))))))))))))));
- if l <> 0 then e(2);
- l:=(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)
- + (((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10)*(((i*j)+(3*i)-5) div 10);
- if l <> 2 then e(3);
-
- l:=((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3)+
- ((j+j) div 4) * ((j+j) div 4) * ((j+j) div 4)* (j div 3 + j div 4 + 3);
- if l <> 6 then e(4);
- i:=j*j*j*j*j*j*j*j*j*j*j*j*j*j - 16383;
- if i <>1 then e(5);
- l:=(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i+(i))))))))))))))));
- if l <> 16 then e(6);
- l:= (((((((((((((((((j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j)+j);
- if l <> 34 then e(7);
- l:= (-(-(-(-(-(-(-(-(-(j))))))))));
- if l <> -2 then e(8);
-
-#ifndef NOFLOAT
- x:= 0.1; y:=0.2; z:=0.3;
- w:=(((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
- ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
- ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
- ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0))*
- ((((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)+(((x+y)/z)*2.0)))-1;
- if abs(w-32767) > 0.0001 then e(9);
-
- i:= trunc(100*y+0.5); if i <> 20 then e(10);
- i:= 32767; w:=i; if w <> 32767 then e(11);
-#endif
-end;
-
-
-
-{************************************************************************}
-procedure tst28;
-{ Calls }
-var i:integer;
-function ack(m,n:integer):integer;
-begin if m=0
- then ack := n+1
- else if n=0
- then ack := ack(m-1,1)
- else ack := ack(m-1,ack(m,n-1))
-end;
-
-procedure fib(a:integer; var b:integer); { Fibonacci nrs }
-var i,j:integer;
-begin
- if (a=1) or (a=2) then b:=1 else
- begin fib(a-1,i); fib(a-2,j); b:=i+j end
-end;
-
-begin t:=28; pct:= pct+1;
- if ack(2,2) <> 7 then e(1);
- if ack(3,3) <> 61 then e(2);
- if ack(3,5) <> 253 then e(3);
- if ack(2,100) <> 203 then e(4);
- fib(10,i); if i <> 55 then e(5);
- fib(20,i); if i <> 6765 then e(6);
-end;
-
-
-{************************************************************************}
-procedure tst29;
-{ Loops }
-var i,l:integer; p:boolean;
-begin t:= 29; pct:=pct+1;
- j:=5;
- k:=0; for i:=1 to j do k:=k+1; if k<>5 then e(1);
- k:=0; for i:=5 to j do k:=k+1; if k<>1 then e(2);
- k:=0; for i:=6 to j do k:=k+1; if k<>0 then e(3);
- k:=0; for i:=-1 downto -j do k:=k+1; if k<>5 then e(4);
- k:=0; for i:=-5 downto -j do k:=k+1; if k<>1 then e(5);
- k:=0; for i:=-6 downto j do k:=k+1; if k<>0 then e(6);
- k:=0; for i:=1 downto 10 do k:=k+1; if k<>0 then e(7);
-
- k:=0; for l:=1 to j do k:=k+1; if k<>5 then e(8);
- k:=0; for l:=5 to j do k:=k+1; if k<>1 then e(9);
- k:=0; for l:=6 to j do k:=k+1; if k<>0 then e(10);
- k:=0; for l:=-1 downto -j do k:=k+1; if k<>5 then e(11);
- k:=0; for l:=-5 downto -j do k:=k+1; if k<>1 then e(12);
- k:=0; for l:=-6 downto j do k:=k+1; if k<>0 then e(13);
- k:=0; for l:=1 downto 10 do k:=k+1; if k<>0 then e(14);
- k:=0; for p:= true downto false do k:=k+1; if k<>2 then e(15);
- k:=0; for p:= false to true do k:=k+1; if k<>2 then e(16);
-
- k:=0; while k<0 do k:=k+1; if k<>0 then e(17);
- k:=0; repeat k:=k+1; until k>0; if k<> 1 then e(18);
- k:=0; repeat k:=k+1; until k > 15; if k <> 16 then e(18);
- k:=0; while k<=10 do k:=k+1; if k<> 11 then e(19);
-end;
-
-{************************************************************************}
-procedure tst30;
-{ case statements }
-begin t:=30; pct:=pct+1;
- i:=3; k:=0;
- case i*i-7 of
- 0: k:=0; 1: k:=0; 2: k:=1; 3,4: k:=0
- end;
- if k<>1 then e(1);
-
- color := red; k:=0;
- case color of
- red: k:=1; blue: k:=0; yellow: k:=0
- end;
- if k<>1 then e(2);
-
- k:=0;
- case color of
- red,blue: k:=1; yellow: k:=0
- end;
- if k<>1 then e(3);
-end;
-#ifndef NOFLOAT
-
-{************************************************************************}
-procedure tst31;
-{ with statements }
-var ra: record i:integer; x:real; p:tp2; q:single;
- a2: record a3: tp2 end
- end;
- rb: record j: integer; y:real; pp:tp2; qq:single end;
-begin t:=31; pct:=pct+1;
- i:=0; x:=0;
- ra.i:=-3006; ra.x:=-6000.23; ra.q[0]:=35; ra.p.i:=20;
- with ra do
- begin if (i<>-3006) or (x<>-6000.23) or (q[0]<>35)
- or (p.i<>20) then e(2);
-
- i:=300; x:= 200.5; q[0]:=35; p.i:=-10
- end;
- if (ra.i<>300) or (ra.x<>200.5) or (ra.q[0]<>35) or (ra.p.i<>-10) then e(3);
- with ra.p do if i <> -10 then e(4);
-
- i:= -23;
- ra.a2.a3.i := -909;
- with ra do if a2.a3.i <> -909 then e(5);
- with ra.a2 do if a3.i <> -909 then e(6);
- with ra.a2.a3 do if i <> -909 then e(7);
- with ra.a2 do i:=5;
- if (i<>5) or (ra.a2.a3.i <> -909) then e(8);
- with ra.a2.a3 do i:= 6;
- if i<>5 then e(9);
- if ra.a2.a3.i <> 6 then e(10);
-
- with ra,rb do
- begin x:=3.5; y:=6.5; i:=3; j:=9 end;
- if (ra.x<>3.5) or (rb.y<>6.5) or (ra.i<>3) or (rb.j<>9) then e(11);
-end;
-
-#else
-
-{************************************************************************}
-procedure tst31;
-{ with statements }
-var ra: record i:integer; p:tp2; q:single;
- a2: record a3: tp2 end
- end;
- rb: record j: integer; pp:tp2; qq:single end;
-begin t:=31; pct:=pct+1;
-#ifndef NOFLOAT
- i:=0; x:=0;
-#else
- i:=0;
-#endif
- ra.i:=-3006; ra.q[0]:=35; ra.p.i:=20;
- with ra do
- begin if (i<>-3006) or (q[0]<>35)
- or (p.i<>20) then e(2);
-
- i:=300; q[0]:=35; p.i:=-10
- end;
- if (ra.i<>300) or (ra.q[0]<>35) or (ra.p.i<>-10) then e(3);
- with ra.p do if i <> -10 then e(4);
-
- i:= -23;
- ra.a2.a3.i := -909;
- with ra do if a2.a3.i <> -909 then e(5);
- with ra.a2 do if a3.i <> -909 then e(6);
- with ra.a2.a3 do if i <> -909 then e(7);
- with ra.a2 do i:=5;
- if (i<>5) or (ra.a2.a3.i <> -909) then e(8);
- with ra.a2.a3 do i:= 6;
- if i<>5 then e(9);
- if ra.a2.a3.i <> 6 then e(10);
-
- with ra,rb do
- begin i:=3; j:=9 end;
- if (ra.i<>3) or (rb.j<>9) then e(11);
-end;
-
-
-#endif
-
-
-
-
-
-
-{************************************************************************}
-procedure tst32;
-{ Standard procedures }
-begin t:=32; pct:=pct+1;
- if abs(-1) <> 1 then e(1);
- i:= -5; if abs(i) <> 5 then e(2);
-#ifndef NOFLOAT
- x:=-2.0; if abs(x) <> 2.0 then e(3);
-#endif
- if odd(5) = false then e(4);
- if odd(4) then e(5);
- if sqr(i) <> 25 then e(6);
- if succ(i) <> -4 then e(7);
- if succ(red) <> blue then e(8);
- if pred(blue) <> red then e(9);
- if ord(red) <> 0 then e(10);
- if ord(succ(succ(red))) <> 2 then e(11);
- if chr(ord(chr(ord(chr(ord('u')))))) <> 'u' then e(12);
- if ord(chr(ord(chr(ord(chr(50)))))) <> 50 then e(13);
-#ifndef NOFLOAT
- if abs(trunc(5.2)-5.0) > eps then e(14);
- if abs(sin(3.1415926536)) > 10*eps then e(15);
- if abs(exp(1.0)-2.7182818) > 0.0001 then e(16);
- if abs(ln(exp(1.0))- 1.0) > 3*eps then e(17);
- if abs(sqrt(25.0)-5.0) > eps then e(18);
- if abs(arctan(1.0) - 3.1415926535/4.0) > 0.0001 then e(19);
- if abs(ln(arctan(1)*4) - 1.144729886) > 0.000001 then e(20);
- if abs(sin(1) - 0.841470985 ) > 0.000001 then e(21);
- if abs(cos(1) - 0.540302306) > 0.000001 then e(22);
- if abs(sqrt(2) - 1.4142135623) > 0.000001 then e(23);
- if abs(sqrt(10) - 3.1622776601) > 0.000001 then e(24);
- if abs(sqrt(1000.0) - 31.622776602) > 0.00001 then e(25);
-#endif
-end;
-
-
-{***************************************************************************}
-procedure tst33;
-{ Functions }
-var i,j,k,l,m: integer;
-begin t:=33; pct := pct+1;
- i:=1; j:=2; k:=3; l:=4; m:=10;
- if twice(k) <> m-l then e(1);
- if twice(1) <> 2 then e(2);
- if twice(k+1) <> twice(l) then e(3);
- if twice(twice(twice(inc(twice(inc(3)))))) <> 72 then e(4);
- if twice(inc(j+twice(inc(twice(i+1+inc(k)+inc(k))+twice(2)))))<>106
- then e(5);
- if twice(1) + twice(2) * twice(3) <> 26 then e(6);
- if 3 <> 0 + twice(1) + 1 then e(7);
- if 0 <> 0 * twice(m) then e(8);
-end;
-
-
-
-{**********************************************************************}
-
-{ Main Program }
-begin ect := 0; pct := 0;
-tst21; tst22; tst25; tst26; tst27; tst28; tst29; tst30; tst31; tst32; tst33;
-
-write('Program t2:',pct:3,' tests completed.');
-writeln('Number of errors = ',ect:0);
-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
-
-}
-{$i64 : sets of integers contain 64 bits}
-program t3(input,output,f1,f2,f3,f4,f5,f6);
-
-{ The Berkeley and EM-1 compilers both can handle this program }
-
-const rcsversion='$Header$';
-type wavelength = (red,blue,yellow,q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11,
- pink,green,orange);
- spectrum= set of wavelength;
- bit = 0..1;
- tp3= packed record c1:char; i:integer; p:boolean; x:real end;
- tp4= record c1:char; i:integer; p:boolean; x:real end;
- vec1 = array [-10..+10] of integer;
- vrec = record case t:boolean of false:(r:real); true:(b:bit) end;
-
-var t,pct,ect:integer;
- i,j,k,l:integer;
- x,y: real;
- p:boolean;
- c2:char;
- a1: vec1;
- c: array [1..20] of char;
- r3: tp3;
- r4: tp4;
- vr: vrec;
- colors: spectrum;
- letters,cset:set of char;
- f1: text;
- f2: file of spectrum;
- f3: file of tp3;
- f4: file of tp4;
- f5: file of vec1;
- f6: file of vrec;
-
-
-
-procedure e(n:integer);
-begin
- ect := ect + 1;
- writeln(' Error', n:3,' in test ', t)
-end;
-
-
-
-
-
-
-
-
-{************************************************************************}
-procedure tst34;
-{ Global files }
-var i:integer; c1:char;
-begin t:=34; pct := pct + 1;
- rewrite(f1);
- if not eof(f1) then e(1);
- write(f1,'abc',20+7:2,'a':2); writeln(f1);
- write(f1,'xyz');
- i:=-3000; write(f1,i:5);
- reset(f1);
- if eof(f1) or eoln(f1) then e(2);
- for i:=1 to 17 do read(f1,c[i]);
- if(c[1]<>'a') or (c[3]<>'c') or (c[5]<>'7') or (c[8]<>' ') or
- (c[12]<>'-') or (c[13]<>'3') or (c[16]<>'0') then e(3);
- if not eof(f1) then e(4);
- rewrite(f1);
- for i:= 32 to 127 do write(f1,chr(i));
- reset(f1); p:= false;
- for i:= 32 to 127 do begin read(f1,c1); if ord(c1) <> i then p:=true end;
- if p then e(5);
- rewrite(f1);
- for c1 := 'a' to 'z' do write(f1,c1);
- reset(f1); p:= false;
- for c1 := 'a' to 'z' do begin read(f1,c2); if c2 <> c1 then p:=true end;
- if p then e(6);
-end;
-
-procedure tst36;
-var i,j:integer;
-begin t:=36; pct:=pct+1;
- rewrite(f2); rewrite(f3); rewrite(f4); rewrite(f5); rewrite(f6);
- colors := []; f2^ := colors; put(f2);
- colors := [red]; f2^ := colors; put(f2);
- colors := [red,blue]; f2^ := colors; put(f2);
- colors := [yellow,blue]; f2^ := colors; put(f2);
- reset(f2);
- colors := f2^; get(f2); if colors <> [] then e(4);
- colors := f2^; get(f2); if colors <> [red] then e(5);
- colors := f2^; get(f2); if colors <> [blue,red] then e(6);
- colors := f2^; get(f2); if colors <> [blue,yellow] then e(7);
- r3.c1:='w'; r3.i:= -100; r3.x:=303.56; r3.p:=true; f3^:=r3; put(f3);
- r3.c1:='y'; r3.i:= -35; r3.x:=26.32; f3^:=r3; put(f3);
- r3.c1:='q'; r3.i:= +29; r3.x:=10.00; f3^:=r3; put(f3);
- r3.c1:='j'; r3.i:= 8; r3.x:=10000; f3^:=r3; put(f3);
- for i:= 1 to 1000 do begin f3^ := r3; put(f3) end;
- reset(f3);
- r3 := f3^; get(f3);
- if (r3.c1<>'w') or (r3.i<>-100) or (r3.x<>303.56) then e(8);
- r3 := f3^; get(f3);
- if (r3.c1<>'y') or (r3.i<> -35) or (r3.x<> 26.32) then e(9);
- r3 := f3^; get(f3);
- if (r3.c1<>'q') or (r3.i<> 29) or (r3.x<> 10.00) then e(10);
- r3 := f3^; get(f3);
- if (r3.c1<>'j') or (r3.i<> 8) or (r3.x<> 10000) then e(11);
-
- r4.c1:='w'; r4.i:= -100; r4.x:=303.56; r4.p:=true; f4^:=r4; put(f4);
- r4.c1:='y'; r4.i:= -35; r4.x:=26.32; f4^:=r4; put(f4);
- r4.c1:='q'; r4.i:= +29; r4.x:=10.00; f4^:=r4; put(f4);
- r4.c1:='j'; r4.i:= 8; r4.x:=10000; f4^:=r4; put(f4);
- for i:= 1 to 1000 do begin f4^ := r4; put(f4) end;
- reset(f4);
- r4 := f4^; get(f4);
- if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
- r4 := f4^; get(f4);
- if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
- r4 := f4^; get(f4);
- if (r4.c1<>'q') or (r4.i<> 29) or (r4.x<> 10.00) then e(13);
- r4 := f4^; get(f4);
- if (r4.c1<>'j') or (r4.i<> 8) or (r4.x<> 10000) then e(14);
-
- for j:= 1 to 100 do
- begin for i:= -10 to +10 do a1[i] := i*j; f5^ := a1; put(f5); end;
- reset(f5);
- for j:= 1 to 99 do
- begin a1:=f5^; get(f5); for i:= -10 to +10 do if a1[i]<> i*j then e(14) end;
-
- vr.t:=false;
- for i:= 1 to 1000 do begin vr.r:=i+0.5; f6^:=vr; put(f6) ; p:=true; end;
- reset(f6); p:=false;
- for i:= 1 to 999 do
- begin vr:=f6^; get(f6); if vr.r <> i+0.5 then p:=true end;
- if p then e(15);
- rewrite(f6);
- if not eof(f6) then e(16);
- for i:= 1 to 1000 do begin vr.b:=i mod 2; f6^:=vr; put(f6) end;
- reset(f6);
- if eof(f6) then e(17);
- p:=false;
- for i:= 1 to 1000 do
- begin vr:=f6^; get(f6); if vr.b <> i mod 2 then p:=true end;
- if not eof(f6) then e(18);
- if p then e(19);
-
- rewrite(f1);
- f1^:=chr(10);
- put(f1);
- reset(f1);
- if ord(f1^) <> 32 then e(20);
-
- rewrite(f1);
- x:=0.0625; write(f1,x:6:4, x:6:2);
- reset(f1); read(f1,y); if y <> 0.0625 then e(21);
- reset(f1); for i:= 1 to 12 do begin c[i]:= f1^; get(f1) end;
- if (c[1]<>'0') or (c[2]<>'.') or (c[4]<>'6') then e(22);
- if (c[7]<>' ') or (c[9]<>'0') or (c[10]<>'.') or (c[12]<>'6') then e(23);
-end;
-
-{************************************************************************}
-procedure tst35;
-{ Local files }
-var g1: text;
- g2: file of spectrum;
- g3: file of tp4;
- g4: file of vec1;
- i,j:integer;
- begin t:=35; pct := pct + 1;
- rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
- if (not (eof(g1) and eof(g4))) then e(1);
- writeln(g1,'abc', 20+7:2,'a':2);
- write(g1,'xyz');
- reset(g1);
- if eof(g1) or eoln(g1) then e(2);
- read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
- if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
- if not eoln(g1) then e(4)
- else readln(g1);
- for i:=1 to 2 do read(g1,c[8+i]);
- if c[10]<>'y' then e(5);
- if eof(g1) or eoln(g1) then e(6);
- colors := []; g2^ := colors; put(g2);
- colors := [pink]; g2^ := colors; put(g2);
- colors := [pink,green]; g2^ := colors; put(g2);
- colors := [orange,green]; g2^ := colors; put(g2);
- reset(g2);
- colors := g2^; get(g2); if colors <> [] then e(7);
- colors := g2^; get(g2); if colors <> [pink] then e(8);
- colors := g2^; get(g2); if colors <> [green,pink] then e(9);
- colors := g2^; get(g2); if colors <> [green,orange] then e(10);
- r4.c1:='w'; r4.i:= -100; r4.x:=303.56; g3^:=r4; put(g3);
- r4.c1:='y'; r4.i:= -35; r4.x:=26.32; g3^:=r4; put(g3);
- r4.c1:='q'; r4.i:= +29; r4.x:=10.00; g3^:=r4; put(g3);
- r4.c1:='j'; r4.i:= 8; r4.x:=10000; g3^:=r4; put(g3);
- for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
- reset(g3);
- if eof(g3) then e(11);
- r4 := g3^; get(g3);
- if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
- r4 := g3^; get(g3);
- if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
- r4 := g3^; get(g3);
- if (r4.c1<>'q') or (r4.i<> 29) or (r4.x<> 10.00) then e(14);
- r4 := g3^; get(g3);
- if (r4.c1<>'j') or (r4.i<> 8) or (r4.x<> 10000) then e(15);
-
- for j:= 1 to 100 do
- begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
- reset(g4);
- for j:= 1 to 100 do
- begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
- if not eof(g2) then e(17);
-colors:=[q1,q2,q3,q4,q5,q6,q7,q8,q9,q10,q11];
-end;
-
-
-{***********************************************************************}
-procedure tst37;
-{ Intermediate level files }
-var g1: text;
- g2: file of spectrum;
- g3: file of tp4;
- g4: file of vec1;
-
- procedure tst3701;
- var i,j:integer;
- begin t:=3701; pct := pct + 1;
- rewrite(g1); rewrite(g2); rewrite(g3); rewrite(g4);
- if (not (eof(g1) and eof(g4))) then e(1);
- writeln(g1,'abc', 20+7:2,'a':2);
- write(g1,'xyz');
- reset(g1);
- if eof(g1) or eoln(g1) then e(2);
- read(g1,c[1]); read(g1,c[2]); read(g1,c[3],c[4],c[5],c[6],c[7]);
- if (c[1]<>'a') or (c[3]<>'c') or (c[4]<>'2') or (c[7]<>'a') then e(3);
- if not eoln(g1) then e(4)
- else readln(g1);
- for i:=1 to 2 do read(g1,c[8+i]);
- if c[10]<>'y' then e(5);
- if eof(g1) or eoln(g1) then e(6);
- colors := []; g2^ := colors; put(g2);
- colors := [pink]; g2^ := colors; put(g2);
- colors := [pink,green]; g2^ := colors; put(g2);
- colors := [orange,green]; g2^ := colors; put(g2);
- reset(g2);
- colors := g2^; get(g2); if colors <> [] then e(7);
- colors := g2^; get(g2); if colors <> [pink] then e(8);
- colors := g2^; get(g2); if colors <> [green,pink] then e(9);
- colors := g2^; get(g2); if colors <> [green,orange] then e(10);
- r4.c1:='w'; r4.i:= -100; r4.x:=303.56; g3^:=r4; put(g3);
- r4.c1:='y'; r4.i:= -35; r4.x:=26.32; g3^:=r4; put(g3);
- r4.c1:='q'; r4.i:= +29; r4.x:=10.00; g3^:=r4; put(g3);
- r4.c1:='j'; r4.i:= 8; r4.x:=10000; g3^:=r4; put(g3);
- for i:= 1 to 1000 do begin g3^ := r4; put(g3) end;
- reset(g3);
- if eof(g3) then e(11);
- r4 := g3^; get(g3);
- if (r4.c1<>'w') or (r4.i<>-100) or (r4.x<>303.56) then e(12);
- r4 := g3^; get(g3);
- if (r4.c1<>'y') or (r4.i<> -35) or (r4.x<> 26.32) then e(13);
- r4 := g3^; get(g3);
- if (r4.c1<>'q') or (r4.i<> 29) or (r4.x<> 10.00) then e(14);
- r4 := g3^; get(g3);
- if (r4.c1<>'j') or (r4.i<> 8) or (r4.x<> 10000) then e(15);
-
- for j:= 1 to 100 do
- begin for i:= -10 to +10 do a1[i] := i*j; g4^ := a1; put(g4) end;
- reset(g4);
- for j:= 1 to 100 do
- begin a1:=g4^; get(g4); for i:= -10 to +10 do if a1[i]<>i*j then e(16) end;
- end;
-
-begin t:=37; pct := pct+1;
- tst3701;
- t:=37;
- if not eof(g2) then e(1);
-end;
-
-
-
-{***********************************************************************}
-procedure tst38;
-{ Advanced set theory }
-begin t:=38; pct := pct + 1;
- if [50] >= [49,51] then e(1);
- if [10] <= [9,11] then e(2);
- if not ([50] <= [49..51]) then e(3);
- i:=1; j:=2; k:=3; l:=5;
- if [i] + [j] <> [i,j] then e(4);
- if [i] + [j] <> [i..j] then e(5);
- if [j..i] <> [] then e(6);
- if [j..l] + [j..k] <> [2,3,4,5] then e(7);
- if ([1..k, l..8] + [10]) * [k..7, 2, l] <> [2,3,l..7] then e(8);
- if [i..9] - [j..l] <> [1,l+1..k*k] then e(9);
- if [k..j] <> [i..j] * [k..l] then e(10);
- if not ([k..10] <= [i..15]) then e(11);
- if not ([k-1..k*l] <= [i..15]) then e(12);
-
- letters := ['a','b', 'z'];
- if letters <> ['a', 'b', 'z'] then e(13);
- cset := ['a'] + ['b', 'c', 'z'] - ['c','d'];
- if cset <> letters then e(14);
- cset := ['a'..'e'];
- if cset <> ['a', 'b', 'c', 'd', 'e'] then e(15);
- cset := ['a'..'z', '0'..'9', '+','-','*','/','.',':','(',')','{','}'];
- if not ('+' in cset) or not ('.' in cset) or not ('}' in cset) then e(16);
- letters := ['a'..'z' , '0'..'9'];
- if letters >= cset then e(17);
-end;
-
-
-{***********************************************************************}
-
-{ Main program }
-begin ect:=0; pct:=0;
- tst34; tst35; tst36; tst37; tst38;
- write('Program t3:',pct:3,' tests completed.');
- writeln('Number of errors = ',ect:0);
-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
-
-}
-
-program t4(input,output);
-{ Tests for the EM-1 compiler }
-const rcsversion='$Header$';
-type vec = array[1..1000] of integer;
- spectrum = set of (red,blue,yellow);
-#ifndef NOFLOAT
- tp2 = record c1:char;i,j:integer; p:boolean; x:real end;
-#else
- tp2 = record c1:char;i,j:integer; p:boolean end;
-#endif
- cmat = array[0..3,0..7] of ^spectrum;
- single = array [0..0] of integer;
- np = ^node;
- node = record val: integer; next: np end;
-
-var t,ect,pct:integer;
- r1: tp2;
- pt1,pt2: ^vec;
- pt3:^integer;
- mk: ^integer;
- i,j: integer;
-
-
-
-procedure e(n:integer);
-begin
- ect := ect + 1;
- writeln(' Error', n:3,' in test ', t)
-end;
-
-function inc(k:integer):integer; begin inc := k+1 end;
-function twice(k:integer):integer; begin twice := 2*k end;
-function decr(k:integer):integer; begin decr := k-1 end;
-
-
-
-procedure tst40;
-{ Mark and Release }
-var i:integer;
- procedure grab;
- var i:integer;
- begin
- for i:=1 to 10 do new(pt1);
- for i:=1 to 1000 do new(pt3);
- end;
-
-begin t:= 40; pct:=pct+1;
- for i:=1 to 10 do
- begin
- mark(mk);
- new(pt2);
- grab;
- release(mk)
- end;
-end;
-
-
-procedure tst41;
-{ Empty sets }
-begin t:=41; pct := pct + 1;
- if red in [] then e(1);
- if ([] <> []) then e(2);
- if not ([] = []) then e(3);
- if not([] <=[]) then e(4);
- if not ( [] >= []) then e(5);
-end;
-
-
-{************************************************************************}
-procedure tst42;
-{ Record variants. These tests are machine dependent }
-var s:record b:boolean; case t:boolean of false:(c:char);true:(d:cmat) end;
- w: packed record
- case z:boolean of
- false: (x:array[0..20] of integer);
- true: (a,b,c,d,e,f,g,h,i,j,k,l:char)
- end;
-
- y: record
- case z:boolean of
- false: (x:array[0..20] of integer);
- true: (a,b,c,d,e,f,g,h,i,j,k,l:char)
- end;
- i:integer;
-begin t:=42; pct:=pct+1;
- s.t:=false; s.c:='x'; if s.c <> 'x' then e(1);
- for i:=0 to 20 do begin w.x[i]:=-1; y.x[i]:=-1 end;
- w.a:=chr(0); w.f:=chr(0);
- y.a:=chr(0); y.f:=chr(0);
- if (ord(w.a) <> 0) or (ord(w.b) <> 255) then e(3);
- if (ord(w.c) <> 255) or (ord(w.d)<>255) then e(4);
- if (ord(w.e) <> 255) or (ord(w.f) <> 0) then e(5);
- if ord(y.a) <> 0 then e(6);
- if ord(y.f) <> 0 then e(7);
-end;
-
-
-
-
-{************************************************************************}
-procedure tst43;
-{ Procedure and function parameters }
- function incr(k:integer):integer; begin incr := k+1 end;
- function double(k:integer):integer; begin double := 2*k end;
- function eval(function f(a:integer):integer; a:integer):integer;
- begin eval:=f(a) end;
- function apply(function f(a:integer):integer; a:integer):integer;
- begin apply:=eval(f,a) end;
-
- procedure x1(function f(a:integer):integer; a:integer; var r:integer);
- procedure x2(function g(c:integer):integer; b:integer; var s:integer);
- begin s:=apply(g,b); end;
- begin x2(f, a+a, r) end;
-
-procedure p0(procedure p(x:integer); i,j:integer);
-begin
- if j=0 then p(i) else p0(p,i+j,j-1)
-end;
-
-procedure p1(a,b,c,d:integer);
-var k:integer;
- procedure p2(x:integer);
- begin k:= x*x end;
-begin k:=0;
- p0(p2,a,b);
- if k <> c then e(d);
-end;
-
-
-
-begin t:=43; pct := pct+1;
- i:=10; j:=20;
- if incr(0) <> 1 then e(1);
- if decr(i) <> 9 then e(2);
- if double(i+j) <> 60 then e(3);
- if incr(double(j)) <> 41 then e(4);
- if decr(double(incr(double(i)))) <> 41 then e(5);
- if incr(incr(incr(incr(incr(5))))) <> 10 then e(6);
- if eval(incr,i) <> 11 then e(7);
- if eval(decr,3) <> 2 then e(8);
- if incr(eval(double,15)) <> 31 then e(9);
- if apply(incr,3) <> 4 then e(10);
-
- x1(double,i,j); if j <> 40 then e(11);
- x1(incr,i+3,j); if j <> 27 then e(12);
- p1(3,5,324,13);
- p1(10,4,400,14);
- p1(1,8,1369,15);
- j:=1;
- if inc(incr(twice(double(inc(incr(twice(double(j)))))))) <> 26 then e(13);
-end;
-
-
-{************************************************************************}
- procedure tst44;
-{ Value parameters }
- type ww2 = array[-10..+10] of tp2;
- arra = array[-10..+10] of integer;
- reca = record k:single; s:spectrum end;
- pa = np;
-#ifndef NOFLOAT
-var l1:integer; xr:real; xb:boolean; xc:char; xar:cmat; xnode:pa;
-#else
-var l1:integer; xb:boolean; xc:char; xar:cmat; xnode:pa;
-#endif
- vec1: arra; vec2: ww2;
- s2:spectrum; rec1: reca;
- zero:0..0;
-
-#ifndef NOFLOAT
-procedure tst4401(pl1:integer; pxr:real; pxb:boolean; pxc:char;
-#else
-procedure tst4401(pl1:integer; pxb:boolean; pxc:char;
-#endif
- pxar:cmat; pxnode:pa; pxtp2:tp2;
- pvec1:arra; pvec2:ww2; prec1:reca;
- ps1,ps2:spectrum; psin:single; i,j:integer);
-begin t:=4401; pct:=pct+1;
- if pl1<>29 then e(1);
-#ifndef NOFLOAT
- if pxr<>-0.31 then e(2);
-#endif
- if pxb <> false then e(3);
- if pxc <> 'k' then e(4);
- if (pxar[1,1]^<>[red,blue]) or (pxar[2,2]^ <> [yellow]) then e(5);
- if (pxnode^.val <> 105) or (pxnode^.next^.val <> 106) then e(6);
-#ifndef NOFLOAT
- if (pxtp2.c1 <> 'w') or (pxtp2.x <> 20.3) then e(7);
-#else
- if (pxtp2.c1 <> 'w') then e(7);
-#endif
- if pvec1[10] <> -996 then e(8);
-#ifndef NOFLOAT
- if pvec2[zero].x <> -300 then e(9);
-#endif
- if (prec1.k[zero] <> -421) or (prec1.s <> []) then e(10);
- if (ps1<>[]) or (ps2<>[red]) then e(11);
- if psin[zero] <> -421 then e(12);
- if i <> -421 then e(13);
- if j <> 106 then e(14);
-
- pl1:=0; pxc:=' '; pxb:=true;
- pxar[1,1]^:=[]; pxar[2,2]^:=[];
- pxnode^.val:=0; pxnode^.next^.val:=1;
- pxtp2.c1:=' ';
- pvec1[10]:=0;
-#ifndef NOFLOAT
- pvec2[zero].x:=0;
-#endif
- prec1.k[zero]:=0;
- psin[0]:=0; i:=0; j:=0;
-end;
-
-begin t:=44; pct:=pct+1;
- zero:=0;
-#ifndef NOFLOAT
- l1:=29; xr:=-0.31; xb:=false; xc:='k';
-#else
- l1:=29; xb:=false; xc:='k';
-#endif
- new(xar[1,1]); xar[1,1]^ := [red,blue];
- new(xar[2,2]); xar[2,2]^ := [yellow];
- new(xar[1,2]); xar[1,2]^ := [yellow];
- new(xnode); xnode^.val :=105;
- new(xnode^.next); xnode^.next^.val :=106;
-#ifndef NOFLOAT
- r1.c1:='w'; r1.x:=20.3;
- vec1[10] := -996; vec2[zero].x := -300;
-#else
- r1.c1:='w';
- vec1[10] := -996;
-#endif
- rec1.k[zero]:=-421; rec1.s :=[];
- s2:=[red];
-
-#ifndef NOFLOAT
- tst4401(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
-#else
- tst4401(l1, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
-#endif
- [], s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
- t:=44;
-
- if l1<>29 then e(1);
-#ifndef NOFLOAT
- if xr<> -0.31 then e(2);
-#endif
- if xb <> false then e(3);
- if xc <> 'k' then e(4);
- if (xar[1,1]^ <> []) or (xar[2,2]^ <> []) then e(5);
- if xar[1,2]^ <> [yellow] then e(6);
- if (xnode^.val <> 0) or (xnode^.next^.val <> 1) then e(7);
-#ifndef NOFLOAT
- if (r1.c1 <> 'w') or (r1.x <> 20.3) then e(8);
-#else
- if (r1.c1 <> 'w') then e(8);
-#endif
- if vec1[10] <> -996 then e(9);
-#ifndef NOFLOAT
- if vec2[zero].x <> -300 then e(10);
-#endif
- if (rec1.k[zero] <> -421) or (rec1.s <> []) then e(11);
- if s2 <> [red] then e(12);
-end;
-
-
-{************************************************************************}
- procedure tst45;
-{ Var parameters }
- type ww2 = array[-10..+10] of tp2;
- arra = array[-10..+10] of integer;
- reca = record k:single; s:spectrum end;
- pa = np;
-#ifndef NOFLOAT
-var l1:integer; xr:real; xb:boolean; xc:char; xar:cmat; xnode:pa;
-#else
-var l1:integer; xb:boolean; xc:char; xar:cmat; xnode:pa;
-#endif
- vec1: arra; vec2: ww2;
- s1,s2:spectrum; rec1: reca;
- zero:0..0;
-
-#ifndef NOFLOAT
-procedure tst4501(var pl1:integer; var pxr:real; var pxb:boolean; var pxc:char;
-#else
-procedure tst4501(var pl1:integer; var pxb:boolean; var pxc:char;
-#endif
- var pxar:cmat; var pxnode:pa; var pxtp2:tp2;
- var pvec1:arra; var pvec2:ww2; var prec1:reca;
- var ps1,ps2:spectrum; var psin:single; var i,j:integer);
-begin t:=4501; pct:=pct+1;
- if pl1<>29 then e(1);
-#ifndef NOFLOAT
- if pxr<>-0.31 then e(2);
-#endif
- if pxb <> false then e(3);
- if pxc <> 'k' then e(4);
- if (pxar[1,1]^<>[red,blue]) or (pxar[2,2]^ <> [yellow]) then e(5);
- if (pxnode^.val <> 105) or (pxnode^.next^.val <> 106) then e(6);
-#ifndef NOFLOAT
- if (pxtp2.c1 <> 'w') or (pxtp2.x <> 20.3) then e(7);
-#else
- if (pxtp2.c1 <> 'w') then e(7);
-#endif
- if pvec1[10] <> -996 then e(8);
-#ifndef NOFLOAT
- if pvec2[zero].x <> -300 then e(9);
-#endif
- if (prec1.k[zero] <> -421) or (prec1.s <> []) then e(10);
- if (ps1<>[]) or (ps2<>[red]) then e(11);
- if psin[zero] <> -421 then e(12);
- if i <> -421 then e(13);
- if j <> 106 then e(14);
-
-#ifndef NOFLOAT
- pl1:=0; pxr:=0; pxc:=' '; pxb:=true;
-#else
- pl1:=0; pxc:=' '; pxb:=true;
-#endif
- pxar[1,1]^:=[]; pxar[2,2]^:=[];
- pxnode^.val:=0; pxnode^.next^.val:=1;
- pxtp2.c1:=' ';
-#ifndef NOFLOAT
- pxtp2.x := 0;
-#endif
- pvec1[10]:=0;
-#ifndef NOFLOAT
- pvec2[zero].x:=0;
-#endif
- prec1.k[zero]:=0;
- psin[0]:=0; i:=223; j:=445;
-end;
-
-begin t:=45; pct:=pct+1;
- zero:=0;
-#ifndef NOFLOAT
- l1:=29; xr:=-0.31; xb:=false; xc:='k';
-#else
- l1:=29; xb:=false; xc:='k';
-#endif
- new(xar[1,1]); xar[1,1]^ := [red,blue];
- new(xar[2,2]); xar[2,2]^ := [yellow];
- new(xar[1,2]); xar[1,2]^ := [yellow];
- new(xnode); xnode^.val :=105;
- new(xnode^.next); xnode^.next^.val :=106;
-#ifndef NOFLOAT
- r1.c1:='w'; r1.x:=20.3;
- vec1[10] := -996; vec2[zero].x := -300;
-#else
- r1.c1:='w';
- vec1[10] := -996;
-#endif
- rec1.k[zero]:=-421; rec1.s :=[];
- s1:=[]; s2:=[red];
-
-#ifndef NOFLOAT
- tst4501(l1, xr, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
-#else
- tst4501(l1, xb, xc, xar, xnode, r1, vec1, vec2, rec1,
-#endif
- s1, s2, rec1.k, rec1.k[zero], xnode^.next^.val);;
- t:=45;
-
- if l1<>0 then e(1);
-#ifndef NOFLOAT
- if xr<> 0 then e(2);
-#endif
- if xb <> true then e(3);
- if xc <> ' ' then e(4);
- if (xar[1,1]^ <> []) or (xar[2,2]^ <> []) then e(5);
- if xar[1,2]^ <> [yellow] then e(6);
- if (xnode^.val <> 0) or (xnode^.next^.val <> 445) then e(7);
-#ifndef NOFLOAT
- if (r1.c1 <> ' ') or (r1.x <> 0) then e(8);
-#else
- if (r1.c1 <> ' ') then e(8);
-#endif
- if vec1[10] <> 0 then e(9);
-#ifndef NOFLOAT
- if vec2[zero].x <> 0 then e(10);
-#endif
- if (rec1.k[zero] <> 223) or (rec1.s <> []) then e(11);
- if (s1 <> []) or (s2 <> [red]) then e(12);
-end;
-
-
-
-
-begin ect:=0; pct:=0;
- tst40; tst41; tst42; tst43; tst44; tst45;
- write('Program t4:',pct:3,' tests completed.');
- writeln('Number of errors = ',ect:0);
-end.
+++ /dev/null
-{$i1000}
-program test(output);
-const rcsversion='$Header$';
-var b:false..true;
- i:integer;
- s:set of 0..999;
-begin
- b:=true; if not b then writeln('error 1');
- s:=[0,100,200,300,400,500,600,700,800,900];
- for i:=0 to 999 do
- if (i in s) <> (i mod 100=0) then
- writeln('error 2');
-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
-
-}
-program tstenc(output);
-const rcsversion='$Header$';
- trapno=150;
-var level:integer;
- beenhere:boolean;
- e:integer;
-procedure trap(erno:integer); extern;
-procedure encaps(procedure p;procedure q(erno:integer)); extern;
-procedure p1;
- label 1;
- var plevel:integer;
- procedure p2;
- var plevel:integer;
- begin plevel:=3 ; trap(trapno) ;
- writeln('executing unreachable code in p2') ; e:=e+1 ;
- end;
- procedure q2(no:integer);
- var qlevel:integer;
- begin qlevel:=-3 ;
- if no<>trapno then
- begin writeln('wrong trapno ',no,' in q2'); e:=e+1 end ;
- if plevel<>2 then
- begin writeln('wrong level ',plevel,' in q2'); e:=e+1 end ;
- trap(trapno) ;
- goto 1;
- writeln('executing unreachable code in q2') ; e:=e+1 ;
- end;
- begin plevel:=2 ; encaps(p2,q2) ;
- writeln('executing unreachable code in p1'); e:=e+1;
-1: if plevel<>2 then
- begin writeln('wrong level ', plevel, 'in p1') ; e:=e+1 end ;
- beenhere:=true ;
- end; { body of p1 }
-procedure q1(no:integer);
- var qlevel:integer;
- begin qlevel:=-2 ;
- if no<>trapno then
- begin writeln('wrong trapno ',no,' in q1'); e:=e+1 end ;
- if level<>1 then
- begin writeln('wrong level ',level,' in q1'); e:=e+1 end ;
- end;
-begin
- level:=1 ;
- e:=0 ;
- beenhere:=false ;
- encaps(p1,q1);
- if not beenhere then
- begin writeln('illegaly skipped code in p1') ; e:=e+1 end;
- if e=0 then writeln('encaps OK')
-end.
+++ /dev/null
-program tstgto(output);
-type int=integer;
- pint=^integer;
-var ga0,ga1,ga2,ga3,ga4,ga5:int;
- gp0,gp1,gp2,gp3,gp4,gp5:pint;
-
-procedure level0(a1,a2:int;p1,p2:pint);
-label 1;
-var a3,a4,a5:int;p3,p4,p5:pint;
-
-procedure level1(a1,a2:int;p1,p2:pint);
-var a3,a4,a5:int;p3,p4,p5:pint;
-
-procedure level2(a1,a2:int;p1,p2:pint);
-var a3,a4,a5:int;p3,p4,p5:pint;
-begin
- a1:= -5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
- a1:= -4;a2:=a1;a3:=a2;a4:=a3;
- a1:= -3;a2:=a1;a3:=a2;
- a1:= -2;a2:=a1;
- a1:=a5+a5;a1:= -1;
- p1:=gp0;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
- p1:=gp1;p2:=p1;p3:=p2;p4:=p3;
- p1:=gp2;p2:=p1;p3:=p2;
- p1:=gp3;p2:=p1;
- p1:=p5;p1:=gp4;
- goto 1;
-end; { level 2 }
-
-begin
- a1:=ga4;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
- a1:=ga3;a2:=a1;a3:=a2;a4:=a3;
- a1:=ga2;a2:=a1;a3:=a2;
- a1:=ga1;a2:=a1;
- a1:=ga0;
- p1:=gp4;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
- p1:=gp3;p2:=p1;p3:=p2;p4:=p3;
- p1:=gp2;p2:=p1;p3:=p2;
- p1:=gp1;p2:=p1;
- p1:=gp0;
- level2(a5,a4,p5,p4);
- writeln('Error, goto failed');
-end; { level 1 }
-
-begin
- a1:=ga5;a2:=a1;a3:=a2;a4:=a3;a5:=a4;
- a1:=ga4;a2:=a1;a3:=a2;a4:=a3;
- a1:=ga3;a2:=a1;a3:=a2;
- a1:=ga2;a2:=a1;
- a1:=ga1;
- p1:=gp5;p2:=p1;p3:=p2;p4:=p3;p5:=p4;
- p1:=gp4;p2:=p1;p3:=p2;p4:=p3;
- p1:=gp3;p2:=p1;p3:=p2;
- p1:=gp2;p2:=p1;
- p1:=gp1;
- level1(a5,a4,p5,p4);
- writeln('Error, goto failed');
-1:
- if (a1 <> ga1) then writeln('level0:a1 has wrong value');
- if (a2 <> ga2) then writeln('level0:a2 has wrong value');
- if (a3 <> ga3) then writeln('level0:a3 has wrong value');
- if (a4 <> ga4) then writeln('level0:a4 has wrong value');
- if (a5 <> ga5) then writeln('level0:a5 has wrong value');
- if (p1 <> gp1) then writeln('level0:p1 has wrong value');
- if (p2 <> gp2) then writeln('level0:p2 has wrong value');
- if (p3 <> gp3) then writeln('level0:p3 has wrong value');
- if (p4 <> gp4) then writeln('level0:p4 has wrong value');
- if (p5 <> gp5) then writeln('level0:p5 has wrong value');
-end; { level 0 }
-
-begin
- ga0:=0;ga1:=1;ga2:=2;ga3:=3;ga4:=4;ga5:=5;
- new(gp0);new(gp1);new(gp2);new(gp3);new(gp4);new(gp5);
- level0(ga5,ga4,gp5,gp4);
-end.
+++ /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=lib/{M}/tail_
-var RT=lib/{M}/head_
-var INCLUDES=-I{EM}/include -I/usr/include
-name be
- from .m.g
- to .s
- program {EM}/lib/{M}/cg
- args <
- stdout
- need .e
-end
-name asld
- from .s.a
- to .out
- outfile 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 {EM}/{LIB}em.vend)
- linker
-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.
-# $Header$
-callname ack
-name cpp
- # no from, this is a preprocessor
- 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} <
- stdout
- prep is
-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?}
- stdin
- stdout
- prep always
- rts .c
- need .c
- callname acc
- callname cc
-end
-var PC_PCPATH={EM}/lib/pc_pem
-var PC_ERRPATH={EM}/etc/pc_errors
-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-}
- mapflag -Pr* PC_ERRPATH=*
- mapflag -PR* PC_PCPATH=*
- args -Vw{w}p{p}f{d}l{l} -R{PC_PCPATH} -r{PC_ERRPATH} {PC_F?} < > {SOURCE}
- prep cond
- rts .p
- need .p
- callname apc
- callname pc
- end
- name abc
- from .b
- to .e
- program {EM}/lib/em_bem
- mapflag -h ABC_F={ABC_F?} -h
- mapflag -w ABC_F={ABC_F?} -w
- mapflag -L ABC_F={ABC_F?} -L
- mapflag -E ABC_F={ABC_F?} -E
-# mapflag -d ABC_F={ABC_F?} -d
- args {ABC_F?} < > {SOURCE}
- prep always
- rts .b
- need .b
- callname abc
-end
-name encode
- from .e
- to .k
- program {EM}/lib/em_encode
- args <
- prep cond
- stdout
-end
-name opt
- from .k
- to .m
- program {EM}/lib/em_opt
- mapflag -LIB OPT_F={OPT_F?} -L
- args {OPT_F?} <
- stdout
- optimizer
-end
-name decode
- from .k.m.g
- to .e
- program {EM}/lib/em_decode
- args <
- stdout
-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=lib/i86/tail_
-var LIBIBM=lib/ibm/tail_
-var RT=lib/i86/head_
-var RTIBM=lib/ibm/head_
-var CPP_F=-Dunix
-var INCLUDES=-I{EM}/include -I{EM}/lib/ibm/include
-name be
- from .m.g
- to .s
- program {EM}/lib/{M}/cg
- args <
- stdout
- need .e
-end
-name asld
- from .s.a
- to .out
- outfile 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)
- linker
-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 CCP_F=-Dunix
-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 CCP_F=-Dunix
-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 CCP_F=-Dunix
-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 CCP_F=-Dunix
-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 CCP_F=-Dunix
-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 CCP_F=-Dunix
-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
-# $Header$
-/movab/ {
-s/movab 1(\(.*\)),\1$/incl \1/
-s/movab -1(\(.*\)),\1$/decl \1/
-s/movab \([0-9]*\)(\(.*\)),\2$/addl2 $\1,\2/
-s/movab -\([0-9]*\)(\(.*\)),\2$/subl2 $\1,\2/
-s/movab 0(\(.*\)) \[\(.*\)\],\1$/addl2 \2,\1/
-s/movab 0(\(.*\)) \[\(.*\)\],\2$/addl2 \1,\2/
-}
-/$0/ {
-s/movz[bw]\([wl]\) $0,/clr\1 /
-s/mov\([bwl]\) $0,/clr\1 /
-s/cvt[bw]\([wl]\) $0,/clr\1 /
-}
-/add/ {
-s/\(add[fdlw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-s/\(add[fdlw]\)3 \(.*\),\(.*\),\2$/\12 \3,\2/
-s/add\([wl]\)2 \$-\([0-9]*\),/sub\12 $\2,/
-s/add\([wl]\)3 \$-\([0-9]*\),/sub\13 $\2,/
-s/add\([wl]\)3 \(.*\),\$-\([0-9]*\),/sub\13 $\3,\2,/
-}
-/mul/ {
-s/\(mul[fdlw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-s/\(mul[fdlw]\)3 \(.*\),\(.*\),\2$/\12 \3,\2/
-}
-/sub/ {
-s/\(sub[fdlw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-s/sub\([wl]\)2 \$-\([0-9]*\),/add\12 $\2,/
-s/sub\([wl]\)3 \$-\([0-9]*\),/add\13 $\2,/
-}
-/div/s/\(div[fdlw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-/bi/s/\(bi[cs][lw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-/bis/s/\(bis[lw]\)3 \(.*\),\(.*\),\2$/\12 \3,\2/
-/xor/ {
-s/\(xor[lw]\)3 \(.*\),\(.*\),\3$/\12 \2,\3/
-s/\(xor[lw]\)3 \(.*\),\(.*\),\2$/\12 \3,\2/
-}
-/$1/ {
-s/add\([wl]\)2 \$1,/inc\1 /
-s/sub\([wl]\)2 \$1,/dec\1 /
-}
-/$-1/ {
-s/add\([wl]\)2 \$-1,/dec\1 /
-s/sub\([wl]\)2 \$-1,/inc\1 /
-}
-/cmp[bwl].*$0/ {
-N
-s/cmp\([bwl]\) \(.*\),$0$/tst\1 \2/
-s/cmp\([bwl]\) $0,\(.*\)\njneq/tst\1 \2\
-jneq/
-s/cmp\([bwl]\) $0,\(.*\)\njeql/tst\1 \2\
-jeql/
-s/cmp\([bwl]\) $0,\(.*\)\njgtr/tst\1 \2\
-jlss/
-s/cmp\([bwl]\) $0,\(.*\)\njlss/tst\1 \2\
-jgtr/
-s/cmp\([bwl]\) $0,\(.*\)\njgeq/tst\1 \2\
-jleq/
-s/cmp\([bwl]\) $0,\(.*\)\njleq/tst\1 \2\
-jgeq/
-P
-D
-}
-/(sp)+/ {
-N
-s/movl (sp)+,\(.*\)\npushl \1$/movl (sp),\1/
-s/tst[wl] (sp)+\nmovl fp,sp$/movl fp,sp/
-s/tst\([wl]\) (sp)+\nmov\1 \(.*\),-(sp)/mov\1 \2,(sp)/
-s/tst\([wl]\) (sp)+\nclr\1 -(sp)/clr\1 (sp)/
-s/tst\([wl]\) (sp)+\nmovzb\1 \(.*\),-(sp)/movzb\1 \2,(sp)/
-s/tst\([wl]\) (sp)+\ncvtb\1 \(.*\),-(sp)/cvtb\1 \2,(sp)/
-s/tst\([wl]\) (sp)+\ntst\1 \(.*\)$/mov\1 \2,(sp)+/
-s/tstl (sp)+\npushl \(.*\)$/movl \1,(sp)/
-s/tstl (sp)+\npusha\([bwlq]\) \(.*\)$/mova\1 \2,(sp)/
-P
-D
-}
-/^addl2 .*,sp/ {
-N
-s/addl2 .*,sp\nmovl fp,sp$/movl fp,sp/
-s/^addl2 $6,sp\nmovw \(.*\),-(sp)/tstl (sp)+\
-movw \1,(sp)/
-s/^addl2 $6,sp\nclrw -(sp)/tstl (sp)+\
-clrw (sp)/
-s/^addl2 $8,sp\nmovq \(.*\),-(sp)/movq \1,(sp)/
-P
-D
-}
-/clrw -(sp)/ {
-N
-s/clrw -(sp)\nmovw \($[0-9]*\),-(sp)/pushl \1/
-s/clrw -(sp)\nmnegw $\([0-9]*\),-(sp)/movzwl $-\1,-(sp)/
-s/clrw -(sp)\nmovw \(.*\),-(sp)/movzwl \1,-(sp)/
-s/clrw -(sp)\ncvtbw \(\$[0-9]*\),-(sp)/pushl \1/
-s/clrw -(sp)\ncvtbw \(\$.*\),-(sp)/movzwl \1,-(sp)/
-P
-D
-}
-/mov/ {
-N
-s/mov\([wl]\) \(.*\),\(.*\)\ntst\1 \3$/mov\1 \2,\3/
-P
-D
-}
+++ /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
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == TEM_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,".short\t%d\n",(int) l);
- fprintf(codefile,".short\t%d\n",(int) (l >> 16));
-}
-
-
-con_float() {
-
-static int been_here;
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- fprintf(codefile,".long\t");
- if (argval == 8)
- fprintf(codefile,"F_DUM,");
- fprintf(codefile,"F_DUM\n");
- if ( !been_here++)
- {
- fprintf(stderr,"Warning : dummy float-constant(s)\n");
- }
-}
-
-prolog(nlocals) full nlocals; {
-
- fprintf(codefile,"\tjsr Pro\n");
- if (nlocals == 0)
- return;
- else
- fprintf(codefile,
- "\tldx #[%d].h\n\tlda #[%d].l\n\tjsr Lcs\n",
- nlocals, 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,".define %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,".extern %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 dlbdlb(x,y) fprintf(codefile,"%s = %s\n",x,y)
-#define newlbss(l,x) fprintf(codefile,"%s: .space\t%d\n",l,x);
-
-#define cst_fmt "%d"
-#define off_fmt "%d"
-#define ilb_fmt "I%03x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "%d+hol%d"
-
-#define con_cst(x) fprintf(codefile,".word\t%d\n",x)
-#define con_ilb(x) fprintf(codefile,".word\t%s\n",x)
-#define con_dlb(x) fprintf(codefile,".word\t%s\n",x)
-
-#define modhead ""
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-#define em_bsize 2 /* must be equal to EM_BSIZE */
-#define ND !defined($1)
-#define D defined($1)
-#define BASE 240
-#define MIN (0-BASE)
-#define MAX (254-em_bsize-BASE)
-#define IN(x) (x>=MIN && x<=MAX)
-#define IND(x) (x>=MIN && x<=(MAX-2))
-
-/*****************************************************\
-**** ****
-**** 6 5 0 0 B A C K E N D T A B L E ****
-**** ****
-\*****************************************************/
-
-
-/*
- * INTEGER SIZE: 16 bits
- * POINTER SIZE: 16 bits
- * NO FLOATS
- */
-
-
-EM_WSIZE = 2
-EM_PSIZE = 2
-EM_BSIZE = 2
-
-
-
-/*********************\
-* R E G I S T E R S *
-\*********************/
-
-REGISTERS:
-AA = ("a",1), REG.
-XX = ("x",1), REG.
-AX = ("<dummy>",2,AA,XX), R16.
-
-/* AX is a registerpair, A contains the highbyte of a word and
- * X contains the lowbyte
- */
-
-
-/***************\
-* T O K E N S *
-\***************/
-
-TOKENS:
-IMMEDIATE = {INT off;} 1 "#%[off]" /* a fake token the
- * cgg needs one
- */
-
-
-
-/***********************************\
-* T O K E N E X P R E S S I O N S *
-\***********************************/
-
-TOKENEXPRESSIONS:
-AAA = IMMEDIATE /* a fake tokenexpression
- * the cgg needs one
- */
-
-
-/***********\
-* C O D E *
-\***********/
-
-CODE:
-
-/* GROUP 1 - LOAD */
-
-loc ($1%256)==($1/256) | |
- allocate(R16)
- "lda #[$1].l"
- "tax"
- | %[a] | |
-loc | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- | %[a] | |
-ldc highw(1)==loww(1) && (loww(1)%256)==(loww(1)/256) | |
- allocate(R16)
- "lda #[%(loww(1)%)].l"
- "tax"
- "jsr Push"
- | %[a] | |
-ldc | |
- allocate(R16)
- "lda #[%(highw(1)%)].h"
- "ldx #[%(highw(1)%)].l"
- "jsr Push"
- "lda #[%(loww(1)%)].h"
- "ldx #[%(loww(1)%)].l"
- | %[a] | |
-lol IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "tax"
- "iny"
- "lda (LBl),y"
- | %[a] | |
-lol | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Lol"
- | %[a] | |
-loe | |
- allocate(R16)
- "lda $1+1"
- "ldx $1"
- | %[a] | |
-lil IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "tax"
- "iny"
- "lda (LBl),y"
- "jsr Loi"
- | %[a] | |
-lil | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Lol"
- "jsr Loi"
- | %[a] | |
-lof $1==0 | R16 |
- "jsr Loi"
- | %[1] | |
-lof | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Adi2"
- "jsr Loi"
- | %[a] | |
-lal | |
- allocate(R16)
- "clc"
- "lda #[$1].l"
- "adc LB"
- "tax"
- "lda #[$1].h"
- "adc LB+1"
- | %[a] | |
-lae | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- | %[a] | |
-lxl $1==0 | |
- allocate(R16)
- "lda LB+1"
- "ldx LB"
- | %[a] | |
-lxl $1<=255 | | /* n restricted to a max of 255 */
- allocate(R16)
- "ldx #[$1].l"
- "jsr Lxl"
- | %[a] | |
-lxa $1==0 | |
- allocate(R16)
- "jsr Lxa1"
- | %[a] | |
-lxa $1<=255 | | /* n restricted to a max of 255 */
- allocate(R16)
- "ldx #[$1].l"
- "jsr Lxa2"
- | %[a] | |
-loi $1==1 | R16 |
- "jsr Loi1"
- | %[1] | |
-loi $1==2 | R16 |
- "jsr Loi"
- | %[1] | |
-loi $1==4 | R16 |
- "jsr Ldi"
- | | |
-loi D | R16 |
- "ldy #[$1].h"
- "sty NBYTES+1"
- "ldy #[$1].l"
- "jsr Loil"
- | | |
-los $1==2 | R16 |
- "jsr Los"
- | | |
-ldl IND($1) | |
- allocate(R16)
- "ldy #BASE+$1+3"
- "lda (LBl),y"
- "pha"
- "dey"
- "lda (LBl),y"
- "tax"
- "pla"
- "jsr Push"
- "dey"
- "lda (LBl),y"
- "pha"
- "dey"
- "lda (LBl),y"
- "tax"
- "pla"
- | %[a] | |
-ldl | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Locaddr"
- "jsr Ldo"
- | | |
-lde | |
- allocate(R16)
- "lda $1+3"
- "ldx $1+2"
- "jsr Push"
- "lda $1+1"
- "ldx $1"
- | %[a] | |
-ldf $1==0 | R16 |
- "jsr Ldi"
- | | |
-ldf | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Adi2"
- "jsr Ldi"
- | | |
-lpi | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- | %[a] | |
-
-
-/* GROUP 2 - STORE */
-
-stl IN($1) | R16 |
- "ldy #BASE+1+$1"
- "sta (LBl),y"
- "txa"
- "dey"
- "sta (LBl),y"
- | | |
-stl | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Stl"
- | | |
-ste | R16 |
- "sta $1+1"
- "stx $1"
- | | |
-sil IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "tax"
- "iny"
- "lda (LBl),y"
- "jsr Sti"
- | | |
-sil | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Lol"
- "jsr Sti"
- | | |
-stf $1==0 | R16 |
- "jsr Sti"
- | | |
-stf | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Adi2"
- "jsr Sti"
- | | |
-sti $1==1 | R16 |
- "jsr Sti1"
- | | |
-sti $1==2 | R16 |
- "jsr Sti"
- | | |
-sti $1==4 | R16 |
- "jsr Sdi"
- | | |
-sti D | R16 |
- "ldy #[$1].h"
- "sty NBYTES+1"
- "ldy #[$1].l"
- "jsr Stil"
- | | |
-sts $1==2 | R16 |
- "jsr Sts"
- | | |
-sdl IND($1) | R16 |
- "ldy #BASE+$1"
- "pha"
- "txa"
- "sta (LBl),y"
- "iny"
- "pla"
- "sta (LBl),y"
- "jsr Pop"
- "iny"
- "pha"
- "txa"
- "sta (LBl),y"
- "iny"
- "pla"
- "sta (LBl),y"
- | | |
-sdl | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Locaddr"
- "jsr Sdo"
- | | |
-sde | R16 |
- "sta $1+1"
- "stx $1"
- "jsr Pop"
- "sta $1+3"
- "stx $1+2"
- | | |
-sdf $1==0 | R16 |
- "jsr Sdi"
- | | |
-sdf | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Adi2"
- "jsr Sdi"
- | | |
-
-
-/* GROUP 3 - INTEGER ARITHMETIC */
-
-loc lol adi (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "clc"
- "lda #[$1].l"
- "adc (LBl),y"
- "tax"
- "iny"
- "lda #[$1].h"
- "adc (LBl),y"
- | %[a] | |
-lol loc adi | | | | loc $2 lol $1 adi $3 |
-lol lol adi (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1+1"
- "lda (LBl),y"
- "pha"
- "dey"
- "lda (LBl),y"
- "ldy #BASE+$2"
- "clc"
- "adc (LBl),y"
- "tax"
- "iny"
- "pla"
- "adc (LBl),y"
- | %[a] | |
-lol loe adi (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "clc"
- "lda (LBl),y"
- "adc $2"
- "tax"
- "iny"
- "lda (LBl),y"
- "adc $2+1"
- | %[a] | |
-loe lol adi | | | | lol $2 loe $1 adi $3 |
-loe loe adi $3==2 | |
- allocate(R16)
- "clc"
- "lda $1"
- "adc $2"
- "tax"
- "lda $1+1"
- "adc $2+1"
- | %[a] | |
-loc loe adi $3==2 | |
- allocate(R16)
- "clc"
- "lda #[$1].l"
- "adc $2"
- "tax"
- "lda #[$1].h"
- "adc $2+1"
- | %[a] | |
-loe loc adi | | | | loc $2 loe $1 adi $3 |
-ldl adi IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1"
- "clc"
- "lda (LBl),y"
- "iny"
- "iny"
- "adc (LBl),y"
- "tax"
- "dey"
- "lda (LBl),y"
- "iny"
- "iny"
- "adc (LBl),y"
- | %[a] | |
-lde adi $2==2 | |
- allocate(R16)
- "clc"
- "lda $1"
- "adc $1+2"
- "tax"
- "lda $1+1"
- "adc $1+3"
- | %[a] | |
-loc adi $2==2 | R16 |
- "pha"
- "txa"
- "clc"
- "adc #[$1].l"
- "tax"
- "pla"
- "adc #[$1].h"
- | %[1] | |
-lol adi IN($1) && $2==2 | R16 |
- "pha"
- "ldy #BASE+$1"
- "clc"
- "txa"
- "adc (LBl),y"
- "tax"
- "iny"
- "pla"
- "adc (LBl),y"
- | %[1] | |
-loe adi $2==2 | R16 |
- "pha"
- "clc"
- "txa"
- "adc $1"
- "tax"
- "pla"
- "adc $1+1"
- | %[1] | |
-lol lol adi IN($1) && !IN($2) && $3==2
- | | | | lol $2 lol $1 adi $3 |
-adi $1==2 | R16 |
- "jsr Adi2"
- | %[1] | |
-adi $1==4 | |
- allocate(R16)
- "jsr Adi4"
- | | |
-adi ND | R16 |
- "jsr Test2"
- "jsr Adi2"
- | %[1] | |
-loc lol sbi (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "sec"
- "lda #[$1].l"
- "sbc (LBl),y"
- "tax"
- "iny"
- "lda #[$1].h"
- "sbc (LBl),y"
- | %[a] | |
-lol loc sbi | | | | lol $1 loc 0-$2 adi $3 |
-lol lol sbi (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1+1"
- "lda (LBl),y"
- "pha"
- "dey"
- "lda (LBl),y"
- "ldy #BASE+$2"
- "sec"
- "sbc (LBl),y"
- "tax"
- "iny"
- "pla"
- "sbc (LBl),y"
- | %[a] | |
-lol loe sbi (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "sec"
- "lda (LBl),y"
- "sbc $2"
- "tax"
- "iny"
- "lda (LBl),y"
- "sbc $2+1"
- | %[a] | |
-loe lol sbi (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "sec"
- "lda $2"
- "sbc (LBl),y"
- "tax"
- "iny"
- "lda $2+1"
- "sbc (LBl),y"
- | %[a] | |
-loe loe sbi $3==2 | |
- allocate(R16)
- "sec"
- "lda $1"
- "sbc $2"
- "tax"
- "lda $1+1"
- "sbc $2+1"
- | %[a] | |
-loc loe sbi $3==2 | |
- allocate(R16)
- "sec"
- "lda #[$1].l"
- "sbc $2"
- "tax"
- "lda #[$1].h"
- "sbc $2+1"
- | %[a] | |
-loe loc sbi | | | | loe $1 loc 0-$2 adi $3 |
-ldl sbi IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1+2"
- "sec"
- "lda (LBl),y"
- "dey"
- "dey"
- "sbc (LBl),y"
- "tax"
- "ldy #BASE+$1+3"
- "lda (LBl),y"
- "dey"
- "dey"
- "sbc (LBl),y"
- | %[a] | |
-lde sbi $2==2 | |
- allocate(R16)
- "sec"
- "lda $1+2"
- "sbc $1"
- "tax"
- "lda $1+3"
- "sbc $1"
- | %[a] | |
-loc sbi $2==2 | R16 |
- "pha"
- "txa"
- "sec"
- "sbc #[$1].l"
- "tax"
- "pla"
- "sbc #[$1].h"
- | %[1] | |
-lol sbi IN($1) && $2==2 | R16 |
- "pha"
- "ldy #BASE+$1"
- "sec"
- "txa"
- "sbc (LBl),y"
- "tax"
- "iny"
- "pla"
- "sbc #[$1].h"
- | %[1] | |
-loe sbi $2==2 | R16 |
- "pha"
- "sec"
- "txa"
- "sbc $1"
- "tax"
- "pla"
- "sbc $1+1"
- | %[1] | |
-sbi $1==2 | R16 |
- "jsr Sbi2"
- | %[1] | |
-sbi $1==4 | |
- allocate(R16)
- "jsr Sbi4"
- | | |
-sbi ND | R16 |
- "jsr Test2"
- "jsr Sbi2"
- | %[1] | |
-loc lol mli (IN($2) && $3==2) | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-lol loc mli | | | | loc $2 lol $1 mli $3 |
-lol lol mli (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-lol loe mli (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-loe lol mli (IN($2) && $3==2) | | | | lol $2 loe $1 mli $3 |
-loe loe mli $3==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-loc loe mli $3==2 | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-loe loc mli | | | | loc $2 loe $1 mli $3 |
-ldl mli IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "iny"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-lde mli $2==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $1+2"
- "sta ARTH+2"
- "lda $1+3"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[a] | |
-loc mli $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[1] | |
-lol mli IN($1) && $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[1] | |
-loe mli $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "jsr Mlinp"
- | %[1] | |
-lol lol mli IN($1) && !IN($2) && $3==2
- | | | | lol $2 lol $1 mli $3 |
-mli $1==2 | R16 |
- "jsr Mli2"
- | %[1] | |
-mli $1==4 | |
- allocate(R16)
- "jsr Mli4"
- | | |
-mli ND | R16 |
- "jsr Test2"
- "jsr Mli2"
- | %[1] | |
-loc lol dvi (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-lol loc dvi (IN($1) && $3==2) | |
- allocate(R16)
- "lda #[$2].l"
- "sta ARTH"
- "lda #[$2].h"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-lol lol dvi (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-lol loe dvi (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-loe lol dvi (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-loe loe dvi $3==2 | |
- allocate(R16)
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-loc loe dvi $3==2 | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-loe loc dvi $3==2 | |
- allocate(R16)
- "lda #[$2].l"
- "sta ARTH"
- "lda #[$2].h"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-ldl dvi IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "iny"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-lde dvi $2==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $1+2"
- "sta ARTH+2"
- "lda $1+3"
- "sta ARTH+3"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[a] | |
-loc dvi $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[1] | |
-lol dvi IN($1) && $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[1] | |
-loe dvi $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "ldy #1"
- "sty UNSIGN"
- "jsr Div"
- | %[1] | |
-dvi $1==2 | R16 |
- "jsr Dvi2"
- | %[1] | |
-dvi $1==4 | |
- allocate(R16)
- "jsr Dvi4"
- | | |
-dvi ND | R16 |
- "jsr Test2"
- "jsr Dvi2"
- | %[1] | |
-rmi $1==2 | R16 |
- "jsr Rmi2"
- | %[1] | |
-rmi $1==4 | |
- allocate(R16)
- "jsr Rmi4"
- | | |
-rmi ND | R16 |
- "jsr Test2"
- "jsr Rmi2"
- | %[1] | |
-ngi $1==2 | R16 |
- "jsr Ngi2"
- | %[1] | |
-ngi $1==4 | |
- allocate(R16)
- "lda SP+1"
- "ldx SP+2"
- "jsr Ngi4"
- | | |
-ngi ND | R16 |
- "jsr Test2"
- "jsr Ngi2"
- | %[1] | |
-sli $1==2 | R16 |
- "jsr Sli2"
- | %[1] | |
-sli $1==4 | R16 |
- "jsr Sli4"
- | | |
-sli ND | R16 |
- "jsr Test2"
- "jsr Sli2"
- | %[1] | |
-sri $1==2 | R16 |
- "jsr Sri2"
- | %[1] | |
-sri $1==4 | R16 |
- "jsr Sri4"
- | | |
-sri ND | R16 |
- "jsr Test2"
- "jsr Sri2"
- | %[1] | |
-
-
-/* GROUP 4 - UNSIGNED ARITHMETIC */
-
-loc lol adu | | | | loc $1 lol $2 adi $3 |
-lol loc adu | | | | lol $1 loc $2 adi $3 |
-lol lol adu | | | | lol $1 lol $2 adi $3 |
-lol loe adu | | | | lol $1 loe $2 adi $3 |
-loe lol adu | | | | loe $1 lol $2 adi $3 |
-loe loe adu | | | | loe $1 loe $2 adi $3 |
-loc loe adu | | | | loc $1 loe $2 adi $3 |
-loe loc adu | | | | loe $1 loc $2 adi $3 |
-ldl adu | | | | ldl $1 adi $2 |
-lde adu | | | | lde $1 adi $2 |
-loc adu | | | | loc $1 adi $2 |
-lol adu | | | | lol $1 adi $2 |
-loe adu | | | | loe $1 adi $2 |
-adu | | | | adi $1 |
-
-loc lol sbu | | | | loc $1 lol $2 sbi $3 |
-lol loc sbu | | | | lol $1 loc $2 sbi $3 |
-lol lol sbu | | | | lol $1 lol $2 sbi $3 |
-lol loe sbu | | | | lol $1 loe $2 sbi $3 |
-loe lol sbu | | | | loe $1 lol $2 sbi $3 |
-loe loe sbu | | | | loe $1 loe $2 sbi $3 |
-loc loe sbu | | | | loc $1 loe $2 sbi $3 |
-loe loc sbu | | | | loe $1 loc $2 sbi $3 |
-ldl sbu | | | | ldl $1 sbi $2 |
-lde sbu | | | | lde $1 sbi $2 |
-loc sbu | | | | loc $1 sbi $2 |
-lol sbu | | | | lol $1 sbi $2 |
-loe sbu | | | | loe $1 sbi $2 |
-sbu | | | | sbi $1 |
-
-loc lol mlu (IN($2) && $3==2) | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-lol loc mlu | | | | loc $2 lol $1 mlu $3 |
-lol lol mlu (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-lol loe mlu (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-loe lol mlu (IN($2) && $3==2) | | | | lol $2 loe $1 mlu $3 |
-loe loe mlu $3==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-loc loe mlu $3==2 | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-loe loc mlu | | | | loc $2 loe $1 mlu $3 |
-ldl mlu IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "iny"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-lde mlu $2==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $1+2"
- "sta ARTH+2"
- "lda $1+3"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[a] | |
-loc mlu $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[1] | |
-lol mlu IN($1) && $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[1] | |
-loe mlu $2==2 | R16 |
- "stx ARTH"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Mul"
- | %[1] | |
-lol lol mlu IN($1) && !IN($2) && $3==2
- | | | | lol $2 lol $1 mlu $3 |
-mlu $1==2 | R16 |
- "jsr Mlu2"
- | %[1] | |
-mlu $1==4 | |
- allocate(R16)
- "jsr Mlu4"
- | | |
-mlu ND | R16 |
- "jsr Test2"
- "jsr Mlu2"
- | %[1] | |
-
-loc lol dvu (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-lol loc dvu (IN($1) && $3==2) | |
- allocate(R16)
- "lda #[$2].l"
- "sta ARTH"
- "lda #[$2].h"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-lol lol dvu (IN($1) && IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-lol loe dvu (IN($1) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-loe lol dvu (IN($2) && $3==2) | |
- allocate(R16)
- "ldy #BASE+$2"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "lda $2"
- "sta ARTH+2"
- "lda $2+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-loe loe dvu $3==2 | |
- allocate(R16)
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-loc loe dvu $3==2 | |
- allocate(R16)
- "lda #[$1].l"
- "sta ARTH+2"
- "lda #[$1].h"
- "sta ARTH+3"
- "lda $2"
- "sta ARTH"
- "lda $2+1"
- "sta ARTH+1"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-loe loc dvu $3==2 | |
- allocate(R16)
- "lda #[$2].l"
- "sta ARTH"
- "lda #[$2].h"
- "sta ARTH+1"
- "lda $1"
- "sta ARTH+2"
- "lda $1+1"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-ldl dvu IND($1) && $2==2 | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "iny"
- "lda (LBl),y"
- "sta ARTH+2"
- "iny"
- "lda (LBl),y"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-lde dvu $2==2 | |
- allocate(R16)
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "lda $1+2"
- "sta ARTH+2"
- "lda $1+3"
- "sta ARTH+3"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[a] | |
-loc dvu $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "lda #[$1].l"
- "sta ARTH"
- "lda #[$1].h"
- "sta ARTH+1"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[1] | |
-lol dvu IN($1) && $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "ldy #BASE+$1"
- "lda (LBl),y"
- "sta ARTH"
- "iny"
- "lda (LBl),y"
- "sta ARTH+1"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[1] | |
-loe dvu $2==2 | R16 |
- "stx ARTH+2"
- "sta ARTH+3"
- "lda $1"
- "sta ARTH"
- "lda $1+1"
- "sta ARTH+1"
- "ldy #0"
- "sty UNSIGN"
- "jsr Duv"
- | %[1] | |
-dvu $1==2 | R16 |
- "jsr Dvu2"
- | %[1] | |
-dvu $1==4 | |
- allocate(R16)
- "jsr Dvu4"
- | | |
-dvu ND | R16 |
- "jsr Test2"
- "jsr Dvu2"
- | %[1] | |
-
-rmu $1==2 | R16 |
- "jsr Rmu2"
- | %[1] | |
-rmu $1==4 | |
- allocate(R16)
- "jsr Rmu4"
- | | |
-slu | | | | sli $1 |
-sru $1==2 | R16 |
- "jsr Sru2"
- | %[1] | |
-sru $1==4 | R16 |
- "jsr Sru4"
- | | |
-sru ND | R16 |
- "jsr Test2"
- "jsr Sru2"
- | %[1] | |
-
-
-/* GROUP 6 - POINTER ARITHMETIC */
-
-adp $1==0 | | | | |
-adp | | | | loc $1 adi 2 |
-ads $1==2 | R16 |
- "jsr Adi2"
- | %[1] | |
-ads ND | R16 |
- "jsr Test2"
- "jsr Adi2"
- | %[1] | |
-sbs $1==2 | R16 |
- "jsr Sbi2"
- | %[1] | |
-sbs ND | R16 |
- "jsr Test2"
- "jsr Sbi2"
- | %[1] | |
-
-
-/* GROUP 7 INCREMENT/DECREMENT/ZERO */
-
-inc | R16 |
- "inx"
- "bne 1f"
- "clc"
- "adc #1\n1:"
- | %[1] | |
-inl IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "clc"
- "lda (LBl),y"
- "adc #1"
- "sta (LBl),y"
- "bcc 1f"
- "iny"
- "lda (LBl),y"
- "adc #0"
- "sta (LBl),y\n1:"
- | | |
-inl D | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Lol"
- "inx"
- "bne 1f"
- "clc"
- "adc #1"
- "1: jsr Stii"
- | | |
-ine | |
- "inc $1"
- "bne 1f"
- "inc $1+1\n1:"
- | | |
-dec | R16 |
- "cpx #0"
- "bne 1f"
- "sec"
- "sbc #1"
- "1: dex"
- | %[1] | |
-del IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "sec"
- "lda (LBl),y"
- "sbc #1"
- "sta (LBl),y"
- "bcs 1f"
- "iny"
- "lda (LBl),y"
- "sbc #0"
- "sta (LBl),y\n1:"
- | | |
-del | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Lol"
- "cpx #0"
- "bne 1f"
- "sec"
- "sbc #1"
- "1: dex"
- "jsr Stii"
- | | |
-dee | |
- "ldy $1"
- "bne 1f"
- "dec $1+1"
- "1: dey"
- "sty $1"
- | | |
-zrl IN($1) | |
- allocate(R16)
- "ldy #BASE+$1"
- "lda #0"
- "sta (LBl),y"
- "iny"
- "sta (LBl),y"
- | | |
-zrl | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Zrl"
- | | |
-zre | |
- "ldy #0"
- "sty $1"
- "sty $1+1"
- | | |
-zer $1==2 | |
- allocate(R16)
- "lda #0"
- "tax"
- | %[a] | |
-zer $1==4 | |
- allocate(R16)
- "lda #0"
- "tax"
- "jsr Push"
- | %[a] | |
-zer $1>0 && $1<=256 | |
- allocate(R16)
- "ldy #$1-1"
- "jsr Zer"
- | | |
-
-
-/* GROUP 8 - CONVERT (stack: source, source size, dest. size (top)) */
-
-loc loc cii $1==1 && $2==2 | R16 |
- "txa"
- "bpl 1f"
- "lda #0FFh"
- "bne 2f"
- "1: lda #0\n2:"
- | %[1] | |
-cii | R16 |
- "jsr Cii"
- | | |
-cui | | | | cii |
-ciu | | | | cii |
-cuu | | | | asp 4 |
-
-
-/* GROUP 9 - LOGICAL */
-
-and $1==2 | R16 |
- "sta ARTH+1"
- "stx ARTH"
- "jsr Pop"
- "and ARTH+1"
- "pha"
- "txa"
- "and ARTH"
- "tax"
- "pla"
- | %[1] | |
-and $1<=254 | |
- allocate(R16)
- "ldy #[$1].l"
- "jsr And"
- | | |
-and ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "iny"
- "jsr And"
- | | |
-ior $1==2 | R16 |
- "sta ARTH+1"
- "stx ARTH"
- "jsr Pop"
- "ora ARTH+1"
- "pha"
- "txa"
- "ora ARTH"
- "tax"
- "pla"
- | %[1] | |
-ior $1<=254 | |
- allocate(R16)
- "ldy #[$1].l"
- "jsr Ior"
- | | |
-ior ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "iny"
- "jsr Ior"
- | | |
-xor $1==2 | R16 |
- "sta ARTH+1"
- "stx ARTH"
- "jsr Pop"
- "eor ARTH+1"
- "pha"
- "txa"
- "eor ARTH"
- "tax"
- "pla"
- | %[1] | |
-xor $1<=254 | |
- allocate(R16)
- "ldy #[$1].l"
- "jsr Xor"
- | | |
-xor ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "iny"
- "jsr Xor"
- | | |
-com $1==2 | R16 |
- "eor #0FFh"
- "pha"
- "txa"
- "eor #0FFh"
- "tax"
- "pla"
- | %[1] | |
-com $1<=254 | |
- allocate(R16)
- "ldy #[$1].l"
- "jsr Com"
- | | |
-com ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "iny"
- "jsr Com"
- | | |
-rol $1==2 | R16 |
- "jsr Rol"
- | %[1] | |
-rol $1==4 | R16 |
- "jsr Rol4"
- | | |
-rol ND | R16 |
- "jsr Test2"
- "jsr Rolw"
- | %[1] | |
-ror $1==2 | R16 |
- "jsr Ror"
- | %[1] | |
-ror $1==4 | R16 |
- "jsr Ror4"
- | | |
-ror ND | R16 |
- "jsr Test2"
- "jsr Rorw"
- | %[1] | |
-
-
-/* GROUP 10 - SETS */
-
-loc inn $1<0 && $2==2 | R16 |
- "lda #0"
- "tax"
- | %[1] | |
-loc inn $2==2 && $1==0 | R16 |
- "txa"
- "and #1"
- "tax"
- "lda #0"
- | %[1] | |
-loc inn $2==2 && $1>0 && $1<16 | R16 |
- "ldy #$1"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bne 1b"
- "lda ARTH"
- "and #1"
- "tax"
- "lda #0"
- | %[1] | |
-loc inn zeq $1>0 && $1<16 && $2==2 | R16 |
- "ldy #$1+1"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bne 1b"
- "bcc $1"
- | | |
-loc inn zne $1>0 && $1<16 && $2==2 | R16 |
- "ldy #$1+1"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bne 1b"
- "bcs $1"
- | | |
-inn $1==2 | R16 |
- "txa"
- "tay"
- "jsr Pop"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bne 1b"
- "lda ARTH"
- "and #1"
- "tax"
- "lda #0"
- | %[1] | |
-inn zeq $1==2 | R16 |
- "txa"
- "tay"
- "jsr Pop"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bpl 1b"
- "lda ARTH"
- "bcc $2"
- | %[1] | |
-inn zne $1==2 | R16 |
- "txa"
- "tay"
- "jsr Pop"
- "stx ARTH"
- "1: lsr a"
- "ror ARTH"
- "dey"
- "bpl 1b"
- "bcs $2"
- | %[1] | |
-inn $1<=256 | R16 |
- "ldy #$1-1"
- "jsr Inn"
- | %[1] | |
-inn ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "jsr Inn"
- | %[1] | |
-loc set $2==2 && $1>=0 && $1<16 | |
- allocate(R16)
- "ldy #$1"
- "lda #0"
- "sta ARTH"
- "sec"
- "1: rol ARTH"
- "rol a"
- "dey"
- "bpl 1b"
- "ldx ARTH"
- | %[a] | |
-set $1==2 | R16 |
- "txa"
- "tay"
- "lda #0"
- "sta ARTH"
- "sec"
- "1: rol ARTH"
- "rol a"
- "bpl 1b"
- "ldx ARTH"
- | %[1] | |
-set $1<=256 | R16 |
- "ldy #$1-1"
- "jsr Set"
- | | |
-set ND | R16 |
- "jsr TestFFh"
- "jsr Pop"
- "jsr Set"
- | | |
-
-
-/* GROUP 11 - ARRAY */
-
-lae lar defined(rom(1,3)) | | | | lae $1 aar $2 loi rom(1,3) |
-lar $1==2 | R16 |
- "jsr Lar"
- | | |
-lar ND | R16 |
- "jsr Test2"
- "jsr Lar"
- | | |
-lae sar defined(rom(1,3)) | | | | lae $1 aar $2 sti rom(1,3) |
-sar $1==2 | R16 |
- "jsr Sar"
- | | |
-sar ND | R16 |
- "jsr Test2"
- "jsr Sar"
- | | |
-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 | R16 |
- "pha"
- "txa"
- "asl a"
- "tax"
- "pla"
- "rol a"
- | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | R16 |
- "pha"
- "txa"
- "asl a"
- "tax"
- "pla"
- "rol a"
- | %[1] | adi 2 adp (0-rom(1,1))*2 |
-lae aar $2==2 && rom(1,3)>2 && rom(1,1)==0 | |
- | | loc rom(1,3) mli 2 adi 2 |
-lae aar $2==2 && rom(1,3)>2 && rom(1,1)!=0 | |
- | | loc rom(1,3) mli 2 adi 2 adp (0-rom(1,1))*rom(1,3) |
-aar $1==2 | R16 |
- "jsr Aar"
- | %[1] | |
-aar ND | R16 |
- "jsr Test2"
- "jsr Aar"
- | %[1] | |
-
-
-/* GROUP 12 - COMPARE */
-
-cmi $1==2 | R16 |
- "jsr Cmi"
- | %[1] | |
-cmi $1==4 | |
- allocate(R16)
- "jsr Cmi4"
- | %[a] | |
-cmi ND | R16 |
- "jsr Test2"
- "jsr Cmi"
- | %[1] | |
-cmu $1==2 | R16 |
- "jsr Cmu2"
- | %[1] | |
-cmu $1==4 | |
- allocate(R16)
- "jsr Cmu4"
- | %[a] | |
-cmu ND | R16 |
- "jsr Test2"
- "jsr Cmu"
- | | |
-cmp | |
- | | cmu 2 |
-cms $1==2 | |
- allocate(R16)
- "ldy #2"
- "jsr Cms"
- | %[a] | |
-cms $1==4 | |
- allocate(R16)
- "ldy #4"
- "jsr Cms"
- | %[a] | |
-cms ND | R16 |
- "jsr TestFFh"
- "iny"
- "jsr Cms"
- | %[1] | |
-tlt | R16 |
- "jsr Tlt"
- | %[1] | |
-tle | R16 |
- "jsr Tle"
- | %[1] | |
-teq | R16 |
- "jsr Teq"
- | %[1] | |
-tne | R16 |
- "jsr Tne"
- | %[1] | |
-tge | R16 |
- "jsr Tge"
- | %[1] | |
-tgt | R16 |
- "jsr Tgt"
- | %[1] | |
-
-
-/* GROUP 13 - BRANCH */
-
-bra | |
- remove(ALL)
- "jmp $1"
- | | |
-
-blt | R16 |
- "jsr Sbi2"
- "bmi $1"
- | | |
-ble | R16 |
- "jsr Sbi2"
- "bmi $1"
- "bne 1f"
- "txa"
- "beq $1\n1:"
- | | |
-beq | R16 |
- "sta BRANCH+1"
- "stx BRANCH"
- "jsr Pop"
- "cmp BRANCH+1"
- "bne 1f"
- "cpx BRANCH"
- "beq $1\n1:"
- | | |
-bne | R16 |
- "sta BRANCH+1"
- "stx BRANCH"
- "jsr Pop"
- "cmp BRANCH+1"
- "bne $1"
- "cpx BRANCH"
- "bne $1"
- | | |
-bge | R16 |
- "jsr Sbi2"
- "bpl $1"
- | | |
-bgt | R16 |
- "jsr Sbi2"
- "bmi 1f"
- "bne $1"
- "txa"
- "bne $1\n1:"
- | | |
-
-cmi zlt $1==2 | | | | blt $2 |
-cmp zlt | | | | blt $2 |
-zlt | R16 |
- "tay"
- "bmi $1"
- | | |
-cmi zle $1==2 | | | | ble $2 |
-cmp zle | | | | ble $2 |
-zle | R16 |
- "tay"
- "bmi $1"
- "bne 1f"
- "txa"
- "beq $1\n1:"
- | | |
-cmi zeq $1==2 | | | | beq $2 |
-cmp zeq | | | | beq $2 |
-cms zeq $1==2 | | | | beq $2 |
-zeq | R16 |
- "tay"
- "bne 1f"
- "txa"
- "beq $1\n1:"
- | | |
-cmi zne $1==2 | | | | bne $2 |
-cmp zne | | | | bne $2 |
-cms zne $1==2 | | | | bne $2 |
-zne | R16 |
- "tay"
- "bne $1"
- "txa"
- "bne $1"
- | | |
-cmi zge $1==2 | | | | bge $2 |
-cmp zge | | | | bge $2 |
-zge | R16 |
- "tay"
- "bpl $1"
- | | |
-cmi zgt $1==2 | | | | bgt $2 |
-cmp zgt | | | | bgt $2 |
-zgt | R16 |
- "tay"
- "bmi 1f"
- "bne $1"
- "txa"
- "bne $1\n1:"
- | | |
-
-
-/* GROUP 14 - PROCEDURE CALL */
-
-cai | R16 |
- "stx ADDR"
- "sta ADDR+1"
- "jsr Indir"
- | | |
-cal | |
- remove(ALL)
- "jsr $1"
- | | |
-lfr $1==2 | |
- allocate(R16)
- "lda #0"
- "ldx #RETURN"
- "jsr Loi"
- | %[a] | |
-lfr $1==4 | |
- allocate(R16)
- "lda #0"
- "ldx #RETURN"
- "jsr Ldi"
- | | |
-lfr ret $1==$2 | | | | ret 0 |
-asp lfr ret $2==$3 | | | | ret 0 |
-ret $1==0 || $1==2 || $1==4 | |
- allocate(R16)
- "ldy #$1"
- "jmp Ret"
- | | |
-
-
-/* GROUP 15 - MISCELLANOUS */
-
-asp | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jsr Asp"
- | | |
-ass $1==2 | R16 |
- "jsr Asp"
- | | |
-ass ND | R16 |
- "jsr Test2"
- "jsr Pop"
- "jsr Asp"
- | | |
-blm $1==0 | | | | asp 4 |
-blm D | R16 |
- "ldy #[[$1].h+1]"
- "sty NBYTES+1"
- "ldy #[$1].l"
- "jsr Blm"
- | | |
-bls $1==2 | R16 |
- "sta NBYTES+1"
- "inc NBYTES+1"
- "txa"
- "tay"
- "jsr Pop"
- "jsr Blm"
- | | |
-bls ND | R16 |
- "jsr Test2"
- "sta NBYTES+1"
- "inc NBYTES+1"
- "txa"
- "tay"
- "jsr Pop"
- "jsr Blm"
- | | |
-csa | R16 |
- "jmp Csa"
- | | |
-csb | R16 |
- "jmp Csb"
- | | |
-dch | | | | loi 2 |
-dup $1==2 | R16 |
- "jsr Push"
- | %[1] | |
-dup $1<=256 | |
- allocate(R16)
- "ldy #[$1].l"
- "jsr Dup"
- | | |
-dus $1==2 | R16 |
- "jsr TestFFh"
- "iny"
- "jsr Dup"
- | | |
-exg $1==2 | R16 |
- "jsr Exg2"
- | %[1] | |
-exg $1<=255 | |
- allocate(R16)
- "ldy #$1"
- "jsr Exg"
- | | |
-fil | |
- "ldy #[$1].l"
- "sty hol0+4"
- "ldy #[$1].h"
- "sty hol0+5"
- | | |
-gto | |
- allocate(R16)
- "lda #[$1].h"
- "ldx #[$1].l"
- "jmp Gto"
- | | |
-lim | |
- allocate(R16)
- "ldx IGNMASK"
- "lda IGNMASK+1"
- | %[a] | |
-lin | |
- "ldy #[$1].l"
- "sty hol0"
- "ldy #[$1].h"
- "sty hol0+1"
- | | |
-lni | |
- "inc hol0"
- "bne 1f"
- "inc hol0+1\n1:"
- | | |
-lor $1==0 | |
- allocate(R16)
- "ldx LB"
- "lda LB+1"
- | %[a] | |
-lor $1==1 | |
- allocate(R16)
- "ldx SP+2"
- "lda SP+1"
- | %[a] | |
-lor $1==2 | |
- allocate(R16)
- "ldx HP"
- "lda HP+1"
- | %[a] | |
-lpb | | | | adp 2 |
-mon | R16 |
- "jsr Mon"
- | %[1] | |
-nop | |
- allocate(R16)
- "jsr Printstack"
- | | |
-rck | R16 | | | |
-rtt | |
- remove(ALL)
- "jmp Rtt"
- | | |
-sig | R16 |
- "pha"
- "txa"
- "pha"
- "ldx ERRPROC"
- "lda ERRPROC+1"
- "jsr Push"
- "pla"
- "sta ERRPROC"
- "pla"
- "sta ERRPROC+1"
- | | |
-sim | R16 |
- "stx IGNMASK"
- "sta IGNMASK+1"
- | | |
-str $1==0 | R16 |
- "stx LB"
- "sta LB+1"
- "tay"
- "sec"
- "txa"
- "sbc #BASE"
- "sta LBl"
- "tya"
- "sbc #0"
- "sta LBl+1"
- | | |
-str $1==1 | R16 |
- "stx SP+2"
- "sta SP+1"
- | | |
-str $1==2 | R16 |
- "stx HP"
- "sta HP+1"
- | | |
-trp | R16 |
- "jsr Trap"
- | | |
-lol lal sti $1==$2 && $3==1 | | | | | /* throw away funny C-proc-prolog */
-
- | STACK |
- allocate(R16)
- "jsr Pop"
- | %[a] | |
-
-/* FLOATING POINT
- * Every EM floating point instruction is translated
- * into a library call. At present, these library
- * routines generate an 'Illegal EM instruction' trap.
- */
-
-
-adf $1==4 | STACK |
- "jsr Adf4"
- | | |
-adf $1==8 | STACK |
- "jsr Adf8" | | |
-
-sbf $1==4 | STACK |
- "jsr Sbf4"
- | | |
-sbf $1==8 | STACK |
- "jsr Sbf8" | | |
-
-mlf $1==4 | STACK |
- "jsr Mlf4"
- | | |
-mlf $1==8 | STACK |
- "jsr Mlf8" | | |
-
-dvf $1==4 | STACK |
- "jsr Dvf4"
- | | |
-dvf $1==8 | STACK |
- "jsr Dvf8" | | |
-
-ngf $1==4 | STACK |
- "jsr Ngf4"
- | | |
-ngf $1==8 | STACK |
- "jsr Ngf8" | | |
-
-zrf $1==4 | STACK |
- "jsr Zrf4"
- | | |
-zrf $1==8 | STACK |
- "jsr Zrf8" | | |
-
-cmf $1==4 | STACK |
- "jsr Cmf4"
- | | |
-cmf $1==8 | STACK |
- "jsr Cmf8" | | |
-
-fef $1==4 | STACK |
- "jsr Fef4"
- | | |
-fef $1==8 | STACK |
- "jsr Fef8" | | |
-
-fif $1==4 | STACK |
- "jsr Fif4"
- | | |
-fif $1==8 | STACK |
- "jsr Fif8" | | |
-
-cfi | STACK |
- "jsr Cfi" | | |
-
-cif | STACK |
- "jsr Cif" | | |
-
-cuf | STACK |
- "jsr Cuf" | | |
-
-cff | STACK |
- "jsr Cff" | | |
-
-cfu | STACK |
- "jsr Cfu" | | |
-
-lfr $1==8 | STACK |
- "jsr Lfr8" | | |
-
-ret $1==8 | STACK |
- "jmp Ret8" | | |
-
-/*************\
-* M O V E S *
-\*************/
-
-MOVES: (AAA,AAA,"nop")
-
-STACKS: (R16, , "jsr Push")
+++ /dev/null
-CFLAGS=-O
-
-dl: dl.o
- cc -o dl -n dl.o
-
-install: dl
- ../../install dl
-
-cmp: dl
- -../../compare dl
-
-opr:
- make pr | opr
-
-pr:
- @pr `pwd`/dl.c
-
-clean:
- -rm -f *.o *.old dl
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=6500" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-all:
- cp head.s head_em
- ../../install head_em
- rm -f head_em
- cp e.a tail_em
- ../../install tail_em
- rm -f head_em tail_em
+++ /dev/null
-MACH=`(cd .. ; basename \`pwd\`)`
-cmp $1 ../../../lib/${MACH}/$1
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int" "SUF=m"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-LIBM="PREF=m" "SRC=lang/cem/libcc/libm"
-LIBLN="PREF=ln" "SRC=lang/cem/libcc/libln"
-
-install: cpstdio cpgen cplibm cplibln
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-cplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tailcp
-cplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmplibm cmplibln
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-cmplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tail
- -../../compare tail_m
-cmplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tail
- -../../compare tail_ln
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int" "SUF=m"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int24" "SUF=m"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-LIBM="PREF=m" "SRC=lang/cem/libcc/libm"
-LIBLN="PREF=ln" "SRC=lang/cem/libcc/libln"
-
-install: cpstdio cpgen cplibm cplibln
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-cplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tailcp
-cplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmplibm cmplibln
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-cmplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tail
- -../../compare tail_m
-cmplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tail
- -../../compare tail_ln
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -Rcpp=/lib/cpp -I/usr/em/h ${MACHFL?} -LIB $1 1>&2
-echo `basename $1 $2`.m
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int24" "SUF=m"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -Rcpp=/lib/cpp -I/usr/em/h ${MACHFL?} -LIB $1 1>&2
-echo `basename $1 $2`.m
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int44" "SUF=m"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-LIBM="PREF=m" "SRC=lang/cem/libcc/libm"
-LIBLN="PREF=ln" "SRC=lang/cem/libcc/libln"
-
-install: cpstdio cpgen cplibm cplibln cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-cplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tailcp
-cplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmplibm cmplibln
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-cmplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tail
- -../../compare tail_m
-cmplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tail
- -../../compare tail_ln
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -Rcpp=/lib/cpp -I/usr/em/h ${MACHFL?} -LIB $1 1>&2
-echo `basename $1 $2`.m
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=int44" "SUF=m"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -Rcpp=/lib/cpp -I/usr/em/h ${MACHFL?} -LIB $1 1>&2
-echo `basename $1 $2`.m
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=8080" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=i86" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-LIBDIR=../lib
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -cmp tail_cc.1s $(LIBDIR)/tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -cmp head_cc $(LIBDIR)/head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -cmp tail_cc.2g $(LIBDIR)/tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -cmp tail_mon $(LIBDIR)/tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?ack} -I/usr/em/h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=i86" "SUF=s"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?ack} -I/usr/em/h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-MACH=`(cd .. ; basename \`pwd\`)`
-if cp $1 ../../../lib/${MACH}/$1 >/dev/null 2>&1 ||
- { rm -f ../../../lib/${MACH}/$1 >/dev/null 2>&1 &&
- cp $1 ../../../lib/${MACH}/$1 >/dev/null 2>&1
- }
-then
- set -
- ranlib ../../../lib/${MACH}/$1 >/dev/null 2>&1
- exit 0
-else
- echo Sorry, can not create "lib/${MACH}/$1".
-fi
+++ /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
- *
- */
-
-/*
- * machine dependent back end routines for the Motorola 68000
- */
-
-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 == 0)
- w <<= 8;
- part_word |= w;
- } else {
- assert(sz == 2);
- part_word = w;
- }
- part_size += sz;
-}
-
-con_mult(sz) word sz; {
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- fprintf(codefile,".long %s\n",str);
-}
-
-con_float() {
-
-static int been_here;
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- fprintf(codefile,".long\t");
- if (argval == 8)
- fprintf(codefile,"F_DUM,");
- fprintf(codefile,"F_DUM\n");
- if ( !been_here++)
- {
- fprintf(stderr,"Warning : dummy float-constant(s)\n");
- }
-}
-
-#ifdef REGVARS
-
-regscore(off,size,typ,score,totyp)
- long off;
-{
- if (score == 0) return -1;
- switch(typ) {
- case reg_float:
- return -1;
- case reg_pointer:
- if (size != 4 || totyp != reg_pointer) return -1;
- score *= 2;
- break;
- case reg_loop:
- score += 5;
- /* fall through .. */
- case reg_any:
- if (size != 2 || totyp == reg_pointer) return -1;
- break;
- }
- if (off >= 0) {
- /* parameters must be initialised with an instruction
- * like "move.w 4(a6),d0", which costs 2 words.
- */
- score -= 2;
- }
- score -= 1; /* take save/restore into account */
- return score;
-}
-struct regsav_t {
- char *rs_reg; /* e.g. "a3" or "d5" */
- long rs_off; /* offset of variable */
- int rs_size; /* 2 or 4 bytes */
-} regsav[9];
-
-
-int regnr;
-
-i_regsave()
-{
- regnr = 0;
-}
-
-#define MOVEM_LIMIT 2
-/* If #registers to be saved exceeds MOVEM_LIMIT, we
-* use the movem instruction to save registers; else
-* we simply use several move.l's.
-*/
-
-save()
-{
- register struct regsav_t *p;
-
- if (regnr > MOVEM_LIMIT) {
- fprintf(codefile,"movem.l ");
- for (p = regsav; ;) {
- fprintf(codefile,"%s",p->rs_reg);
- if (++p == ®sav[regnr]) break;
- putc('/',codefile);
- }
- fprintf(codefile,",-(sp)\n");
- } else {
- for (p = regsav; p < ®sav[regnr]; p++) {
- fprintf(codefile,"move.l %s,-(sp)\n",p->rs_reg);
- }
- }
- /* initialise register-parameters */
- for (p = regsav; p < ®sav[regnr]; p++) {
- if (p->rs_off >= 0) {
- fprintf(codefile,"move.%c %ld(a6),%s\n",
- (p->rs_size == 4 ? 'l' : 'w'),
- p->rs_off,
- p->rs_reg);
- }
- }
-}
-
-restr()
-{
- register struct regsav_t *p;
-
- if (regnr > MOVEM_LIMIT) {
- fprintf(codefile,"movem.l (sp)+,");
- for (p = regsav; ;) {
- fprintf(codefile,"%s",p->rs_reg);
- if (++p == ®sav[regnr]) break;
- putc('/',codefile);
- }
- putc('\n',codefile);
- } else {
- for (p = ®sav[regnr-1]; p >= regsav; p--) {
- fprintf(codefile,"move.l (sp)+,%s\n",p->rs_reg);
- }
- }
- fprintf(codefile,"unlk a6\n");
- fprintf(codefile,"rts\n");
-}
-
-
-f_regsave()
-{
- save();
-}
-
-regsave(str,off,size)
- char *str;
- long off;
-{
- assert (regnr < 9);
- regsav[regnr].rs_reg = str;
- regsav[regnr].rs_off = off;
- regsav[regnr++].rs_size = size;
- fprintf(codefile, "!Local %ld into %s\n",off,str);
-}
-
-regreturn()
-{
- restr();
-}
-
-#endif
-
-prolog(nlocals) full nlocals; {
-
- fprintf(codefile,"tst.b -%D(sp)\nlink\ta6,#-%D\n",nlocals+40,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,".define %s\n",argstr) ;
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
+++ /dev/null
-#define ex_ap(y) fprintf(codefile,".extern %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 dlbdlb(x,y) fprintf(codefile,"%s = %s\n",x,y)
-#define newlbss(l,x) fprintf(codefile,"%s:.space\t%D\n",l,x);
-
-#define pop_fmt "(sp)+"
-#define cst_fmt "%D"
-#define off_fmt "%D"
-#define ilb_fmt "I%03x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define loc_off "%d(a6)"
-#define arg_off "8+%d(a6)"
-#define hol_off "%d+hol%d"
-
-#define con_cst(x) fprintf(codefile,".short\t%d\n",x)
-#define con_ilb(x) fprintf(codefile,".long\t%s\n",x)
-#define con_dlb(x) fprintf(codefile,".long\t%s\n",x)
-
-#define modhead ""
-
-#define id_first '_'
-#define BSS_INIT 0
-
+++ /dev/null
-"$Header$"
-/*
- * (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
- *
- */
-
-/***********************************************************************
- ***** *****
- ***** 6 8 0 0 0 B A C K E N D T A B L E S *****
- ***** *****
- ***********************************************************************/
-
-
-
-/*
- * INTEGER SIZE: 16 bits
- * POINTER SIZE: 32 bits
- */
-
-#define REGVARS
-
-EM_WSIZE = 2
-EM_PSIZE = 4
-EM_BSIZE = 8
-
-
-
-/***************************
- ** R E G I S T E R S **
- ***************************/
-
-REGISTERS:
-D0 = ("d0",2) DATAREG.
-D1 = ("d1",2) DATAREG.
-D2 = ("d2",2) DATAREG.
-
-/* Note: the order of the registers is important: it is used by
- * the .gto routine in the tail_em library.
- */
-
-#ifdef REGVARS
-D7 = ("d7",2) regvar, DATAREG.
-D6 = ("d6",2) regvar, DATAREG.
-D5 = ("d5",2) regvar, DATAREG.
-D4 = ("d4",2) regvar, DATAREG.
-D3 = ("d3",2) regvar, DATAREG.
-#else
-D3 = ("d3",2) DATAREG.
-D4 = ("d4",2) DATAREG.
-D5 = ("d5",2) DATAREG.
-D6 = ("d6",2) DATAREG.
-D7 = ("d7",2) DATAREG.
-#endif
-
-#ifndef REGVARS
-DD7 = ("d7",4,D7) DATAREG4.
-DD6 = ("d6",4,D6) DATAREG4.
-DD5 = ("d5",4,D5) DATAREG4.
-DD4 = ("d4",4,D4) DATAREG4.
-DD3 = ("d3",4,D3) DATAREG4.
-#endif
-DD2 = ("d2",4,D2) DATAREG4.
-DD1 = ("d1",4,D1) DATAREG4.
-DD0 = ("d0",4,D0) DATAREG4.
-
-A0 = ("a0",4) ADDREG.
-A1 = ("a1",4) ADDREG.
-#ifdef REGVARS
-A5 = ("a5",4) regvar(pointer), ADDREG.
-A4 = ("a4",4) regvar(pointer), ADDREG.
-A3 = ("a3",4) regvar(pointer), ADDREG.
-A2 = ("a2",4) regvar(pointer), ADDREG.
-#else
-A2 = ("a2",4) ADDREG.
-A3 = ("a3",4) ADDREG.
-A4 = ("a4",4) ADDREG.
-A5 = ("a5",4) ADDREG.
-#endif
-
-LB = ("a6",4) LOCALBASE.
-
-
-
-
-
-/*****************
- ** T O K E N S **
- *****************/
-
-TOKENS:
-IADDREG = {REGISTER reg;} 2 cost=(0,2) "(%[reg])"
- /* indirect address reg. */
-IADDREG1 = {REGISTER reg;} 2 cost=(0,2) "(%[reg])"
-DISPL = {REGISTER reg;
- INT dis;} 2 cost=(2,4) "%[dis](%[reg])"
- /* displacement */
-DISPL1 = {REGISTER reg;
- INT dis;} 2 cost=(2,4) "%[dis](%[reg])"
-INDEXED = {REGISTER reg,ireg;
- INT di;} 2 cost=(2,5) "%[di](%[reg],%[ireg].w)"
-ABS = {STRING addr;} 2 cost=(3,5) "%[addr]"
-ABS1 = {STRING addr;} 2 cost=(3,5) "%[addr]"
-IMMEDIATE = {INT cc;} 2 cost=(1,2) "#%[cc]"
-LOCAL_ADDR = {INT off;} 4 /* not really addressable */
-REGOFF_ADDR = {REGISTER reg;
- INT off;} 4 /* not really addressable */
-EXTERNAL_ADDR = {STRING off;} 4 cost=(4,4) "#%[off]"
-INDEX_ADDR = {REGISTER reg,ireg;
- INT di;} 4
-
-IADDREG4 = {REGISTER reg;} 4 cost=(0,4) "(%[reg])" /* indirect address reg. */
-DISPL4 = {REGISTER reg;
- INT dis;} 4 cost=(2,6) "%[dis](%[reg])" /* disisplacement */
-INDEXED4 = {REGISTER reg,ireg;
- INT di;} 4 cost=(2,7) "%[di](%[reg],%[ireg].w)"
-/* The ABS addressing mode requires either 1 or 2 words of extension.
- * We just use the average (1.5 words=2bytes). The access time is either
- * 4 or 6 cycles, so we use 5.
- */
-
-ABS4 = {STRING addr;} 4 cost=(3,7) "%[addr]"
-IMMEDIATE4 = {INT cc;} 4 cost=(4,4) "#%[cc]"
-DOUBLE = {STRING cc;} 4 cost=(4,4) "#%[cc]"
-DOUBLEZERO = { } 4
-
-
-
-
-/*************************************
- ** T O K E N E X P R E S S I O N S **
- *************************************/
-
-TOKENEXPRESSIONS:
-DATA = DATAREG + IADDREG + DISPL + INDEXED +
- ABS + IMMEDIATE
-MEMORY = DATA - DATAREG
-CONTROL = MEMORY - IMMEDIATE
-ALTERABLE = DATAREG + IADDREG + DISPL +
- INDEXED + ABS
-ANY = DATA + MEMORY + CONTROL + ALTERABLE
-DATA_ALT = DATA * ALTERABLE
-ALT_MEM = ALTERABLE * MEMORY
-
-DATASCR = DATAREG * SCRATCH
-ADDSCR = ADDREG * SCRATCH
-MEM_ALL = ALL - DATAREG - DATAREG4 - ADDREG - IMMEDIATE - IMMEDIATE4
- - LOCAL_ADDR -REGOFF_ADDR - EXTERNAL_ADDR - DOUBLE - DOUBLEZERO
-ALL_ACCESSIBLE = IADDREG + IADDREG4 + IADDREG1 + INDEXED + INDEXED4
-
-ANY1 = DISPL1 + ABS1 + IADDREG1
-DATA_ALT1 = ANY1
-DATA_ALT_1OR2 = DATA_ALT + DATA_ALT1
-
-
-REG4 = DATAREG4 + ADDREG
-DATA4 = DATAREG4 + IADDREG4 + DISPL4 + INDEXED4 +
- ABS4 + IMMEDIATE4 + DOUBLE
-MEMORY4 = DATA4 - DATAREG4
-CONTROL4 = MEMORY4 - IMMEDIATE4 - DOUBLE
-ALTERABLE4 = DATAREG4 + ADDREG + IADDREG4 + DISPL4 +
- INDEXED4 + ABS4
-ANY4 = DATA4 + MEMORY4 + CONTROL4 + ALTERABLE4 + LOCALBASE +
- EXTERNAL_ADDR
-DATA_ALT4 = DATA4 * ALTERABLE4
-ALT_MEM4 = ALTERABLE4 * MEMORY4
-
-DATASCR4 = DATAREG4 * SCRATCH
-
-
-
-
-
-/*************
- ** C O D E **
- *************/
-
-CODE:
-
-/* G R O U P I : L O A D S */
-
-loc | | | {IMMEDIATE,$1} | |
-loc loc $1==0 && $2==0 | | | {DOUBLEZERO} | |
-ldc | | | {DOUBLE, $1} | |
-#ifdef REGVARS
-lol inreg($1)==2 | | | regvar($1) | |
-#endif
-lol | | | {DISPL,LB,$1} | |
-#ifdef REGVARS
-ldl inreg($1)==2 | | | regvar($1) | |
-#endif
-ldl | | | {DISPL4,LB,$1} | |
-loe | | | {ABS,$1} | |
-lde | | | {ABS4,$1} | |
-#ifdef REGVARS
-lil inreg($1) == 2 | | | {IADDREG, regvar($1)} | |
-#endif
-lil | | allocate(ADDREG = {DISPL4,LB,$1})| {IADDREG,%[a]} | |
-lof | ADDREG | | {DISPL,%[1],$1} | |
-... | nocoercions: EXTERNAL_ADDR | | {ABS,%[1.off]+"+"+tostring($1)} | |
-... | nocoercions: LOCAL_ADDR | | {DISPL,LB,%[1.off]+$1} | |
-... | nocoercions: REGOFF_ADDR | | {DISPL,%[1.reg],%[1.off]+$1} | |
-ldf | ADDREG | | {DISPL4,%[1],$1} | |
-... | nocoercions: EXTERNAL_ADDR | | {ABS4,%[1.off]+"+"+tostring($1)} | |
-... | nocoercions: LOCAL_ADDR | | {DISPL4,LB,%[1.off]+$1} | |
-... | nocoercions: REGOFF_ADDR | | {DISPL4,%[1.reg],%[1.off]+$1} | |
-lal | | | {LOCAL_ADDR,$1} | |
-| LOCAL_ADDR | allocate(ADDREG)
- "lea %[1.off](a6),%[a]"
- samecc | %[a] | |
-| REGOFF_ADDR | allocate(ADDREG)
- "lea %[1.off](%[1.reg]),%[a]"
- samecc | %[a] | |
-lae | | | {EXTERNAL_ADDR,$1} | |
-| EXTERNAL_ADDR | allocate(ADDREG)
- "lea %[1.off],%[a]"
- samecc | %[a] | | (3,5)
-
-/* For the lxl and lxa instructions we assume that the static link
- * (i.e. a pointer to the LB of the lexically enclosing subprogram)
- * is passed as zero-th actual parameter. The distance (in bytes)
- * between LB and the zero-th parameter is the constant EM_BSIZE
- */
-
-lxl $1 == 0 | | | LB | |
-lxl $1 == 1 | | | {DISPL4,LB,8} | |
-lxl $1>1 | |
- allocate(ADDREG,DATAREG = {IMMEDIATE,$1-1})
- "move.l a6,%[a]"
- "1:"
- "move.l 8(%[a]),%[a]"
- "dbf %[b],1b"
- erase(%[b]) | %[a] | |
-lxa $1 == 0 | |
- allocate(ADDREG = {IMMEDIATE4,8})
- "add.l a6,%[a]"
- erase(%[a]) | %[a] | |
-lxa $1 > 0 | |
- allocate(ADDREG, DATAREG = {IMMEDIATE,$1-1})
- "move.l a6,%[a]"
- "1:"
- "move.l 8(%[a]),%[a]"
- "dbf %[b],1b"
- "add.l #8,%[a]"
- erase(%[b]) | %[a] | |
-loi $1 == 1 | ADDREG | | {IADDREG1, %[1]} | |
-... | nocoercions: LOCAL_ADDR | | {DISPL1,LB,%[1.off]} | |
-... | nocoercions: REGOFF_ADDR | | {DISPL1,%[1.reg],%[1.off]} | |
-... | nocoercions: EXTERNAL_ADDR | | {ABS1,%[1.off]} | |
-loi $1 == 2 | ADDREG | | {IADDREG,%[1]} | |
-loi $1 == 4 | ADDREG | | {IADDREG4,%[1]} | |
-lal loi $2 == 6 | | remove(ALL)
- "move.w $1+4(a6),-(sp)"
- "move.l $1(a6),-(sp)" | | |
-lal loi $2 == 8 | | remove(ALL)
- "move.l $1+4(a6),-(sp)"
- "move.l $1(a6),-(sp)" | | |
-lae loi $2 == 6 | | remove(ALL)
- "move.w $1+4,-(sp)"
- "move.l $1,-(sp)" | | |
-lae loi $2 == 8 | | remove(ALL)
- "move.l $1+4,-(sp)"
- "move.l $1,-(sp)" | | |
-loi $1 == 6 | ADDREG | | {DISPL,%[1],4} {IADDREG4,%[1]} | |
-loi $1 == 8 | ADDREG | | {DISPL4,%[1],4} {IADDREG4,%[1]} | |
-loi $1 > 8 | ADDSCR | remove(ALL)
- allocate(DATAREG4= {IMMEDIATE4,$1/2-1})
- "add.l #$1,%[1]"
- "1:"
- "move.w -(%[1]),-(sp)"
- "dbf %[a],1b"
- erase(%[a]) | | |
- ... | nocoercions: LOCAL_ADDR |
- remove(ALL)
- allocate(DATAREG4 = {IMMEDIATE4,$1/2-1},
- ADDREG)
- "lea %[1.off]+$1(a6),%[b]"
- "1:"
- "move.w -(%[b]),-(sp)"
- "dbf %[a],1b"
- erase(%[a]) | | |
- ... | nocoercions: EXTERNAL_ADDR |
- remove(ALL)
- allocate(DATAREG4={IMMEDIATE4,$1/2-1},
- ADDREG)
- "lea %[1.off]+$1,%[b]"
- "1:"
- "move.w -(%[b]),-(sp)"
- "dbf %[a],1b"
- erase(%[a]) | | |
-los $1 == 2 | |
- remove(ALL)
- "jsr .los" | | |
-lpi | | | {EXTERNAL_ADDR,$1} | |
-
-
-
-
-/* G R O U P II : S T O R E S */
-
-
-/* A store instruction can always corrupt part of the fakestack,
- * so some items of the stack have to be removed (i.e. pushed on
- * the real stack or stored in a register). Registers on the
- * fakestack will never be corrupted, because they can never be
- * the destination.
- * For most store instructions (e.g. sil,stf) we have hardly any
- * idea what the destination will be, so everything on the
- * fakestack (except registers) is removed (i.e. remove(MEM_ALL)).
- * For a stl,sdl,ste and sde we remove only those items that may
- * be affected, assuming that a stl only affects locals and a
- * ste only affects externals. Care has to be taken that doubles
- * and singles may overlap, e.g. "lol 6 sdl 4".
- * Furthermore, stacktoken instances that resulted from a lof,lif
- * or loi may be corrupted too.
- */
-
-
-#ifdef REGVARS
-stl inreg($1)==2 | nocoercions: ANY | remove(regvar($1))
- move(%[1],regvar($1)) | | |
-... | STACK |
- "move.w (sp)+,%(regvar($1)%)" | | |
-#endif
-stl | nocoercions: ANY | remove(DISPL,%[reg] == LB && %[dis] == $1)
- remove(DISPL4,%[reg] == LB && (%[dis] == $1-2 ||
- %[dis] == $1))
- remove(DISPL1,%[reg] == LB && (%[dis] == $1 ||
- %[dis] == $1+1))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- move(%[1],{DISPL,LB,$1}) | | |
-... | STACK |
- "move.w (sp)+,$1(a6)" | | |
-ste | ANY |
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- move(%[1],{ABS,$1}) | | |
-#ifdef REGVARS
-sil inreg($1)==2 | ANY | remove(MEM_ALL)
- move(%[1],{IADDREG,regvar($1)}) | | |
-#endif
-sil | ANY | allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- move(%[1],{IADDREG,%[a]})
- setcc({IADDREG,%[a]}) | | |
-stf | ADDREG ANY | remove(MEM_ALL)
- move(%[2],{DISPL,%[1],$1}) | | |
-sti $1 == 1
- | ADDREG DATAREG |
- remove(MEM_ALL)
- move(%[2], {IADDREG1,%[1]}) | | |
-... | ADDREG IADDREG |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],1}, {IADDREG1,%[1]}) | | |
-... | ADDREG DISPL |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],%[2.dis]+1}, {IADDREG1,%[1]}) | | |
-... | ADDREG INDEXED |
- remove(MEM_ALL)
- move({INDEXED,%[2.reg],%[2.ireg],%[2.di]+1},
- {IADDREG1,%[1]}) | | |
-... | ADDREG ABS |
- remove(MEM_ALL)
- move({ABS,%[2.addr]+"+1"}, {IADDREG1,%[1]}) | | |
-... | ADDREG IMMEDIATE |
- remove(MEM_ALL)
- move({IMMEDIATE,(%[2.cc]-((%[2.cc]>>8)<<8)+128)%256-128},
- {IADDREG1,%[1]}) | | |
-... | ADDREG ANY1 |
- remove(MEM_ALL)
- move(%[2],{IADDREG1,%[1]}) | | |
-... | nocoercions: LOCAL_ADDR DATAREG |
- remove(MEM_ALL)
- move(%[2], {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR IADDREG |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],1}, {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR DISPL |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],%[2.dis]+1}, {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR INDEXED |
- remove(MEM_ALL)
- move({INDEXED,%[2.reg],%[2.ireg],%[2.di]+1},
- {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR ABS |
- remove(MEM_ALL)
- move({ABS,%[2.addr]+"+1"}, {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR IMMEDIATE |
- remove(MEM_ALL)
- move({IMMEDIATE,(%[2.cc]-((%[2.cc]>>8)<<8)+128)%256-128},
- {DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: LOCAL_ADDR ANY1 |
- remove(MEM_ALL)
- move(%[2],{DISPL1,LB,%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR DATAREG |
- remove(MEM_ALL)
- move(%[2], {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR IADDREG |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],1}, {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR DISPL |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],%[2.dis]+1}, {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR INDEXED |
- remove(MEM_ALL)
- move({INDEXED,%[2.reg],%[2.ireg],%[2.di]+1},
- {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR ABS |
- remove(MEM_ALL)
- move({ABS,%[2.addr]+"+1"}, {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR IMMEDIATE |
- remove(MEM_ALL)
- move({IMMEDIATE,(%[2.cc]-((%[2.cc]>>8)<<8)+128)%256-128},
- {DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: REGOFF_ADDR ANY1 |
- remove(MEM_ALL)
- move(%[2],{DISPL1,%[1.reg],%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR DATAREG |
- remove(MEM_ALL)
- move(%[2], {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR IADDREG |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],1}, {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR DISPL |
- remove(MEM_ALL)
- move({DISPL,%[2.reg],%[2.dis]+1}, {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR INDEXED |
- remove(MEM_ALL)
- move({INDEXED,%[2.reg],%[2.ireg],%[2.di]+1},
- {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR ABS |
- remove(MEM_ALL)
- move({ABS,%[2.addr]+"+1"}, {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR IMMEDIATE |
- remove(MEM_ALL)
- move({IMMEDIATE,(%[2.cc]-((%[2.cc]>>8)<<8)+128)%256-128},
- {ABS1,%[1.off]}) | | |
-... | nocoercions: EXTERNAL_ADDR ANY1 |
- remove(MEM_ALL)
- move(%[2],{ABS1,%[1.off]}) | | |
-sti $1 == 2 | ADDREG ANY | remove(MEM_ALL)
- move(%[2],{IADDREG,%[1]}) | | |
-sti $1 == 4 | ADDREG ANY4 | remove(MEM_ALL)
- move(%[2],{IADDREG4,%[1]}) | | |
-sti $1 > 4 | ADDREG | remove(ALL)
- allocate(DATAREG4={IMMEDIATE4,$1/2-1})
- "1:"
- "move.w (sp)+,(%[1])+"
- "dbf %[a], 1b"
- setcc({IADDREG,%[1]}) | | |
-sts $1 == 2 | | remove(ALL)
- "jsr .sts"
- | | |
-#ifdef REGVARS
-sdl inreg($1)==2 | nocoercions: ANY4 | remove(regvar($1))
- move (%[1],regvar($1)) | | |
-... | STACK |
- "move.l (sp)+,%(regvar($1)%)" | | |
-#endif
-sdl | nocoercions: ANY4 |
- remove(DISPL,%[reg] == LB && (%[dis] == $1 || %[dis] == $1+2))
- remove(DISPL4,%[reg] == LB && (%[dis] >= $1-2 &&
- %[dis] <= $1+2))
- remove(DISPL1,%[reg] == LB && (%[dis] >= $1 &&
- %[dis] <= $1+3))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- move(%[1],{DISPL4,LB,$1}) | | |
-... | STACK |
- "move.l (sp)+,$1(a6)" | | |
-sde | ANY4 |
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- move(%[1],{ABS4,$1}) | | |
-sdf | ADDREG ANY4 | remove(MEM_ALL)
- move(%[2],{DISPL4,%[1],$1}) | | |
-
-
-#ifdef REGVARS
-
-/* R U L E S F O R R E G I S T E R V A R I A B L E S */
-
-/* Note that these rules should come before the normal patterns for
- * local variables that are not register-variables.
- */
-
-ldl ldl adp sdl loi $1==$2 && $2==$4 && inreg($1)==2 && $3==1 && $5==1 | |
- allocate(DATAREG={IMMEDIATE,0})
- remove(regvar($1))
- "move.b (%(regvar($1)%))+,%[a]" | %[a] | |
-ldl ldl adp sdl loi $1==$2 && $2==$4 && inreg($1)==2 && $3==2 && $5==2 | |
- allocate(DATAREG)
- remove(regvar($1))
- "move.w (%(regvar($1)%))+,%[a]" | %[a] | |
-ldl ldl adp sdl sti $1==$2 && $2==$4 && inreg($1)==2 && $3==1 && $5==1 | DATAREG |
- remove(regvar($1))
- "move.b %[1],(%(regvar($1)%))+" | | |
-ldl ldl adp sdl sti $1==$2 && $2==$4 && inreg($1)==2 && $3==2 && $5==2 | ANY |
- remove(regvar($1))
- "move.w %[1],(%(regvar($1)%))+" | | |
-ldl ldl adp sdl $1==$2 && $2==$4 && inreg($1)==2 | |
- allocate(ADDREG=regvar($1)) | %[a]
- | ldl $2 adp $3 sdl $2 |
-lol inl $1==$2 && inreg($1)==2 | |
- allocate(DATAREG=regvar($1)) | %[a]
- | inl $2 |
-lol inl $1==$2 | |
- allocate(DATAREG={DISPL,LB,$1}) | %[a]
- | inl $2 |
-lol del $1==$2 && inreg($1)==2 | |
- allocate(DATAREG=regvar($1)) | %[a]
- | del $2 |
-lol del $1==$2 | |
- allocate(DATAREG={DISPL,LB,$1}) | %[a]
- | del $2 |
-loe ine $1==$2 | |
- allocate(DATAREG={ABS,$1}) | %[a]
- | ine $2 |
-loe dee $1==$2 | |
- allocate(DATAREG={ABS,$1}) | %[a]
- | dee $2 |
-
-lol adi stl $1 == $3 && $2 == 2 && inreg($1)==2 | ANY |
- remove(regvar($1))
- "add.w %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-loc lil adi sil $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(MEM_ALL)
- "add.w #$1,(%(regvar($2)%))" | | |
-lil adi sil $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(ALL)
- "add.w %[1],(%(regvar($1)%))" | | |
-ldl ldc adi sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "add.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl adi sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "add.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl adi sdl $1 == $3 && $2 == 4 && inreg($1)==2 | DATAREG4 |
- remove(regvar($1))
- "add.l %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc sbi stl $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "sub.w #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lil loc adi sil $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(MEM_ALL)
- "add.w #$2,(%(regvar($1)%))" | | |
-ldl ldc sbi sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "sub.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol ngi stl $1 == $3 && $2 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "neg.w %(regvar($1)%)"
- erase(regvar($1)) | | |
-lil ngi sil $1 == $3 && $2 == 2 && inreg($1)==2 | |
- remove(MEM_ALL)
- "neg.w (%(regvar($1)%))" | | |
-lol ngi stl $1 == $3 && $2 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "neg.l %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc sli stl $1 == $4 && $2 == 1 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "asl.w #1, %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc sri stl $1 == $4 && $2 == 1 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "asr.w #1,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc sru stl $1 == $4 && $2 == 1 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "lsr.w #1,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc adu stl $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "add.w #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adu stl $1 == $3 && $2 == 2 && inreg($1)==2 | ANY |
- remove(regvar($1))
- "add.w %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-loc lil adu sil $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(MEM_ALL)
- "add.w #$1,(%(regvar($2)%))" | | |
-lil adu sil $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(MEM_ALL)
- "add.w %[1],(%(regvar($1)%))" | | |
-ldl ldc adu sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "add.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl adu sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "add.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl adu sdl $1 == $3 && $2 == 4 && inreg($1)==2 | DATAREG4 |
- remove(regvar($1))
- "add.l %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc sbu stl $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "sub.w #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lil loc adu sil $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(MEM_ALL)
- "add.w #$2,(%(regvar($1)%))" | | |
-ldl ldc sbu sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "sub.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc slu stl $1 == $4 && $2 == 1 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "asl.w #1,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldl adp sdl $1 == $3 && inreg($1)==2 | | remove(regvar($1))
- "add.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldl adp dup sdl loi inreg($1) == 2 && $1 == $4 && $3 == 4 && $5 == 4 | | | |
- ldl $1 adp $2 sdl $1 ldl $1 loi 4 |
-ldl loi ldl loi adp ldl sti $2==4&&$4==4&&$7==4&&$1==$3&&$1==$6&&inreg($1)==2
- | | remove(MEM_ALL)
- allocate(ADDREG = {IADDREG4,regvar($1)})
- "add.l #$5,(%(regvar($1)%))" | %[a] | |
-loc ldl ads sdl $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(regvar($2))
- "add.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl ldc ads sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "add.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl ads sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "add.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-lil inc sil $1==$3 && inreg($1)==2 | |
- remove(MEM_ALL)
- "add.w #1,(%(regvar($1)%))"
- setcc({IADDREG,regvar($1)}) | | |
-lil dec sil $1==$3 && inreg($1)==2 | |
- remove(MEM_ALL)
- "sub.w #1,(%(regvar($1)%))"
- setcc({IADDREG,regvar($1)}) | | |
-lol and stl $1 == $3 && $2 == 2 && inreg($1)==2 | ANY |
- remove(regvar($1))
- "and.w %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-loc lil and sil $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(MEM_ALL)
- "and.w #$1,(%(regvar($2)%))" | | |
-lil and sil $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(MEM_ALL)
- "and.w %[1],(%(regvar($1)%))" | | |
-ldl ldc and sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "and.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl and sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "and.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl and sdl $1 == $3 && $2 == 4 && inreg($1)==2 | DATAREG4 |
- remove(regvar($1))
- "and.l %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol ior stl $1 == $3 && $2 == 2 && inreg($1)==2 | ANY |
- remove(regvar($1))
- "or.w %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lil ior sil $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(MEM_ALL)
- "or.w %[1],(%(regvar($1)%))" | | |
-loc lil ior sil $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(MEM_ALL)
- "or.w #$1,(%(regvar($2)%))" | | |
-ldl ldc ior sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "or.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl ior sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "or.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl ior sdl $1 == $3 && $2 == 4 && inreg($1)==2 | DATAREG4 |
- remove(regvar($1))
- "or.l %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol loc xor stl $1 == $4 && $3 == 2 && inreg($1)==2 | |
- remove(regvar($1))
- "eor.w #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-loc lol xor stl $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(regvar($2))
- "eor.w #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-loc lil xor sil $2 == $4 && $3 == 2 && inreg($2)==2 | |
- remove(MEM_ALL)
- "eor.w #$1,(%(regvar($2)%))" | | |
-lol xor stl $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(regvar($1))
- "eor.w %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lil xor sil $1 == $3 && $2 == 2 && inreg($1)==2 | DATAREG |
- remove(MEM_ALL)
- "eor.w %[1],(%(regvar($1)%))" | | |
-ldl ldc xor sdl $1 == $4 && $3 == 4 && inreg($1)==2 | |
- remove(regvar($1))
- "eor.l #$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-ldc ldl xor sdl $2 == $4 && $3 == 4 && inreg($2)==2 | |
- remove(regvar($2))
- "eor.l #$1,%(regvar($2)%)"
- erase(regvar($2)) | | |
-ldl xor sdl $1 == $3 && $2 == 4 && inreg($1)==2 | DATAREG4 |
- remove(regvar($1))
- "eor.l %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif
-/* G R O U P III AND IV : I N T E G E R A R I T H M E T I C */
-
-adi $1 == 2 | ANY DATASCR | "add.w %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,2)+%[1]
-... | DATASCR ANY | "add.w %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,2)+%[2]
-loc lol adi stl $2 == $4 && $3 == 2 && inreg($2) < 2 | |
- remove(MEM_ALL)
- "add.w #$1,$2(a6)" | | | (6,10)
-loc lil adi sil $2 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$2})
- remove(MEM_ALL)
- "add.w #$1,(%[a])" | | |
-lol adi stl $1 == $3 && $2 == 2 && inreg($1) < 2 | DATAREG |
- remove(MEM_ALL)
- "add.w %[1],$1(a6)" | | |
-loe adi ste $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "add.w %[1],$1" | | |
-lil adi sil $1 == $3 && $2 == 2 | DATAREG |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(ALL)
- "add.w %[1],(%[a])" | | |
-loe loc adi ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "add.w #$2,$1" | | | (7,11)
-loc loe adi ste $3 == 2 && $2 == $4 | |
- remove(MEM_ALL)
- "add.w #$1,$2" | | | (7,11)
-adi $1 == 4 | ANY4 DATASCR4 | "add.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,3)+%[1]
-... | DATASCR4 ANY4 | "add.l %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,3)+%[2]
-ldl ldc adi sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$2,$1(a6)" | | | (8,16)
-ldc ldl adi sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$1,$2(a6)" | | | (8,16)
-lde ldc adi sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "add.l #$2,$1" | | | (9,17)
-ldc lde adi sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "add.l #$1,$2" | | | (9,17)
-ldl adi sdl $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "add.l %[1],$1(a6)" | | |
-lde adi sde $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "add.l %[1],$1" | | |
-sbi $1 == 2 | ANY DATASCR | "sub.w %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,2)+%[1]
-lol loc sbi stl $1 == $4 && $3 == 2 | |
- remove(MEM_ALL)
- "sub.w #$2,$1(a6)" | | | (6,10)
-loe loc sbi ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "sub.w #$2,$1" | | | (7,11)
-lil loc adi sil $1 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$1})
- remove(MEM_ALL)
- "add.w #$2,(%[a])" | | |
-sbi $1 == 4 | ANY4 DATASCR4 | "sub.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,3)+%[1]
-ldl ldc sbi sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "sub.l #$2,$1(a6)" | | | (8,16)
-lde ldc sbi sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "sub.l #$2,$1" | | | (9,17)
-mli $1 == 2 | ANY DATASCR | "muls %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-mli $1 == 4 | | remove(ALL)
- "jsr .mli"
- | DD1 | |
-dvi $1 == 2 | ANY DATASCR | "ext.l %[2]"
- "divs %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-dvi $1 == 4 | | remove(ALL)
- "jsr .dvi"
- | DD1 | |
-rmi $1 == 2 | ANY DATASCR | "ext.l %[2]"
- "divs %[1],%[2]"
- "swap %[2]"
- erase(%[2]) | %[2] | |
-rmi $1 == 4 | | remove(ALL)
- "jsr .dvi"
- | DD2 | |
-ngi $1 == 2 | DATASCR | "neg %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-lol ngi stl $1 == $3 && $2 == 2 | |
- remove(MEM_ALL)
- "neg.w $1(a6)" | | |
-loe ngi ste $1 == $3 && $2 == 2 | |
- remove(MEM_ALL)
- "neg.w $1" | | |
-lil ngi sil $1 == $3 && $2 == 2 | |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "neg.w (%[a])" | | |
-ngi $1 == 4 | DATASCR4 | "neg.l %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-lol ngi stl $1 == $3 && $2 == 4 | |
- remove(MEM_ALL)
- "neg.l $1(a6)" | | |
-loe ngi ste $1 == $3 && $2 == 4 | |
- remove(MEM_ALL)
- "neg.l $1" | | |
-loc sli $1 == 1 && $2 == 2 | DATASCR |
- "add.w %[1],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sli $1 > 1 && $1 <= 8 && $2 == 2 | DATASCR |
- "asl.w #$1,%[1]"
- erase(%[1]) | %[1] | |
-loc sli $1 == 1 && $2 == 4 | DATASCR4 |
- "add.l %[1],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sli $1 > 1 && $1 <= 8 && $2 == 4 | DATASCR4 |
- "asl.l #$1,%[1]"
- erase(%[1]) | %[1] | |
-lol loc sli ads inreg($1) == 2 && $2 == 1 && $3 == 2 && $4 == 2 | ADDSCR |
- "add.w %(regvar($1)%),%[1]"
- "add.w %(regvar($1)%),%[1]"
- erase(%[1]) | %[1] | |
-lol loc sli stl $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asl.w #1, $1(a6)" | | |
-loe loc sli ste $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asl.w #1, $1" | | |
-sli $1 == 2 | DATAREG DATASCR | "asl %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-sli $1 == 4 | DATAREG DATASCR4 | "asl.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-loc sri $1 >= 1 && $1 <= 8 && $2 == 2 | DATASCR |
- "asr.w #$1,%[1]"
- erase(%[1]) | %[1] | |
-loc sri $1 >= 1 && $1 <= 8 && $2 == 4 | DATASCR4 |
- "asr.l #$1,%[1]"
- erase(%[1]) | %[1] | |
-lol loc sri stl $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asr.w #1,$1(a6)" | | |
-loe loc sri ste $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asr.w #1,$1" | | |
-sri $1 == 2 | DATAREG DATASCR | "asr %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-sri $1 == 4 | DATAREG DATASCR4 | "asr.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-mlu $1 == 2 | ANY DATASCR | "mulu %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-mlu $1 == 4 | | remove(ALL)
- "jsr .mlu"
- | DD1 | |
-dvu $1 == 2 | ANY ANY | allocate(DATAREG)
- "clr.l %[a]"
- "move.w %[2],%[a]"
- "divu %[1],%[a]" | %[a] | |
-dvu $1 == 4 | | remove(ALL)
- "jsr .dvu"
- | DD1 | |
-rmu $1 == 2 | ANY ANY | allocate(DATAREG)
- "clr.l %[a]"
- "move.w %[2],%[a]"
- "divu %[1],%[a]"
- "swap %[a]" | %[a] | |
-rmu $1 == 4 | | remove(ALL)
- "jsr .dvu"
- | DD2 | |
-loc sru $1 >= 1 && $1 <= 8 && $2 == 2 | DATASCR |
- "lsr.w #$1,%[1]"
- erase(%[1]) | %[1] | |
-loc sru $1 >= 1 && $1 <= 8 && $2 == 4 | DATASCR4 |
- "lsr.l #$1,%[1]"
- erase(%[1]) | %[1] | |
-lol loc sru stl $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "lsr.w #1,$1(a6)" | | |
-loe loc sru ste $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "lsr.w #1,$1" | | |
-sru $1 == 2 | DATAREG DATASCR | "lsr %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-sru $1 == 4 | DATAREG DATASCR4 | "lsr.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-
-
-/* The adu instruction has precisely the same effect as an adi.
- * The same applies to (sbu,sbi) and (slu,sli)
- */
-
-lol loc adu stl $1 == $4 && $3 == 2 && inreg($1) < 2 | |
- remove(MEM_ALL)
- "add.w #$2,$1(a6)" | | |
-loc lol adu stl $2 == $4 && $3 == 2 && inreg($2) < 2 | |
- remove(MEM_ALL)
- "add.w #$1,$2(a6)" | | |
-loc lil adu sil $2 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$2})
- remove(MEM_ALL)
- "add.w #$1,(%[a])" | | |
-lol adu stl $1 == $3 && $2 == 2 && inreg($1) < 2 | DATAREG |
- remove(MEM_ALL)
- "add.w %[1],$1(a6)" | | |
-loe adu ste $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "add.w %[1],$1" | | |
-lil adu sil $1 == $3 && $2 == 2 | DATAREG |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "add.w %[1],(%[a])" | | |
-loe loc adu ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "add.w #$2,$1" | | | (7,11)
-loc loe adu ste $3 == 2 && $2 == $4 | |
- remove(MEM_ALL)
- "add.w #$1,$2" | | | (7,11)
-ldl ldc adu sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$2,$1(a6)" | | | (8,16)
-ldc ldl adu sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$1,$2(a6)" | | | (8,16)
-lde ldc adu sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "add.l #$2,$1" | | | (9,17)
-ldc lde adu sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "add.l #$1,$2" | | | (9,17)
-ldl adu sdl $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "add.l %[1],$1(a6)" | | |
-lde adu sde $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "add.l %[1],$1" | | |
-lol loc sbu stl $1 == $4 && $3 == 2 | |
- remove(MEM_ALL)
- "sub.w #$2,$1(a6)" | | | (6,10)
-loe loc sbu ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "sub.w #$2,$1" | | | (7,11)
-lil loc adu sil $1 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$1})
- remove(MEM_ALL)
- "add.w #$2,(%[a])" | | |
-ldl ldc sbu sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "sub.l #$2,$1(a6)" | | | (8,16)
-lde ldc sbu sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "sub.l #$2,$1" | | | (9,17)
-loc slu $1 >= 1 && $1 <= 8 && $2 == 2 | DATASCR |
- "asl.w #$1,%[1]"
- erase(%[1]) | %[1] | |
-loc slu $1 >= 1 && $1 <= 8 && $2 == 4 | DATASCR4 |
- "asl.l #$1,%[1]"
- erase(%[1]) | %[1] | |
-lol loc slu stl $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asl.w #1,$1(a6)" | | |
-loe loc slu ste $1 == $4 && $2 == 1 && $3 == 2 | |
- remove(MEM_ALL)
- "asl.w #1,$1" | | |
-adu | | | | adi $1 |
-sbu | | | | sbi $1 |
-slu | | | | sli $1 |
-
-
-
-/* G R O U P VI : P O I N T E R A R I T H M E T I C */
-
-adp $1 >= 1 && $1 <= 8
- | nocoercions: EXTERNAL_ADDR | | {EXTERNAL_ADDR,%[1.off] + "+"
- + tostring($1)} | |
-... | nocoercions: LOCAL_ADDR | | {LOCAL_ADDR,%[1.off]+$1} | |
-... | nocoercions: REGOFF_ADDR | | {REGOFF_ADDR,%[1.reg],%[1.off]+$1} | |
-... | nocoercions: ADDREG | | {REGOFF_ADDR,%[1],$1} | |
-... | ADDSCR | "add.l #$1,%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-adp $1 >= 0-32767 && $1 <= 32767
- | nocoercions: EXTERNAL_ADDR | | {EXTERNAL_ADDR,%[1.off] + "+"
- + tostring($1)} | |
-... | nocoercions: LOCAL_ADDR | | {LOCAL_ADDR,%[1.off]+$1} | |
-... | nocoercions: REGOFF_ADDR | | {REGOFF_ADDR,%[1.reg],%[1.off]+$1} | |
-... | nocoercions: ADDREG | | {REGOFF_ADDR,%[1],$1} | |
-... | ADDSCR | "lea $1(%[1]),%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-adp | nocoercions: EXTERNAL_ADDR | | {EXTERNAL_ADDR,%[1.off] + "+"
- + tostring($1)} | |
-... | ADDSCR | "add.l #$1,%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-
-/* The next patterns are for efficient translation of "*p++" in C */
-ldl ldl adp sdl $1 == $2 && $2 == $4 | |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(DISPL,%[reg] == LB && (%[dis] == $1 || %[dis] == $1+2))
- remove(DISPL4,%[reg] == LB && (%[dis] >= $1-2 &&
- %[dis] <= $1+2))
- remove(DISPL1,%[reg] == LB && (%[dis] >= $1 &&
- %[dis] <= $1+3))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "add.l #$3,$1(a6)" | %[a] | |
-lde lde adp sde $1 == $2 && $2 == $4 | |
- allocate(ADDREG={ABS4,$1})
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "add.l #$3,$1" | %[a] | |
-ldl adp sdl $1 == $3 | | remove(MEM_ALL)
- "add.l #$2,$1(a6)" | | | (8,16)
-lde adp sde $1 == $3 | | remove(MEM_ALL)
- "add.l #$2,$1" | | | (9,17)
-ads $1 == 2 | ANY ADDSCR | "add.w %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-ads $1 == 4 | ANY4 ADDSCR | "add.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-loc ldl ads sdl $2 == $4 && $3 == 2 | |
- remove(MEM_ALL)
- "add.l #$1,$2(a6)" | | | (8,16)
-lde loc ads sde $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "add.l #$2,$1" | | | (9,17)
-ldl ldc ads sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$2,$1(a6)" | | | (8,16)
-ldc ldl ads sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "add.l #$1,$2(a6)" | | | (8,16)
-lde ldc ads sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "add.l #$2,$1" | | | (9,17)
-ldc lde ads sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "add.l #$1,$2" | | | (9,17)
-sbs $1 == 2 | ANY4 DATASCR4 | "sub.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2.1] | |
-sbs $1 == 4 | ANY4 DATASCR4 | "sub.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-
-
-/* G R O U P VII : I N C R E M E N T / D E C R E M E N T */
-
-inc | DATASCR | "add.w #1,%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-... | STACK | "add.w #1,(sp)" | | |
-#ifdef REGVARS
-lil inc sil $1==$3 && inreg($1) == 2 | |
- remove(MEM_ALL)
- "add.w #1,(%(regvar($1)%))"
- setcc({IADDREG,regvar($1)}) | | |
-lil dec sil $1==$3 && inreg($1) == 2 | |
- remove(MEM_ALL)
- "sub.w #1,(%(regvar($1)%))"
- setcc({IADDREG,regvar($1)}) | | |
-#endif
-lil inc sil $1==$3 | | allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "add.w #1,(%[a])" | | |
-lil dec sil $1==$3 | | allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "sub.w #1,(%[a])" | | |
-#ifdef REGVARS
-inl inreg($1)==2 | | remove(regvar($1))
- "add.w #1,%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-del inreg($1)==2 | | remove(regvar($1))
- "sub.w #1,%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-zrl inreg($1)==2 | | remove(regvar($1))
- "clr.w %(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-#endif
-inl | | remove(DISPL,%[reg] == LB && %[dis] == $1)
- remove(DISPL4,%[reg] == LB && (%[dis] == $1-2 ||
- %[dis] == $1))
- remove(DISPL1,%[reg] == LB && (%[dis] == $1 ||
- %[dis] == $1+1))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "add.w #1,$1(a6)"
- setcc({DISPL,LB,$1}) | | |
-ine | |
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "add.w #1,$1"
- setcc({ABS,$1}) | | |
-dec | DATASCR | "sub.w #1,%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-... | STACK | "sub.w #1,(sp)" | | |
-del | | remove(DISPL,%[reg] == LB && %[dis] == $1)
- remove(DISPL4,%[reg] == LB && (%[dis] == $1-2 ||
- %[dis] == $1))
- remove(DISPL1,%[reg] == LB && (%[dis] == $1 ||
- %[dis] == $1+1))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "sub.w #1,$1(a6)"
- setcc({DISPL,LB,$1}) | | |
-dee | |
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "sub.w #1,$1"
- setcc({ABS,$1}) | | |
-zrl | | remove(DISPL,%[reg] == LB && %[dis] == $1)
- remove(DISPL4,%[reg] == LB && (%[dis] == $1-2 ||
- %[dis] == $1))
- remove(DISPL1,%[reg] == LB && (%[dis] == $1 ||
- %[dis] == $1+1))
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "clr $1(a6)"
- setcc({DISPL,LB,$1}) | | |
-zre | |
- remove(ABS)
- remove(ABS4)
- remove(ABS1)
- remove(DISPL,%[reg] != LB)
- remove(DISPL4,%[reg] != LB)
- remove(DISPL1,%[reg] != LB)
- remove(ALL_ACCESSIBLE)
- "clr $1"
- setcc({ABS,$1}) | | |
-zrf $1 == 4 | | | {IMMEDIATE4,0} | |
-zrf $1 == 8 | | | {IMMEDIATE4,0} {IMMEDIATE4,0} | |
-zer $1 == 2 | | | {IMMEDIATE,0} | |
-zer $1 == 4 | | | | ldc 0 |
-zer $1 == 6 | | remove(ALL)
- "clr.l -(sp)"
- "clr.w -(sp)" | | |
-zer $1 == 8 | | remove(ALL)
- "clr.l -(sp)"
- "clr.l -(sp)" | | |
-zer $1 == 10 | | remove(ALL)
- "clr.l -(sp)"
- "clr.l -(sp)"
- "clr.w -(sp)" | | |
-zer $1 == 12 | | remove(ALL)
- "clr.l -(sp)"
- "clr.l -(sp)"
- "clr.l -(sp)" | | |
-zer $1 > 12 | | remove(ALL)
- allocate(DATAREG4)
- "move.l #$1/2-1,%[a]"
- "1:"
- "clr -(sp)"
- "dbf %[a],1b" | | |
-
-
-
-/* G R O U P VIII : C O N V E R T */
-
-
-cii | | remove(ALL)
- "jsr .cii"
- | | |
-cuu | | remove(ALL)
- "jsr .cuu"
- | | |
-cui | | | | cuu |
-ciu | | | | cuu |
-
-loc loc cii $1==1 && $2==2 | DATASCR |
- "ext.w %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc loc cii $1==1 && $2==4 | ANY |
- allocate(%[1],DATAREG4)
- move(%[1],%[a.1])
- "ext.w %[a]"
- "ext.l %[a]"
- erase(%[a])
- setcc(%[a]) | %[a] | |
-loc loc cii $1==2 && $2==4 | ANY |
- allocate(%[1],DATAREG4)
- move(%[1],%[a.1])
- "ext.l %[a]"
- erase(%[a])
- setcc(%[a]) | %[a] | |
-loc loc cuu $1==2 && $2==4 | | | {IMMEDIATE,0} | |
-loc loc ciu $1==2 && $2==4 | | | {IMMEDIATE,0} | |
-loc loc cui $1==2 && $2==4 | | | {IMMEDIATE,0} | |
-
-loc loc loc cuu $1 == 0 && $2 == 2 && $3 == 4 | | | {DOUBLE,"0"} | |
-loc loc loc ciu $1 == 0 && $2 == 2 && $3 == 4 | | | {DOUBLE,"0"} | |
-loc loc loc cui $1 == 0 && $2 == 2 && $3 == 4 | | | {DOUBLE,"0"} | |
-
-loc loc cii $1==4 && $2==2 | DATAREG4 | | %[1.1] | |
-... | ANY ANY | | %[2] | |
-loc loc cuu $1==4 && $2==2 | DATAREG4 | | %[1.1] | |
-... | ANY | | | |
-loc loc ciu $1==4 && $2==2 | DATAREG4 | | %[1.1] | |
-... | ANY | | | |
-loc loc cui $1==4 && $2==2 | DATAREG4 | | %[1.1] | |
-... | ANY | | | |
-
-/* G R O U P IX : L O G I C A L */
-
-and defined($1) && $1 == 2 | ANY DATASCR |
- "and %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | | (2,2)+%[1]
-... | DATASCR ANY |
- "and %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | | (2,2)+%[2]
-lol loc and $2 == 255 && inreg($1) < 2 && $3 == 2 | | | {DISPL1,LB,$1} | |
-lal loi and lal sti $1 == $4 && $2 == 1 && $3 == 2 && $5 == 1 && inreg($1) < 2
- | DATAREG |
- remove(MEM_ALL)
- "and.b %[1],$1(a6)" | | |
-loc lol and stl $2 == $4 && $3 == 2 && inreg($2) < 2 | |
- remove(MEM_ALL)
- "and.w #$1,$2(a6)" | | | (6,10)
-loe loc and ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "and.w #$2,$1" | | | (7,11)
-loc loe and ste $3 == 2 && $2 == $4 | |
- remove(MEM_ALL)
- "and.w #$1,$2" | | | (7,11)
-loc lil and sil $2 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$2})
- remove(MEM_ALL)
- "and.w #$1,(%[a])" | | |
-lol and stl $1 == $3 && $2 == 2 && inreg($1) < 2 | DATAREG |
- remove(MEM_ALL)
- "and.w %[1],$1(a6)" | | |
-loe and ste $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "and.w %[1],$1" | | |
-lil and sil $1 == $3 && $2 == 2 | DATAREG |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "and.w %[1],(%[a])" | | |
-/* Note that the contents of an address register may not be used as
- * operand of a and, or etc. instruction
- */
-and defined($1) && $1 == 4 | ANY4-ADDREG DATASCR4 |
- "and.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,3)+%[1]
-... | DATASCR4 ANY4-ADDREG |
- "and.l %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,3)+%[2]
-ldl ldc and sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "and.l #$2,$1(a6)" | | | (8,16)
-ldc ldl and sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "and.l #$1,$2(a6)" | | | (8,16)
-lde ldc and sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "and.l #$2,$1" | | | (9,17)
-ldc lde and sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "and.l #$1,$2" | | | (9,17)
-ldl and sdl $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "and.l %[1],$1(a6)" | | |
-lde and sde $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "and.l %[1],$1" | | |
-and defined($1) && $1 > 4 | STACK |
- allocate(DATAREG4,ADDREG,DATAREG)
- "move.l #$1/2-1,%[a]"
- "move.l sp,%[b]"
- "add.l #$1,%[b]"
- "1:"
- "move.w (sp)+,%[c]"
- "and %[c],(%[b])+"
- "dbf %[a],1b" | | |
-and !defined($1) | DATASCR STACK |
- allocate(ADDREG,DATAREG)
- "move.l sp,%[a]"
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "1:"
- "move.w (sp)+,%[b]"
- "and %[b],(%[a])+"
- "dbf %[1],1b"
- erase(%[1]) | | |
-ior defined($1) && $1 == 2 | ANY DATASCR |
- "or %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,2)+%[1]
-... | DATASCR ANY |
- "or %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,2)+%[2]
-lal loi ior lal sti $1 == $4 && $2 == 1 && $3 == 2 && $5 == 1 && inreg($1) < 2
- | DATAREG |
- remove(MEM_ALL)
- "or.b %[1],$1(a6)" | | |
-loc lol ior stl $2 == $4 && $3 == 2 && inreg($2) < 2 | |
- remove(MEM_ALL)
- "or.w #$1,$2(a6)" | | | (6,10)
-lol ior stl $1 == $3 && $2 == 2 && inreg($1) < 2 | DATAREG |
- remove(MEM_ALL)
- "or.w %[1],$1(a6)" | | |
-loe ior ste $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "or.w %[1],$1" | | |
-lil ior sil $1 == $3 && $2 == 2 | DATAREG |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "or.w %[1],(%[a])" | | |
-loe loc ior ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "or.w #$2,$1" | | | (7,11)
-loc loe ior ste $3 == 2 && $2 == $4 | |
- remove(MEM_ALL)
- "or.w #$1,$2" | | | (7,11)
-loc lil ior sil $2 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$2})
- remove(MEM_ALL)
- "or.w #$1,(%[a])" | | |
-ior defined($1) && $1 == 4 | ANY4-ADDREG DATASCR4 |
- "or.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |(2,3)+%[1]
-... | DATASCR4 ANY4-ADDREG |
- "or.l %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |(2,3)+%[2]
-ldl ldc ior sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "or.l #$2,$1(a6)" | | | (8,16)
-ldc ldl ior sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "or.l #$1,$2(a6)" | | | (8,16)
-lde ldc ior sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "or.l #$2,$1" | | | (9,17)
-ldc lde ior sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "or.l #$1,$2" | | | (9,17)
-ldl ior sdl $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "or.l %[1],$1(a6)" | | |
-lde ior sde $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "or.l %[1],$1" | | |
-ior defined($1) && $1 > 4 | STACK |
- allocate(DATAREG4,ADDREG,DATAREG)
- "move.l #$1/2-1,%[a]"
- "move.l sp,%[b]"
- "add.l #$1,%[b]"
- "1:"
- "move.w (sp)+,%[c]"
- "or %[c],(%[b])+"
- "dbf %[a],1b" | | |
-ior !defined($1) | DATASCR STACK |
- allocate(ADDREG,DATAREG)
- "move.l sp,%[a]"
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "1:"
- "move.w (sp)+,%[b]"
- "or %[b],(%[a])+"
- "dbf %[1],1b"
- erase(%[1]) | | |
-xor defined($1) && $1 == 2 | DATAREG DATASCR |
- "eor %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,2)+%[1]
-... | DATASCR DATAREG |
- "eor %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,2)+%[2]
-lal loi xor lal sti $1 == $4 && $2 == 1 && $3 == 2 && $5 == 1 && inreg($1) < 2
- | DATAREG |
- remove(MEM_ALL)
- "eor.b %[1],$1(a6)" | | |
-lol loc xor stl $1 == $4 && $3 == 2 | |
- remove(MEM_ALL)
- "eor.w #$2,$1(a6)" | | | (6,10)
-loc lol xor stl $2 == $4 && $3 == 2 | |
- remove(MEM_ALL)
- "eor.w #$1,$2(a6)" | | | (6,10)
-loe loc xor ste $3 == 2 && $1 == $4 | |
- remove(MEM_ALL)
- "eor.w #$2,$1" | | | (7,11)
-loc loe xor ste $3 == 2 && $2 == $4 | |
- remove(MEM_ALL)
- "eor.w #$1,$2" | | | (7,11)
-loc lil xor sil $2 == $4 && $3 == 2 | |
- allocate(ADDREG = {DISPL4,LB,$2})
- remove(MEM_ALL)
- "eor.w #$1,(%[a])" | | |
-lol xor stl $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "eor.w %[1],$1(a6)" | | |
-loe xor ste $1 == $3 && $2 == 2 | DATAREG |
- remove(MEM_ALL)
- "eor.w %[1],$1" | | |
-lil xor sil $1 == $3 && $2 == 2 | DATAREG |
- allocate(ADDREG={DISPL4,LB,$1})
- remove(MEM_ALL)
- "eor.w %[1],(%[a])" | | |
-xor defined($1) && $1 == 4 | DATAREG4 DATASCR4 |
- "eor.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,3)+%[1]
-... | DATASCR4 DATAREG4 |
- "eor.l %[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,3)+%[2]
-ldl ldc xor sdl $1 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "eor.l #$2,$1(a6)" | | | (8,16)
-ldc ldl xor sdl $2 == $4 && $3 == 4 | |
- remove(MEM_ALL)
- "eor.l #$1,$2(a6)" | | | (8,16)
-lde ldc xor sde $3 == 4 && $1 == $4 | |
- remove(MEM_ALL)
- "eor.l #$2,$1" | | | (9,17)
-ldc lde xor sde $3 == 4 && $2 == $4 | |
- remove(MEM_ALL)
- "eor.l #$1,$2" | | | (9,17)
-ldl xor sdl $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "eor.l %[1],$1(a6)" | | |
-lde xor sde $1 == $3 && $2 == 4 | DATAREG4 |
- remove(MEM_ALL)
- "eor.l %[1],$1" | | |
-xor defined($1) && $1 > 4 | STACK |
- allocate(DATAREG4,ADDREG,DATAREG)
- "move.l #$1/2-1,%[a]"
- "move.l sp,%[b]"
- "add.l #$1,%[b]"
- "1:"
- "move.w (sp)+,%[c]"
- "eor %[c],(%[b])+"
- "dbf %[a],1b" | | |
-xor !defined($1) | DATASCR STACK |
- allocate(ADDREG,DATAREG)
- "move.l sp,%[a]"
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "1:"
- "move.w (sp)+,%[b]"
- "eor %[b],(%[a])+"
- "dbf %[1],1b"
- erase(%[1]) | | |
-com defined($1) && $1 == 2 | DATASCR | "not %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-com defined($1) && $1 == 4 | DATASCR4 | "not.l %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-com defined($1) && $1 > 4 | STACK | allocate(DATAREG4,ADDREG)
- "move.l #$1/2-1,%[a]"
- "move.l sp,%[b]"
- "1:"
- "not (%[b])+"
- "dbf %[a],1b" | | |
-com !defined($1) | DATASCR STACK | allocate(ADDREG)
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "move.w sp,%[a]"
- "1:"
- "not (%[a])+"
- "dbf %[1],1b" | | |
-rol defined($1) && $1 == 2 | DATAREG DATASCR |
- "rol %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-rol defined($1) && $1 == 4 | DATAREG DATASCR4 |
- "rol.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-ror defined($1) && $1 == 2 | DATAREG DATAREG |
- "ror %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-ror defined($1) && $1 == 4 | DATAREG DATAREG4 |
- "ror.l %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-
-
-/* G R O U P X : S E T S */
-
-inn defined($1) | | remove(ALL)
- move({IMMEDIATE,$1},D0)
- "jsr .inn"
- erase(D0)
- | D0 | |
-inn !defined($1) | ANY | remove(ALL)
- move(%[1],D0)
- "jsr .inn"
- erase(D0)
- | D0 | |
-set defined($1) | | remove(ALL)
- move({IMMEDIATE,$1},D0)
- "jsr .set"
- erase(D0)
- | | |
-set !defined($1) | ANY | remove(ALL)
- move(%[1],D0)
- "jsr .set"
- erase(D0)
- | | |
-
-
-/* G R O U P XI : A R R A Y S */
-
-/* In general, array references are resolved via a subroutine call.
- * Only for two very simple cases we use a more efficient method.
- * The array must be static, i.e. its element size and its index
- * range must be static. In these cases the array descriptor will
- * normally be stored in a rom and an element will be accessed via
- * the sequence "lae lar", in which lae puts the address of the
- * descriptor on the stack. The efficient method is used only if the
- * element size is 2 or 4 bytes. We also make sure that
- * the offset generated fits in 8 bits.
- */
-
-
-lae lar $2 == 2 && rom(1,3) == 2 && rom(1,1) >= (0-63) && rom(1,1) <= 63
- | DATASCR ADDREG |
- "asl #1,%[1]"
- erase(%[1])
- setcc(%[1]) |
- {INDEXED,%[2],%[1],
- (0-2)*rom(1,1)} | |
-lae lar $2 == 2 && rom(1,3) == 4 && rom(1,1) >= (0-31) && rom(1,1) <= 31
- | DATASCR ADDREG |
- "asl #2,%[1]"
- erase(%[1])
- setcc(%[1]) |
- {INDEXED4,%[2],%[1],
- (0-4)*rom(1,1)} | |
-lar $1 == 2 | | remove(ALL)
- "jsr .lar"
- | | |
-lae sar $2 == 2 && rom(1,3) == 2 && rom(1,1) >= (0-63) && rom(1,1) <= 63
- | DATASCR ADDREG ANY |
- remove(MEM_ALL)
- "asl #1,%[1]"
- move(%[3],{INDEXED,%[2],%[1],
- (0-2)*rom(1,1)} )
- erase(%[1]) | | |
-lae sar $2 == 2 && rom(1,3) == 4 && rom(1,1) >= (0-31) && rom(1,1) <= 31
- | DATASCR ADDREG ANY4 |
- remove(MEM_ALL)
- "asl #2,%[1]"
- move(%[3],{INDEXED4,%[2],%[1],
- (0-4)*rom(1,1)})
- erase(%[1]) | | |
-sar $1 == 2 | | remove(ALL)
- "jsr .sar"
- | | |
-lae aar $2 == 2 && rom(1,3) == 2 && rom(1,1) >= (0-63) && rom(1,1) <= 63
- | DATASCR ADDREG |
- "asl #1,%[1]"
- erase(%[1])
- setcc(%[1]) |
- {INDEX_ADDR,%[2],%[1],
- (0-2)*rom(1,1)} | |
-lae aar $2 == 2 && rom(1,3) == 4 && rom(1,1) >= (0-31) && rom(1,1) <= 31
- | DATASCR ADDREG |
- "asl #2,%[1]"
- erase(%[1])
- setcc(%[1]) |
- {INDEX_ADDR,%[2],%[1],
- (0-4)*rom(1,1)} | |
-| INDEX_ADDR | allocate(ADDREG)
- "lea %[1.di](%[1.reg],%[1.ireg].w),%[a]"
- samecc | %[a] | |
-aar $1 == 2 | | remove(ALL)
- "jsr .aar"
- | | |
-lar !defined($1) | |
- remove(ALL)
- "jsr .lari"
- | | |
-sar !defined($1) | |
- remove(ALL)
- "jsr .sari"
- | | |
-aar !defined($1) | |
- remove(ALL)
- "jsr .aari"
- | | |
-
-
-/* G R O U P XII : C O M P A R E */
-
-cmi $1 == 2 | ANY DATASCR | "sub.w %[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-cmi $1 == 4 | | remove(ALL)
- "jsr .cmi"
- | D1 | |
-cmu $1 == 4 | | | | cmp |
-cmu defined($1) | | remove(ALL)
- "move.w #$1,d0"
- "jsr .cmu"
- | D1 | |
-cmu !defined($1) | ANY | remove(ALL)
- move(%[1],D0)
- erase(D0)
- "jsr .cmu"
- | D1 | |
-cms $1 == 2 | ANY DATASCR | "sub.w %[1],%[2]"
- setcc(%[2])
- erase(%[2]) | %[2] | |
-... | DATASCR ANY | "sub.w %[2],%[1]"
- setcc(%[1])
- erase(%[1]) | %[1] | |
-cms $1==4 | | | | cmi $1 |
-cms defined($1) | | remove(ALL)
- "move.w #$1,d0"
- "jsr .cms"
- | | |
-cms !defined($1) | ANY | remove(ALL)
- move(%[1],D0)
- "jsr .cms"
- erase(D0)
- | | |
-cmp | | remove(ALL)
- "jsr .cmp"
- | D1 | |
-
-cmi tlt and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "blt 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bge 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tle and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "ble 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tle ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bgt 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi teq and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "beq 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi teq ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bne 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tne and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bne 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tne ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "beq 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tge and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bge 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tge ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "blt 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tgt and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bgt 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "ble 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-
-cmu tlt and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bcs 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tlt ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bcc 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tle and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bls 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tle ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bhi 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu teq and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "beq 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu teq ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bne 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tne and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bne 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tne ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "beq 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tge and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bcc 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tge ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bcs 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tgt and $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bhi 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu tgt ior $1==2 && $3==2 | ANY DATAREG DATASCR |
- "cmp %[1],%[2]"
- "bls 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmu zlt $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "bcs $2" | | |
-cmu zle $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "bls $2" | | |
-cmu zeq $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "beq $2" | | |
-cmu zne $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "bne $2" | | |
-cmu zge $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "bcc $2" | | |
-cmu zgt $1==2 | ANY DATAREG STACK |
- "cmp.w %[1],%[2]"
- "bhi $2" | | |
-
-cmi tlt and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "blt 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bge 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tle and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "ble 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tle ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bgt 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi teq and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "beq 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi teq ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bne 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tne and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bne 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tne ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "beq 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tge and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bge 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tge ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "blt 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tgt and $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "bgt 1f"
- "clr %[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==4 && $3==2 | ANY4 DATAREG4 DATASCR |
- "cmp.l %[1],%[2]"
- "ble 1f"
- "bset #0,%[3]"
- "1:"
- erase(%[3]) | %[3] | |
-cmi tlt $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "blt 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi tle $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "ble 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi teq $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "beq 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi tne $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bne 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi tge $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bge 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi tgt $1==4 | ANY4 DATAREG4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bgt 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-
-ldc cmi tlt and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "blt 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tlt ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bge 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tle and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "ble 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tle ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bgt 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi teq and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "beq 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi teq ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bne 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tne and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bne 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tne ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "beq 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tge and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bge 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tge ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "blt 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tgt and loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "bgt 1f"
- "clr %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tgt ior loww(1)==0&&highw(1)==0 && $2==4 && $4==2 | DATA_ALT4 DATASCR |
- "tst.l %[1]"
- "ble 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-ldc cmi tlt loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "blt 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-ldc cmi tle loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "ble 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-ldc cmi teq loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "beq 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-ldc cmi tne loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "bne 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-ldc cmi tge loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "bge 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-ldc cmi tgt loww(1)==0&&highw(1)==0 | DATA_ALT4 | allocate(DATAREG={IMMEDIATE,1})
- "tst.l %[1]"
- "bgt 1f"
- "clr %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmi zlt $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "blt $2" | | |
-cmi zle $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "ble $2" | | |
-cmi zeq $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "beq $2" | | |
-cmi zne $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "bne $2" | | |
-cmi zge $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "bge $2" | | |
-cmi zgt $1==4 | ANY4 REG4 STACK |
- "cmp.l %[1],%[2]"
- "bgt $2" | | |
-ldc cmi zlt loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "blt $3" | | |
-ldc cmi zle loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "ble $3" | | |
-ldc cmi zeq loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "beq $3" | | |
-ldc cmi zne loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "bne $3" | | |
-ldc cmi zge loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "bge $3" | | |
-ldc cmi zgt loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "bgt $3" | | |
-
-
-ldc cms zeq loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "beq $3" | | |
-ldc cms zne loww(1)==0&&highw(1)==0 && $2==4 | DATA_ALT4 STACK |
- test(%[1])
- "bne $3" | | |
-
-cmp tlt | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bcs 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bcs 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmp tle | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bls 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bls 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmp teq | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "beq 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "beq 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmp bne | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bne 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bne 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmp tge | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bcc 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bcc 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-cmp tgt | ANY4 ADDREG | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bhi 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | allocate(DATAREG={IMMEDIATE,1})
- "cmp.l %[1],%[2]"
- "bhi 1f"
- "clr.w %[a]"
- "1:"
- erase(%[a]) | %[a] | |
-
-cmp zlt | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "bcs $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "bcs $2" | | |
-cmp zle | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "bls $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "bls $2" | | |
-cmp zeq | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "beq $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "beq $2" | | |
-cmp zne | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "bne $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "bne $2" | | |
-cmp zge | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "bcc $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "bcc $2" | | |
-cmp zgt | ANY4 ADDREG | remove(ALL)
- "cmp.l %[1],%[2]"
- "bhi $2" | | |
-... | nocoercions: EXTERNAL_ADDR ANY4 | remove(ALL)
- "cmp.l %[1],%[2]"
- "bhi $2" | | |
-tlt and $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "blt 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tlt ior $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "bge 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tlt | DATA_ALT | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "blt 1f"
- "clr %[a]"
- "1:" | %[a] | |
-tle and $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "ble 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tle ior $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "bgt 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tle | DATA_ALT | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "ble 1f"
- "clr %[a]"
- "1:" | %[a] | |
-teq and $2==2 | DATA_ALT_1OR2 DATASCR |
- test(%[1])
- "beq 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-teq ior $2==2 | DATA_ALT_1OR2 DATASCR |
- test(%[1])
- "bne 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-teq | DATA_ALT_1OR2 | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "beq 1f"
- "clr %[a]"
- "1:" | %[a] | |
-tne and $2==2 | DATA_ALT_1OR2 DATASCR |
- test(%[1])
- "bne 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tne ior $2==2 | DATA_ALT_1OR2 DATASCR |
- test(%[1])
- "beq 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tne | DATA_ALT_1OR2 | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "bne 1f"
- "clr %[a]"
- "1:" | %[a] | |
-tge and $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "bge 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tge ior $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "blt 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tge | DATA_ALT | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "bge 1f"
- "clr %[a]"
- "1:" | %[a] | |
-tgt and $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "bgt 1f"
- "clr.w %[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tgt ior $2==2 | DATA_ALT DATASCR |
- test(%[1])
- "ble 1f"
- "bset #0,%[2]"
- "1:"
- erase(%[2]) | %[2] | |
-tgt | DATA_ALT | allocate(DATAREG={IMMEDIATE,1})
- test(%[1])
- "bgt 1f"
- "clr %[a]"
- "1:" | %[a] | |
-
-
-/* G R O U P XIII : B R A N C H */
-
-bra | STACK | "bra $1" | | |
-/* byte comparisons */
-loc beq $1 >= 0 && $1 < 256 | nocoercions: DATA_ALT1 |
- remove(ALL)
- "cmp.b #$1,%[1]"
- "beq $2" | | |
-... | DATA_ALT STACK |
- "cmp #$1,%[1]"
- "beq $2" | | |
-loc bne $1 >= 0 && $1 < 256 | nocoercions: DATA_ALT1 |
- remove(ALL)
- "cmp.b #$1,%[1]"
- "bne $2" | | |
-... | DATA_ALT STACK |
- "cmp #$1,%[1]"
- "bne $2" | | |
-blt | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "blt $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "blt $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "bgt $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "bgt $1" | | |
-ble | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "ble $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "ble $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "bge $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "bge $1" | | |
-beq | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "beq $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "beq $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "beq $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "beq $1" | | |
-bne | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "bne $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "bne $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "bne $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "bne $1" | | |
-bge | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "bge $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "bge $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "ble $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "ble $1" | | |
-bgt | IMMEDIATE DATA_ALT STACK | "cmp %[1],%[2]"
- "bgt $1" | | |
-... | ANY DATAREG STACK | "cmp %[1],%[2]"
- "bgt $1" | | |
-... | DATAREG ANY STACK | "cmp %[2],%[1]"
- "blt $1" | | |
-... | DATA_ALT IMMEDIATE STACK | "cmp %[2],%[1]"
- "blt $1" | | |
-zlt | DATA_ALT | remove(ALL)
- test(%[1])
- "blt $1" | | |
-zle | DATA_ALT | remove(ALL)
- test(%[1])
- "ble $1" | | |
-zeq | DATA_ALT_1OR2 | remove(ALL)
- test(%[1])
- "beq $1" | | |
-zne | DATA_ALT_1OR2 | remove(ALL)
- test(%[1])
- "bne $1" | | |
-zge | DATA_ALT | remove(ALL)
- test(%[1])
- "bge $1" | | |
-zgt | DATA_ALT | remove(ALL)
- test(%[1])
- "bgt $1" | | |
-
-/* G R O U P : XIV P R O C E D U R E C A L L S */
-
-cai | ADDREG | remove(ALL)
- "jsr (%[1])"
- | | |
-cal | | remove(ALL)
- "jsr $1"
- | | |
-lfr $1 == 2 | | | D0 | |
-lfr $1 == 4 | | | DD0 | |
-lfr $1 == 8 | | | DD1 DD0 | |
-
-ret $1 == 0 | STACK |
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-ret $1 == 2 | ANY STACK |
- move(%[1],D0)
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-... | STACK |
- "move.w (sp)+,d0"
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-ret $1 == 4 | ANY4 STACK |
- move(%[1],DD0)
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-... | STACK |
- "move.l (sp)+,d0"
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-ret $1 == 8 | ANY4 ANY4 STACK |
- move(%[1],DD0)
- move(%[2],DD1)
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-... | STACK |
- "move.l (sp)+,d0"
- "move.l (sp)+,d1"
-#ifdef REGVARS
- return | | |
-#else
- "unlk a6"
- "rts" | | |
-#endif
-
-/* G R O U P XV : M I S C E L L A N E O U S */
-
-asp $1 >= 1 && $1 <= 8 | STACK | "add.l #$1,sp" | | |
-asp | STACK | "lea $1(sp),sp" | | |
-
-ass $1 == 2 | DATAREG STACK | "add.l %[1],sp" | | |
-blm $1 == 2 | ADDREG ADDREG | remove(MEM_ALL)
- move({IADDREG,%[2]}, {IADDREG,%[1]}) | | |
-blm $1 == 4 | ADDREG ADDREG | remove(MEM_ALL)
- move({IADDREG4,%[2]}, {IADDREG4,%[1]}) | | |
-blm $1 == 6 | ADDSCR ADDSCR | remove(MEM_ALL)
- "move.w (%[2])+,(%[1])+"
- "move.l (%[2]),(%[1])"
- erase(%[1])
- erase(%[2]) | | |
-blm $1 == 8 | ADDSCR ADDSCR | remove(MEM_ALL)
- "move.l (%[2])+,(%[1])+"
- "move.l (%[2]),(%[1])"
- erase(%[1])
- erase(%[2]) | | |
-blm $1 == 10 | ADDSCR ADDSCR | remove(MEM_ALL)
- "move.w (%[2])+,(%[1])+"
- "move.l (%[2])+,(%[1])+"
- "move.l (%[2]),(%[1])"
- erase(%[1])
- erase(%[2]) | | |
-blm $1 == 12 | ADDSCR ADDSCR | remove(MEM_ALL)
- "move.l (%[2])+,(%[1])+"
- "move.l (%[2])+,(%[1])+"
- "move.l (%[2]),(%[1])"
- erase(%[1])
- erase(%[2]) | | |
-blm $1 > 12 | ADDSCR ADDSCR | remove(MEM_ALL)
- allocate(DATAREG4={IMMEDIATE4,$1/2-1})
- "1:"
- "move.w (%[2])+,(%[1])+"
- "dbf %[a],1b"
- erase(%[a])
- erase(%[1])
- erase(%[2]) | | |
-/* Wait for restriction nregneeded<2 to be removed
-bls $1 == 2 | DATASCR ADDSCR ADDSCR |
- remove(MEM_ALL)
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "beq 2f"
- "1:"
- "move.w (%[3])+,(%[2])+"
- "dbf %[1],1b"
- "2:"
- erase(%[1])
- erase(%[2])
- erase(%[3]) | | |
-*/
-bls $1 == 2 | STACK |
- allocate(ADDREG,ADDREG,DATAREG)
- "move.w (sp)+,%[c]"
- "move.l (sp)+,%[b]"
- "move.l (sp)+,%[a]"
- "sub.w #1,%[c]"
- "asr #1,%[c]"
- "beq 2f"
- "1:"
- "move.w (%[a])+,(%[b])+"
- "dbf %[c],1b"
- "2:" | | |
-
-/* For csa and csb we just jump to a piece of code that computes
- * the jump-address and jumps to this address
- */
-
-csa $1 == 2 | | remove(ALL)
- "jmp .csa"
- | | |
-csb $1 == 2 | | remove(ALL)
- "jmp .csb"
- | | |
-dch | | | | loi 4 |
-dup $1 == 2 | ANY | | %[1] %[1] | |
-dup $1 == 4 | ANY4 | | %[1] %[1] | |
- ... | ANY ANY | | %[2] %[1] %[2] %[1] | |
-dup $1 > 4 | STACK | allocate(ADDREG,DATAREG4)
- "move.l sp,%[a]"
- "add.l #$1,%[a]"
- "move.l #$1/2-1,%[b]"
- "1:"
- "move.w -(%[a]),-(sp)"
- "dbf %[b],1b" | | |
-dus $1 == 2 | DATASCR | remove(ALL)
- allocate(ADDREG)
- "move.l sp,%[a]"
- "add.l %[1],%[a]"
- "sub.w #1,%[1]"
- "asr #1,%[1]"
- "1:"
- "move.w -(%[a]),-(sp)"
- "dbf %[1],1b" | | |
-exg | STACK | "move.w #$1,d0"
- "jsr .exg" | | |
-fil | | "move.l #$1,.filn" | | |
-gto | STACK | allocate(ADDREG)
- "lea $1,%[a]"
- "move.l 4(%[a]),sp"
- "move.l 8(%[a]),a6"
- "move.l (%[a]),%[a]"
- "jmp (%[a])" | | |
-lin | | "move.w #$1,.lino" | | |
-lni | | "add.w #1,.lino" | | |
-mon | STACK | "jsr .mon" | | |
-nop | STACK | "jsr .nop" | | |
-lim | | | {ABS4,".trpim"} | |
-lor $1 == 0 | | | LB | |
-lor $1 == 1 | STACK | "move.l sp,-(sp)" | | |
-lor $1 == 2 | | | {ABS4,".reghp"} | |
-lpb | | | | adp 8 |
-rck $1 == 2 | | remove(ALL)
- "jsr .rck"
- | | |
-rtt | | | | ret 0 |
-sig | STACK | "jsr .sig" | | |
-sim | | remove(ALL)
- "move.w (sp)+,.trpim" | | |
-str $1 == 0 | ANY4 STACK | "move.l %[1],a6" | | |
-str $1 == 1 | STACK | "move.l (sp)+,sp" | | |
-str $1 == 2 | | remove(ALL)
- "jsr .strhp"
- | | |
-trp | STACK | "jsr .trp" | | |
-
-
-/* For several floating point instructions we generate an illegal
- * instruction trap.
- */
-
-adf | | | | loc 18 trp |
-sbf | | | | loc 18 trp |
-mlf | | | | loc 18 trp |
-dvf | | | | loc 18 trp |
-ngf | | | | loc 18 trp |
-fef | | | | loc 18 trp |
-fif | | | | loc 18 trp |
-zrf | | | | loc 18 trp |
-cfi | | | | loc 18 trp |
-cif | | | | loc 18 trp |
-cuf | | | | loc 18 trp |
-cff | | | | loc 18 trp |
-cfu | | | | loc 18 trp |
-cmf | | | | loc 18 trp |
-
-
-
-/* C O E R C I O N S */
-
-
-/* from stack */
-
-| STACK | allocate(DATAREG)
- "move.w (sp)+,%[a]"
- setcc(%[a]) | %[a] | | (2,4)
-| STACK | allocate(DATAREG4)
- "move.l (sp)+,%[a]"
- setcc(%[a]) | %[a] | | (2,6)
-| STACK | allocate(ADDREG)
- "move.l (sp)+,%[a]"
- setcc(%[a]) | %[a] | | (2,6)
-
-
-/* to a register, for efficiency */
-
-| ANY | allocate(%[1],DATAREG=%[1]) | %[a] | | (2,2)
-
-| ANY4 | allocate(%[1],DATAREG4=%[1]) | %[a] | | (2,2)
-| ANY4 | allocate(%[1],ADDREG=%[1]) | %[a] | | (2,2)
-
-/* from double to 2 singles */
-
-| DOUBLEZERO | | {IMMEDIATE,0} {IMMEDIATE,0} | |
-| DISPL4 | | {DISPL,%[1.reg],%[1.dis]+2} {DISPL,%[1.reg],%[1.dis]} | |
-/* impossible to add string and integer:
-| ABS4 | | {ABS,%[1.addr]} {ABS,[%1.addr]+2} | |
-*/
-/*
-| INDEXED4 | | {INDEXED,%[1.reg],%[1.ireg],%[1.di]}
- {INDEXED,%[1.reg],%[1.ireg],%[1.di]+2} | |
-*/
-
-/* from 1 to 2 bytes */
-
-| ANY1 | allocate(DATAREG = {IMMEDIATE,0})
- "move.b %[1],%[a]"
- erase(%[a]) | %[a] | |
-
-
-MOVES:
-(IMMEDIATE %[cc] == 0, DATA_ALT, "clr.w %[2]" setcc(%[2]),(2,3)+%[2] )
-(IMMEDIATE (%[cc] >= 0-128 && %[cc] <= 127), DATAREG,
- "move.l %[1],%[2]" setcc(%[2]),(2,2))
-(ANY, DATA_ALT, "move.w %[1], %[2]"setcc(%[2]),(2,2)+%[1]+%[2])
-(IMMEDIATE %[cc] == 0, ANY1, "clr.b %[2]" setcc(%[2]),(2,3)+%[2] )
-(ANY+ANY1, ANY1, "move.b %[1], %[2]"setcc(%[2]),(2,2)+%[1]+%[2])
-(IMMEDIATE4 %[cc] == 0, DATA_ALT4, "clr.l %[2]"setcc(%[2]),(2,5)+%[2])
-(DOUBLEZERO, DATA_ALT4, "clr.l %[2]"setcc(%[2]),(2,5)+%[2])
-(DOUBLE %[cc] == "0", DATA_ALT4, "clr.l %[2]"setcc(%[2]),(2,5)+%[2])
-(IMMEDIATE4 (%[cc] >= 0-128 && %[cc] <= 127),DATAREG4,
- "move.l %[1],%[2]" setcc(%[2]),(2,2))
-(IMMEDIATE4, ADDREG, "lea %[1.cc],%[2]" nocc, (4,4))
-(EXTERNAL_ADDR, ADDREG, "lea %[1.off],%[2]" nocc, (5,5))
-(ANY4, DATA_ALT4, "move.l %[1], %[2]"setcc(%[2]),(2,2)+%[1]+%[2])
-(ANY, ADDREG, "move.w %[1], %[2]"samecc,(2,2)+%[1])
-(ANY4,ADDREG, "move.l %[1], %[2]"samecc,(2,2)+%[1])
-
-TESTS:
-(DATA_ALT, "tst %[1]",(2,2)+%[1])
-(DATA_ALT4,"tst.l %[1]",(2,2)+%[1])
-(ANY1,"tst.b %[1]",(2,2)+%[1])
-
-STACKS:
-(IMMEDIATE %[cc] == 0, , "clr.w -(sp)" setcc(%[1]))
-(ANY, , "move.w %[1],-(sp)" setcc(%[1]), (2,4) + %[1])
-(EXTERNAL_ADDR, , "pea %[1.off]" nocc)
-(LOCAL_ADDR, , "pea %[1.off](a6)" nocc)
-(REGOFF_ADDR, , "pea %[1.off](%[1.reg])" nocc)
-(INDEX_ADDR, , "pea %[1.di](%[1.reg],%[1.ireg].w)" nocc)
-(IMMEDIATE4 %[cc] == 0, , "clr.l -(sp)")
-(IMMEDIATE4, , "pea %[1.cc]" nocc)
-(DOUBLEZERO, , "clr.l -(sp)", (2,4))
-(ANY4, , "move.l %[1],-(sp)" setcc(%[1]), (2,6) + %[1])
-(ANY1, , "clr.w -(sp)" "move.b %[1],1(sp)")
+++ /dev/null
-CFLAGS=-O
-
-cv: cv.o
- $(CC) -o cv -n cv.o
-
-pmcv: pmcv.o
- $(CC) -o pmcv -n pmcv.o
-
-install: ins_cv ins_pmcv
-ins_cv: cv
- ../../install cv
-ins_pmcv: pmcv
- ../../install pmcv
-
-cmp: cmp_cv cmp_pmcv
-cmp_cv: cv
- -../../compare cv
-cmp_pmcv: pmcv
- -../../compare pmcv
-
-opr:
- make pr | opr
-
-pr:
- @pr `pwd`/cv.c `pwd`/pmcv.c
-
-clean:
- -rm -f *.o *.old cv pmcv
+++ /dev/null
-static char rcsid[] = "$Header$";
-/*
- * (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 <a.out.h>
-
-/*
- * NOTE: Beware that the a.out.h file included here should be the a.out.h
- * file of the TARGET machine, not of the SOURCE machine.
- */
-
-struct bhdr s_exec;
-
-main(argc,argv) char **argv; {
- unsigned short losh,hish;
- long addr,maxaddr;
- short count;
-
- maxaddr=0;
- if (argc != 3) {
- fprintf(stderr,"Usage: %s VU-a.out Bleasdale-a.out\n",argv[0]);
- exit(-1);
- }
- if (freopen(argv[1],"r",stdin)==NULL) {
- perror(argv[1]);
- exit(-1);
- }
- if (freopen(argv[2],"w",stdout)==NULL) {
- perror(argv[2]);
- exit(-1);
- }
- while (fread(&hish,sizeof(short),1,stdin)==1) {
- if (fread(&losh,sizeof(short),1,stdin)!=1)
- exit(fprintf(stderr,"foo\n"));
- addr=losh+(((long)hish)*65536L);
- addr -= 0x20000; /* entry point is 0x20000 on Bleasdale */
- if (fread(&count,sizeof(short),1,stdin)!=1)
- exit(fprintf(stderr,"bar\n"));
- fseek(stdout,addr+sizeof(s_exec),0);
- while (count--) {
- putchar(getchar());
- addr++;
- }
- if (addr>maxaddr)
- maxaddr = addr;
- }
- s_exec.fmagic = FMAGIC;
- s_exec.dsize = maxaddr;
- s_exec.entry = 0x20000;
- fseek(stdout,0L,0);
- fwrite(&s_exec,sizeof(s_exec),1,stdout);
- chmod(argv[2],0755);
- return 0;
-}
-
-
+++ /dev/null
-static char rcsid[] = "$Header$";
-#define MAXBYTE 24
-#include <stdio.h>
-char hex[] = "0123456789ABCDEF";
-FILE *fp, *fopen();
-char **s;
-int bytes, bytcnt, checksum;
-long pc;
-
-
-main (argc,argv)
-int argc;
-char *argv[];
- {
- if (argc != 2) fatal ("usage: %s filename\n",argv[0]);
- if ((fp = fopen (*++argv,"r")) == NULL)
- fatal ("can't open %s\n",*argv);
- else {
- s = argv;
- convert ();
- fclose (fp);
- }
- }
-
-convert ()
- {
- int c;
- do
- {
- pc = getword ();
- pc = (pc << 16) | getword ();
- bytes = getword ();
- while (bytes != 0)
- {
- bytcnt = (bytes < MAXBYTE) ? bytes : MAXBYTE;
- bytes -= bytcnt;
- checksum = 0;
- if (pc > 0xffffL) S2record (); else S1record ();
- }
- c = getc (fp);
- ungetc (c, fp);
- }
- while (c != EOF);
- printf ("S9030000FC\n");
- }
-
-
-S2record ()
- {
- printf ("S2");
- bytcnt += 4;
- outbyte (bytcnt);
- outbyte (pc);
- record ();
- }
-
-S1record ()
- {
- printf ("S1");
- bytcnt += 3;
- outbyte (bytcnt);
- record ();
- }
-
-record ()
- {
- outbyte (pc << 8);
- outbyte (pc << 16);
- while (bytcnt != 0)
- {
- outbyte (getbyte ());
- pc ++;
- }
- outbyte (~checksum);
- putchar ('\n');
- putchar (0);
- putchar (0);
- }
-
-outbyte (b)
-int b;
- {
- checksum = (checksum + b) & 0377;
- putchar (hex[(b>>4) & 017]);
- putchar (hex[b & 017]);
- -- bytcnt;
- }
-
-getword ()
- {
- int c;
- c = getbyte ();
- return ((getbyte () << 8) | c );
- }
-
-getbyte ()
- {
- int c;
- if ((c = getc (fp)) == EOF) fatal ("end of %s\n",*s);
- return (c);
- }
-fatal (s,a)
- {
- printf (s,a);
- exit (-1);
- }
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=m68k2" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-install:
- ln head_em.s head_em ; ../../install head_em ; rm head_em
- ln libem_s.a tail_em.rt ; ../../install tail_em.rt ; rm tail_em.rt
- ln libem_s.vend.a tail_em.vend ; ../../install tail_em.vend ;\
- rm tail_em.vend
-
-clean :
-
-opr :
- make pr | opr
-
-pr:
- @ar pv libem_s.a
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=m68k2" "SUF=s"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-install:
- ln tail_mon.a tail_mon ; ../../install tail_mon ; rm tail_mon
-
-clean :
-
-opr :
- make pr | opr
-
-pr:
- @ar pv tail_mon.a
+++ /dev/null
-install:
- ln tail_mon.a tail_mon ; ../../install tail_mon ; rm tail_mon
-
-clean :
-
-opr :
- make pr | opr
-
-pr:
- @ar pv tail_mon.a
+++ /dev/null
-P = mloop
-em2tl: a.out
- cv a.out em2tl
- rm a.out
-a.out: $P02tl.s $P12tl.s $P22tl.s $P32tl.s $P42tl.s $P52tl.s $P62tl.s $P72tl.s $P82tl.s $P92tl.s $Pa2tl.s $Pb2tl.s $Pc2tl.s $Pe2tl.s
- m68k2 -s $P?2tl.s >symem2tl
-$P02tl.s: $P0
- prep $P0 $P02tl.s
-$P12tl.s: $P1
- prep $P1 $P12tl.s
-$P22tl.s: $P2
- prep $P2 $P22tl.s
-$P32tl.s: $P3
- prep $P3 $P32tl.s
-$P42tl.s: $P4
- prep $P4 $P42tl.s
-$P52tl.s: $P5
- prep $P5 $P52tl.s
-$P62tl.s: $P6
- prep $P6 $P62tl.s
-$P72tl.s: $P7
- prep $P7 $P72tl.s
-$P82tl.s: $P8
- prep $P8 $P82tl.s
-$P92tl.s: $P9
- prep $P9 $P92tl.s
-$Pa2tl.s: $Pa
- prep $Pa $Pa2tl.s
-$Pb2tl.s: $Pb
- prep $Pb $Pb2tl.s
-$Pc2tl.s: $Pc
- prep $Pc $Pc2tl.s
-$Pe2tl.s: $Pe
- prep $Pe $Pe2tl.s
+++ /dev/null
-! (c) copyright 1980 by the Vrije Universiteit, Amsterdam, The Netherlands.
-! Explicit permission is hereby granted to universities to use or duplicate
-! this program for educational or research purposes. All other use or dup-
-! lication by universities, and all use or duplication by other organiza-
-! tions is expressly prohibited unless written permission has been obtained
-! from the Vrije Universiteit. Requests for such permissions may be sent to
-
-! Dr. Andrew S. Tanenbaum
-! Wiskundig Seminarium
-! Vrije Universiteit
-! Postbox 7161
-! 1007 MC Amsterdam
-! The Netherlands
-
-! Organizations wishing to modify part of this software for subsequent sale
-! must explicitly apply for permission. The exact arrangements will be
-! worked out on a case by case basis, but at a minimum will require the or-
-! ganization to include the following notice in all software and documenta-
-! tion based on our work:
-
-! This product is based on the Pascal system developed by
-! Andrew S. Tanenbaum, Johan W. Stevenson and Hans van Staveren
-! of the Vrije Universiteit, Amsterdam, The Netherlands.
-!
-!=========================================================================
-
-! This is an interpreter for EM programs with no virtual memory for the
-! the PMDS-II . This interpreter is adapted from an interpreter which was
-! made for the pdp11 by Evert Wattel and Hans van Staveren . The present
-! version is made by Freek van Schagen
-! Vrije Universiteit
-! Amsterdam.
-
-
-!-------------------------------------------------------------------------
-
-! The program requires preprocessing by the C-preprocessor . There are
-! several options :
-! lword: 4byte word size in stead of 2 byte word size ;
-! test: checking for undefined variables , nil pointers
-! array indices , overflow , etc ;
-! last: generation of a file with the last 16 lines executed ;
-! count: generation of a file with a flow count ;
-! flow: generation of a file with a flow bitmap ;
-! prof: generation of a file with a runtime profile ;
-! opfreq: generation of a file with a frequency count per opcode.
-
-!--------------------------------------------------------------------------
-
-! Memory layout:
-
-! --------------------------------------------------------------------------
-! | | | | | | | | | |
-! | 1 | 2 | 3 | 4 | 5 | 6 | | 7 | 8 |
-! | | | | | | | | | |
-! --------------------------------------------------------------------------
-
-! 1: Interpreter text+data+bss.
-! 2: EM text.
-! 3: EM procedure descriptors.
-! 4: EM global data area.
-! 5: tables for flow , count , profile.
-! 6: EM heap area.
-! 7: EM local data and stack.
-! 8: Arguments to the interpreter .
-
-
-!REGISTER USE
-! pc programcounter
-! a7=sp stackpointer d7 if lword: 1 , if not lword: 0
-! a6 external base= eb d6 0
-! a5 scratch d5 scratch
-! a4 address of loop d4 scratch
-! a3 EM programcounter d3 scratch
-! a2 local base =lb d2 scratch
-! a1 address of return area d1 scratch
-! a0 scratch d0 opcode byte and scratch
+++ /dev/null
-#ifdef lword
-#define word 4
-#define wrd #4
-#define wmu #2
-#define und #-0x80000000
-#define ad add.l
-#define an and.l
-#define asle asl.l
-#define asri asr.l
-#define cl clr.l
-#define comp cmp.l
-#define exor eor.l
-#define extend !
-#define inor or.l
-#define lsle lsl.l
-#define lsri lsr.l
-#define nega neg.l
-#define mov move.l
-#define nt not.l
-#define rotl rol.l
-#define rotr ror.l
-#define subt sub.l
-#define testen tst.l
-#define l0 16
-#define l1 20
-#define l2 24
-#define l3 28
-#define l_1 -4
-#define l_2 -8
-#define l_3 -12
-#define l_4 -16
-#define l_5 -20
-#define l_6 -24
-#define l_7 -28
-#define l_8 -32
-#define checksize cmp.l #4,d0 ; beq 4f ; cmp.l #8,d0 ; bne 9f ; bsr no8bar ; \
-9: bra e_oddz
-#else
-#define word 2
-#define wrd #2
-#define wmu #1
-#define und #-0x8000
-#define ad add.w
-#define an and.w
-#define asle asl.w
-#define asri asr.w
-#define cl clr.w
-#define comp cmp.w
-#define exor eor.w
-#define extend ext.l
-#define inor or.w
-#define lsle lsl.w
-#define lsri lsr.w
-#define nega neg.w
-#define mov move.w
-#define nt not.w
-#define rotl rol.w
-#define rotr ror.w
-#define subt sub.w
-#define testen tst.w
-#define l0 16
-#define l1 18
-#define l2 20
-#define l3 22
-#define l_1 -2
-#define l_2 -4
-#define l_3 -6
-#define l_4 -8
-#define l_5 -10
-#define l_6 -12
-#define l_7 -14
-#define l_8 -16
-#define checksize cmp.w #2,d0 ; beq 2f ; cmp.w #4,d0 ; beq 4f ; bra e_oddz
-#endif
-#define adroff move.b (a3)+,(a1) ; move.b (a3)+,1(a1)
-#define claimstack tst.b -1024(sp)
-
-
+++ /dev/null
-!definitions
-!#define lword
-!#define FLTRAP
-#define opfreq 0
-#define last 1
-#define test 1
-#define count 0
-#define flow 0
+++ /dev/null
-!---------------------------------------------------------------------------
-! START OF THE PROGRAM
-!---------------------------------------------------------------------------
-
- lea retarea,a1 !a1 POINTS AT RETURN AREA
- move.l nd,-(sp) !nd contains endbss
- bsr _break
- add.l wrd,sp
-#if last
- move.l #30,d0 !initialise lasttable
- lea lasttable,a5
-0: clr.l (a5)+
- dbra d0,0b
- move.l #-1,(a5)
- move.l #linused-8,linused
-#endif
- move.l 4(sp),a2
- move.l (a2),filb !interpreter name in filb
- sub.l #1,(sp)
- bgt 0f
- .data
-emfile: .asciz "e.out"
- .align 2
- .text
- move.l 4(sp),a0 !4(sp) is argv
- move.l #emfile,(a0) !pointer to e.out in argp1
- add.l #1,(sp) !only 1 argument in this case
- bra 1f
-0: add.l #4,4(sp) !skip name of interpreter
-1: add.l #4-word,sp
- move.l sp,ml
- move.l word(sp),a2
- cl -(sp)
- move.l (a2),-(sp)
- lea eb,a6
- bsr _open
- testen (sp)+
- bne nofile
- mov (sp)+,savefd
- move.l (a2),filb !load file name in filb
- !information about file for error mess.
- move.l #16,-(sp) ; pea header
- mov savefd,-(sp) !skip first header
- bsr _read ; testen (sp)+
- bne badarg1
- move.l #32,(sp)
- pea header
- mov savefd,-(sp)
- bsr _read
- testen (sp)+
- bne badarg1
- cmp.l #32,(sp)+
- bne badarg1
- lea header,a0
- move.l #5,d0 !convert em integer to integer
-0: add.l #4,a1
- move.b (a0)+,-(a1) ; move.b (a0)+,-(a1)
- move.b (a0)+,-(a1) ; move.b (a0)+,-(a1)
- move.l (a1),-4(a0) ; dbra d0,0b
- move.l nd,a0 ; move.l a0,pb !Bottom emtext
- add.l ntext,a0 ; move.l a0,pd !proc. descr. base
- move.l nproc,d1 ; asl.l #3,d1 !2 pointers
-#if count + prof + flow
- mulu #3,d1 !or 6 pointers
-#endif
- add.l d1,a0 ; move.l a0,eb !external base
- add.l szdata,a0 ; move.l a0,tblmax
- move.l a0,globmax ; move.l a0,hp
- add.l #2000,a0 ; move.l a0,-(sp)
- bsr _break !ask for core
- testen (sp)+ ; bne toolarge
- move.l eb,a6 ; move.l filb,4(a6)
- move.l ntext,-(sp)
- move.l pb,-(sp)
- mov savefd,-(sp)
- bsr _read
- testen (sp)+ ; bne badarg
- add.l #4,sp
-#if float
-! PM
-#endif
-
-lblbuf: sub.l #2048,sp
- claimstack
- move.l sp,a4 !transport ptr a4
- move.l sp,a5
- move.l #2048,-(sp) ; move.l a4,-(sp)
- mov savefd,-(sp) ; bsr _read
- testen (sp)+ ; bne badarg
- move.l (sp)+,d0
- cmp.l #2048,d0 ; bcs 0f
- add.l #1024,a5 ; bra 1f !a5 =buffer middle
-0: add.l d0,a5 !a5 = buffer end
-1: move.l eb,a3 !At a3 filling has to start
- clr.l d1 ; clr.l d2
- move.l #datswi,a6
-
-datloop: cmp.l a4,a5 ; bhi 9f !Go on filling data
- bsr blshift !shift block down , read next block
-9: sub.l #1,ndata ; blt finito
- move.b (a4)+,d1 ; beq dat0 !type byte in d1
- move.l a3,a2 ; move.b (a4)+,d2 !count byte in d2
- asl.l #2,d1 ; move.l -4(a6,d1),a0
- jmp (a0)
-
- .data
-datswi: .long dat1; .long dat2; .long dat3; .long dat4
- .long dat5; .long dat6; .long dat6; .long dofloat
- .text
-
-dat0: add.l #4,a1
- move.b (a4)+,-(a1) ; move.b (a4)+,-(a1)
- move.b (a4)+,-(a1) ; move.b (a4)+,-(a1)
- move.l (a1),d0 ; move.l a3,d4 !d0 =count
- sub.l a2,d4 !reconstruct byte count of previous describtor
- sub.l #1,d0 ; sub.l #1,d4
-1: move.l d4,d3
-2: move.b (a2)+,(a3)+ ; dbra d3,2b
- dbra d0,1b ; bra datloop
-
-dat1: mov und,(a3)+ ; sub.b #1,d2
- bne dat1 ; bra datloop
-
-dat2: move.b (a4)+,(a3)+ ; sub.b #1,d2
- bne dat2 ; bra datloop
-
-dat3: move.w wrd,d1 ; add.l d1,a3 !wrd = 2 or 4
-3: move.b (a4)+,-(a3) ; sub.b #1,d1 ; bgt 3b
- add.l wrd,a3 ; sub.b #1,d2
- bne dat3 ; bra datloop
-
-dat4: move.l eb,d4 ; bra 4f
-dat5: move.l pb,d4
-4: add.l #4,a3
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- add.l d4,(a3)+ ; sub.b #1,d2
- bne 4b ; bra datloop
-
-dat6: add.l d2,a3 ; move.l d2,d3
-6: move.b (a4)+,-(a3) ; sub.b #1,d2
- bne 6b ; add.l d3,a3
- bra datloop
-
-dofloat: add.l d2,a3
- bsr atof ; bra datloop
-
-!DUMMY ASCII TO FLOAT ROUTINE
-atof: tst.b (a4)+ ; bne atof
- rts
-
-blshift: move.l a5,a0 ; move.l #1024,d0
- sub.l d0,a0 ; move.l d0,-(sp)
- sub.l d0,a4 !update pointer
- asr.l #2,d0
-0: move.l (a5)+,(a0)+ ; sub.w #1,d0
- bgt 0b ; move.l a0,a5
- move.l a5,-(sp) ; mov savefd,-(sp)
- bsr _read
- testen (sp)+ ; bne badarg
- move.l (sp)+,d0
- cmp.l #1024,d0 ; beq 1f
- add.l d0,a5
-1: rts
-
-finito: cmp.l hp,a3 ; bne badarg !load file error
- move.l eb,a6 !eb IN a6 NOW
- lea 4(a6),a0 !filb CONTAINS eb+4
- move.l a0,filb
-
-!WE START TO READ THE PROCEDURE DESCRIPTORS
-
- move.l nproc,d1 ; move.l pd,a3
- asl.l #3,d1 !proc. descr. is 8 bytes
-4: move.l a5,d2 ; sub.l a4,d2 !What is available?
- add.l #7,d2 ; and.w #-0x8,d2 !multiple of 8!
- sub.l d2,d1 !subtract what can
- asr.l #3,d2 !be read. divide by 8
- sub.l #1,d2
-2: add.l #4,a3
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- add.l #8,a3
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- move.b (a4)+,-(a3) ; move.b (a4)+,-(a3)
- move.l pb,d0 ; add.l d0,(a3)+ !em address to machine address
-
-#if count+prof+flow
- clr.l (a3)+
- clr.l (a3)+
- clr.l (a3)+
- clr.l (a3)+
-#endif
- dbra d2,2b ; tst.l d1
- ble 3f ; bsr blshift !more or ready
- bra 4b
-3: cmp.l eb,a3 ; bne badarg
- move.l savefd,-(sp) ; bsr _close
- move.l ml,sp !refresh stack
-
-#if count+prof+flow
-! |=======================|
-! Here we fill the fields in the procedure | current file name |
-! descriptor with table information. The |-----------------------|
-! procedure descriptor has six fields, | link to next proc |
-! like described in this picture. We |-----------------------|
-! construct a linked list of the procedure | first line number |
-! descriptors, such that the defined |-----------------------|
-! order of procedures is compatible | count pointer |
-! with the text order. Thereafter we |-----------------------|
-! scan the text for line information to | start address |
-! fill the count pointer and startline |-----------------------|
-! field. The link to the first procedure | bytes for locals |
-! is in firstp , links are descriptor |=======================|
-! start addresses. The last procedure
-! links to the external base. All lines in the text get a count
-! number, lines of a procedure get consecutive count numbers,
-! the procedure count pointer gives the number of the first line.
-! Count pointer zero is reserved for the case that no line number
-! is yet defined.
-
-! Register use: a6 is external base ("eb"), a1 points at return area, other
-! registers are free
-
-makelink: move.l pd,a0
- move.l #0,a2
- move.l a0,a3 !a3 will point at the first proc.
- move.l a0,a4 !a4 will point at proc descr base
-0: move.l a0,a5 !keep former descr pointer in a5
- add.l #24,a0 !a0 points at next one
- cmp.l a0,a6 !top of descriptor space
- bls 4f !yes? ready!
-1: move.l 4(a0),d0 !start address of current proc in d0
- cmp.l 4(a5),d0 !compair start address with previous
- bcc 2f !d0 large? follow link!
- sub.l #24,a5 !d0 small? compair with previous
- cmp.l a5,a4 !is a5 smaller than pd
- bls 1b !no? try again
- move.l a3,16(a0) !yes? then smallest text add up to now
- move.l a0,a3 !remind a3 is to point at first proc
- bra 0b !next descriptor
-2: move.l 16(a5),d1 !follow the link to find place
- beq 3f !if 0 then no link defined
- move.l d1,a2
- cmp.l 4(a2),d0 !compair start address
- bcs 3f !start addr between those of a5 and a2
- move.l a2,a5 !d0 above start address of a5
- bra 2b !go on looking
-3: move.l a0,16(a5) !a0 follows a5
- move.l d1,16(a0) !a2 follows a0
- bra 0b
-4: move.l a3,firstp !firstp links to first procedure
-
-! Register use: a3 points at first procedure , d0 opcode byte , a5 base of
-! table , d1 keeps min line nr , d2 keeps max line nr , d3 current line nr ,
-! maxcount in d4
-
-procinf: move.l #1,maxcount !count pointer for first procedure
- move.l #1,d4
- move.l #0,d3
- move.l #0,d0
-0: move.l a3,-(sp) !stack current procedure
- move.l #-1,d1 !minimal line number on 0xFFFFFFFF
- move.l #0,d2 !maximal line number on 0
- tst.l 16(a3) !bottom address next procedure
- beq 6f !if 0 last procedure
- move.l 16(a3),a4
- move.l 4(a4),a4 !a4 points at top of current proc
- bra 2f
-6: move.l pd,a4
-2: move.l 4(a3),a3 !start address of current procedure
-8: move.b (a3)+,d0 !start scanning
- cmp.b #-2,d0
- beq 1f !case escape1
- cmp.b #-1,d0
- beq 6f !case escape2
- cmp.b #-106,d0
- bhi 7f !ordinary skip at 7
- beq 2f !case lni at 2
- cmp.b #-108,d0 !lin_l ?
- bcs 7f !ordinary skip at 7
- beq 3f !lin_l at 3
- move.l #0,d3
- move.b (a3)+,d3 !lin_s0 here
- bra 4f !compare at 4
-2: add.l #1,d3
- bra 4f
-3: adroff
- move.l #0,d3
- move.w (a1),d3
- bra 4f
-6: move.b (a3)+,d0
- cmp.b #35,d0 !lin_q ?
- bne 6f !skip for escape2 at 6f
- move.b (a3)+,(a1)+
- move.b (a3)+,(a1)+
- move.b (a3)+,(a1)+
- move.b (a3)+,(a1)
- sub.l #3,a1
- move.l (a1),d3
-4: cmp.l d1,d3 !d3 less than minimum ?
- bcc 5f
- move.l d3,d1
-5: cmp.l d3,d2 !d3 more than maximum ?
- bcc 9f
- move.l d3,d2
- bra 9f
-6: add.l #4,a3
- bra 9f
-1: move.b (a3)+,d0
- move.l d0,a2 !escape1 opcodes treated here
- add.l #256,a2 !second table
- bra 1f
-7: move.l d0,a2
-1: move.b skipdisp(a2),d0 !look for argument size
- add.l d0,a3
-9: cmp.l a3,a4 !still more text
- bhi 8b
- move.l (sp)+,a3 !bottom back
- sub.l d1,d2 !compute number of lines
- bcs 9f !no line so no information
- move.l d4,8(a3)
- move.l d1,12(a3)
- add.l #1,d2
- add.l d2,d4 !this is the new maxcount
- move.l d4,maxcount
-9: tst.l 16(a3) !follow link to next procedure
- beq 1f
- move.l 16(a3),a3
- bra 0b
-1:
-countlabel:
-
- .data
-skipdisp:
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 2; .byte 0;
-.byte 0; .byte 1; .byte 1; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;
-.byte 1; .byte 1; .byte 1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;
-
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 0;
-.byte 1; .byte 0; .byte 0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 0;
-.byte 1; .byte 1; .byte 0; .byte 1; .byte 0; .byte 2; .byte 0; .byte 2;
-.byte 1; .byte 0; .byte 0; .byte 0; .byte 1; .byte 1; .byte 0; .byte 1;
-.byte 2; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1;
-
-.byte 2; .byte 2; .byte 0; .byte 0; .byte 1; .byte 1; .byte 1; .byte 0;
-.byte 0; .byte 2; .byte 1; .byte 0; .byte 1; .byte 0; .byte 0; .byte 1;
-.byte 1; .byte 1; .byte 0; .byte 0; .byte 2; .byte 1; .byte 0; .byte 2;
-.byte 0; .byte 1; .byte 1; .byte 2; .byte 1; .byte 1; .byte 1; .byte 1;
-.byte 1; .byte 2; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1; .byte 2;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1; .byte 2; .byte 2;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 0; .byte 0; .byte 0; .byte 1; .byte 1; .byte 0; .byte 0;
-
-.byte 0; .byte 1; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1;
-.byte 0; .byte 0; .byte 1; .byte 0; .byte 0; .byte 1; .byte 1; .byte 1;
-.byte 1; .byte 0; .byte 2; .byte 1; .byte 1; .byte 1; .byte 2; .byte 0;
-.byte 0; .byte 1; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 1;
-.byte 2; .byte 2; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0; .byte 0;
-.byte 0; .byte 1; .byte 0; .byte 0; .byte 0; .byte 0; .byte 2; .byte 1;
-.byte 1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1; .byte 1;
-.byte 2; .byte 1; .byte 0; .byte 0; .byte 1; .byte 2; .byte 7; .byte 5;
-
-!escaped opcodes
-
-.byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 0; .byte 2;
-.byte 2; .byte 2; .byte 2; .byte 2; .byte 0; .byte 2; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 0; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 0; .byte 0; .byte 0; .byte 2; .byte 2; .byte 2;
-.byte 2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
-.byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;
-
-.byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;
-.byte 2; .byte 2; .byte 2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 1;
-.byte 2; .byte 2; .byte 2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
-.byte 0; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 0; .byte 2;
-.byte 0; .byte 2; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
-.byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 2; .byte 2;
-.byte 2; .byte 2; .byte 0; .byte 0; .byte 2; .byte 2; .byte 0; .byte 2;
-
-.byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2; .byte 0; .byte 2;
-.byte 2; .byte 0; .byte 1; .byte 0; .byte 0; .byte 0; .byte 2; .byte 0;
-.byte 2; .byte 0; .byte 2; .byte 2; .byte 2; .byte 2; .byte 2; .byte 2;
-.byte 0; .byte 2; .byte 0; .byte 1; .byte 2; .byte 0; .byte 0; .byte 2;
-
- .text
- move.l globmax,d1
- move.l d1,a3
-#if prof
- move.l d1,ltime
- move.l d1,profile !PROFILE POINTER FOR CURRENT PROC
- move.l maxcount,d0
- add.l #1,d0
- asl.l #2,d0 !4 BYTES FOR EACH LINE
- add.l d0,d1
- move.l d0,profsiz !profsiz CONTAINS NEEDED MEM SIZE
-#endif
-#if flow
- move.l d1,lflow
- move.l maxcount,d0
- asr.l #3,d0 !divide by 8 ; byte is 8 bits ,you know
- add.l #2,d0
- bclr #0,d0 !make integer number of words (2 byte!)
- add.l d0,d1
- move.l d0,flowsiz
-#endif
-#if count
- move.l d1,lcount
- move.l maxcount,d0
- add.l #1,d0
- asl.l #2,d0
- add.l d0,d1
- move.l d0,countsiz
-#endif
- move.l d1,tblmax
- add.l #1024,d1
- cmp.l nd,d1
- bcs 2f
- move.l d1,-(sp)
- bsr _break
- testen (sp)+
- bne toolarge
-2: sub.l a3,d1
- asr.l wmu,d1
-3: cl (a3)+
- dbra d1,3b
- sub.l #1024,a3
- move.l a3,hp
-cfp: move.l ml,sp !LABEL FOR DEBUGGING
-
-#endif
-
-!----------------------------------------------------------------------------
-! START CALLING SEQUENCE HERE
-!-----------------------------------------------------------------------------
-
- lea loop,a4
- move.l pb,a3
- move.l #0,a2
- move.l wmu-1,d7
- clr.l d6
-lblsp: move.l entry,-(sp) !start procedure to call
- bra cai_z
-
-
-nofile: mov #0xD,d0 ; bra notrap1
-badarg: move.l eb,a6
-badarg1: mov #0xE,d0 ; bra notrap1
-toolarge: mov #0xF,d0 ; bra notrap1
- .data
-retsize: .space 2
-retarea: .space 32
-
-
- .bss
-argc: .space 4
-argv: .space 4
-envp: .space 4
-savefd: .space 4
-header:
-ntext: .space 4
-ndata: .space 4
-nproc: .space 4
-entry: .space 4
-nline: .space 4
-szdata: .space 4
-firstp: .space 4
-maxcount: .space 4
-
-tblmax: .space 4
-globmax: .space 4
-ml: .space 4
-eb: .space 4 !EXPLICITELY REQUIRED eb, filb, curproc IN
-filb: .space 4 !THIS ORDER
-curproc: .space 4
-pb: .space 4
-pd: .space 4
-hp: .space 4
-
- .define filb
- .define curproc
- .define pd
- .define nproc
- .define retarea
- .define retsize
- .define hp
- .define globmax
- .define tblmax
- .define ml
- .define argc
-
- .text
+++ /dev/null
-!-------------------------------------------------------------------------------
-! Main loop of the interpreter starts here
-!----------------------------------------------------------------------------
-
-loop: move.l #0,d0
- move.b (a3)+,d0 !opcode in d0
- add.w d0,d0 !opcode to index in table
- add.w d0,d0
-#if prof
- move.l profile,a0
- lea timeinf,a5
- move.l 0(a5,d0),d1 !get operation time
- add.l d1,(a0)
-#endif
-#if opfreq
- lea counttab,a5
- add.l #1,0(a5,d0)
-#endif
- jmp dispat(pc,d0) !jump to branch to the operation
-
-
-!---------------------------------------------------------------------------
-! the BRANCH LIST follows
-!--------------------------------------------------------------------------
-
-
-dispat:
-
-
-bra loc_0 ; bra loc_1 ; bra loc_2 ; bra loc_3
-bra loc_4 ; bra loc_5 ; bra loc_6 ; bra loc_7
-bra loc_8 ; bra loc_9 ; bra loc_10 ; bra loc_11
-bra loc_12 ; bra loc_13 ; bra loc_14 ; bra loc_15
-bra loc_16 ; bra loc_17 ; bra loc_18 ; bra loc_19
-bra loc_20 ; bra loc_21 ; bra loc_22 ; bra loc_23
-bra loc_24 ; bra loc_25 ; bra loc_26 ; bra loc_27
-bra loc_28 ; bra loc_29 ; bra loc_30 ; bra loc_31
-bra loc_32 ; bra loc_33 ; bra aar_1W ; bra adf_s0
-bra adi_1W ; bra adi_2W ; bra adp_l ; bra adp_1
-bra adp_2 ; bra adp_s0 ; bra adp_s_1 ; bra ads_1W
-bra and_1W ; bra asp_1W ; bra asp_2W ; bra asp_3W
-bra asp_4W ; bra asp_5W ; bra asp_w0 ; bra beq_l
-bra beq_s0 ; bra bge_s0 ; bra bgt_s0 ; bra ble_s0
-bra blm_s0 ; bra blt_s0 ; bra bne_s0 ; bra bra_l
-bra bra_s_1 ; bra bra_s_2 ; bra bra_s0 ; bra bra_s1
-bra cal_1 ; bra cal_2 ; bra cal_3 ; bra cal_4
-bra cal_5 ; bra cal_6 ; bra cal_7 ; bra cal_8
-bra cal_9 ; bra cal_10 ; bra cal_11 ; bra cal_12
-bra cal_13 ; bra cal_14 ; bra cal_15 ; bra cal_16
-bra cal_17 ; bra cal_18 ; bra cal_19 ; bra cal_20
-bra cal_21 ; bra cal_22 ; bra cal_23 ; bra cal_24
-bra cal_25 ; bra cal_26 ; bra cal_27 ; bra cal_28
-bra cal_s0 ; bra cff_z ; bra cif_z ; bra cii_z
-bra cmf_s0 ; bra cmi_1W ; bra cmi_2W ; bra cmp_z
-bra cms_s0 ; bra csa_1W ; bra csb_1W ; bra dec_z
-bra dee_w0 ; bra del_w_1 ; bra dup_1W ; bra dvf_s0
-bra dvi_1W ; bra fil_l ; bra inc_z ; bra ine_lw
-bra ine_w0 ; bra inl__1W ; bra inl__2W ; bra inl__3W
-bra inl_w_1 ; bra inn_s0 ; bra ior_1W ; bra ior_s0
-bra lae_l ; bra lae_w0 ; bra lae_w1 ; bra lae_w2
-bra lae_w3 ; bra lae_w4 ; bra lae_w5 ; bra lae_w6
-bra lal_p ; bra lal_n ; bra lal_0 ; bra lal__1
-bra lal_w0 ; bra lal_w_1 ; bra lal_w_2 ; bra lar_1W
-bra ldc_0 ; bra lde_lw ; bra lde_w0 ; bra ldl_0
-bra ldl_w_1 ; bra lfr_1W ; bra lfr_2W ; bra lfr_s0
-bra lil_w_1 ; bra lil_w0 ; bra lil_0 ; bra lil_1W
-bra lin_l ; bra lin_s0 ; bra lni_z ; bra loc_l
-bra loc__1 ; bra loc_s0 ; bra loc_s_1 ; bra loe_lw
-bra loe_w0 ; bra loe_w1 ; bra loe_w2 ; bra loe_w3
-bra loe_w4 ; bra lof_l ; bra lof_1W ; bra lof_2W
-bra lof_3W ; bra lof_4W ; bra lof_s0 ; bra loi_l
-bra loi_1 ; bra loi_1W ; bra loi_2W ; bra loi_3W
-bra loi_4W ; bra loi_s0 ; bra lol_pw ; bra lol_nw
-bra lol_0 ; bra lol_1W ; bra lol_2W ; bra lol_3W
-bra lol__1W ; bra lol__2W ; bra lol__3W ; bra lol__4W
-bra lol__5W ; bra lol__6W ; bra lol__7W ; bra lol__8W
-bra lol_w0 ; bra lol_w_1 ; bra lxa_1 ; bra lxl_1
-bra lxl_2 ; bra mlf_s0 ; bra mli_1W ; bra mli_2W
-bra rck_1W ; bra ret_0 ; bra ret_1W ; bra ret_s0
-bra rmi_1W ; bra sar_1W ; bra sbf_s0 ; bra sbi_1W
-bra sbi_2W ; bra sdl_w_1 ; bra set_s0 ; bra sil_w_1
-bra sil_w0 ; bra sli_1W ; bra ste_lw ; bra ste_w0
-bra ste_w1 ; bra ste_w2 ; bra stf_l ; bra stf_1W
-bra stf_2W ; bra stf_s0 ; bra sti_1 ; bra sti_1W
-bra sti_2W ; bra sti_3W ; bra sti_4W ; bra sti_s0
-bra stl_pw ; bra stl_nw ; bra stl_0 ; bra stl_1W
-bra stl__1W ; bra stl__2W ; bra stl__3W ; bra stl__4W
-bra stl__5W ; bra stl_w_1 ; bra teq_z ; bra tgt_z
-bra tlt_z ; bra tne_z ; bra zeq_l ; bra zeq_s0
-bra zeq_s1 ; bra zer_s0 ; bra zge_s0 ; bra zgt_s0
-bra zle_s0 ; bra zlt_s0 ; bra zne_s0 ; bra zne_s_1
-bra zre_lw ; bra zre_w0 ; bra zrl__1W ; bra zrl__2W
-bra zrl_w_1 ; bra zrl_nw
-
-.errnz .-dispat-1016
-!-----------------------------------------------------------------------------
-! Two byte opcodes come here for decoding of second byte
-!----------------------------------------------------------------------------
-
-escape1:
- move.l #0,d0
- bra 1f
- bra escape2
-1: move.b (a3)+,d0 !second byte ,extended opcode
- add.w d0,d0 !make index of address
- add.w d0,d0
- cmp.w #640,d0 !check for range
- bhi e_illins !jump to ill instruction procedure
-#if prof
- lea timeinf1,a5
- move.l 0(a5,d0),d1
- add.l d1,(a0)
-#endif
-#if opfreq
- lea counttab+1024,a5
- add.l #1,0(a5,d0)
-#endif
- jmp dispae1(pc,d0) !jump to the operation
-
-!------------------------------------------------------------------------------
-! now dispatch table for escaped opcodes
-!------------------------------------------------------------------------------
-
-dispae1: !dispatch escaped opcodes 1
-
-bra aar_l ; bra aar_z ; bra adf_l ; bra adf_z
-bra adi_l ; bra adi_z ; bra ads_l ; bra ads_z
-bra adu_l ; bra adu_z ; bra and_l ; bra and_z
-bra asp_lw ; bra ass_l ; bra ass_z ; bra bge_l
-bra bgt_l ; bra ble_l ; bra blm_l ; bra bls_l
-bra bls_z ; bra blt_l ; bra bne_l ; bra cai_z
-bra cal_l ; bra cfi_z ; bra cfu_z ; bra ciu_z
-bra cmf_l ; bra cmf_z ; bra cmi_l ; bra cmi_z
-bra cms_l ; bra cms_z ; bra cmu_l ; bra cmu_z
-bra com_l ; bra com_z ; bra csa_l ; bra csa_z
-bra csb_l ; bra csb_z ; bra cuf_z ; bra cui_z
-bra cuu_z ; bra dee_lw ; bra del_pw ; bra del_nw
-bra dup_l ; bra dus_l ; bra dus_z ; bra dvf_l
-bra dvf_z ; bra dvi_l ; bra dvi_z ; bra dvu_l
-bra dvu_z ; bra fef_l ; bra fef_z ; bra fif_l
-bra fif_z ; bra inl_pw ; bra inl_nw ; bra inn_l
-bra inn_z ; bra ior_l ; bra ior_z ; bra lar_l
-bra lar_z ; bra ldc_l ; bra ldf_l ; bra ldl_pw
-bra ldl_nw ; bra lfr_l ; bra lil_pw ; bra lil_nw
-bra lim_z ; bra los_l ; bra los_z ; bra lor_s0
-bra lpi_l ; bra lxa_l ; bra lxl_l ; bra mlf_l
-bra mlf_z ; bra mli_l ; bra mli_z ; bra mlu_l
-bra mlu_z ; bra mon_z ; bra ngf_l ; bra ngf_z
-bra ngi_l ; bra ngi_z ; bra nop_z ; bra rck_l
-bra rck_z ; bra ret_l ; bra rmi_l ; bra rmi_z
-bra rmu_l ; bra rmu_z ; bra rol_l ; bra rol_z
-bra ror_l ; bra ror_z ; bra rtt_z ; bra sar_l
-bra sar_z ; bra sbf_l ; bra sbf_z ; bra sbi_l
-bra sbi_z ; bra sbs_l ; bra sbs_z ; bra sbu_l
-bra sbu_z ; bra sde_l ; bra sdf_l ; bra sdl_pw
-bra sdl_nw ; bra set_l ; bra set_z ; bra sig_z
-bra sil_pw ; bra sil_nw ; bra sim_z ; bra sli_l
-
-
-bra sli_z ; bra slu_l ; bra slu_z ; bra sri_l
-bra sri_z ; bra sru_l ; bra sru_z ; bra sti_l
-bra sts_l ; bra sts_z ; bra str_s0 ; bra tge_z
-bra tle_z ; bra trp_z ; bra xor_l ; bra xor_z
-bra zer_l ; bra zer_z ; bra zge_l ; bra zgt_l
-bra zle_l ; bra zlt_l ; bra zne_l ; bra zrf_l
-bra zrf_z ; bra zrl_pw ; bra dch_z ; bra exg_s0
-bra exg_l ; bra exg_z ; bra lpb_z ; bra gto_l
-
-.errnz .-dispae1-640
-
-!----------------------------------------------------------------------------
-
-escape2:
- move.l #0,d0
- move.b (a3)+,d0 !opcode
- sub.l #4,sp
- move.b (a3)+,(sp)
- move.b (a3)+,1(sp)
- move.b (a3)+,2(sp)
- move.b (a3)+,3(sp)
- add.w d0,d0
- add.w d0,d0
- cmp.w #220,d0
- bhi e_illins
-#if prof
- lea timeinf2,a5
- move.l 0(a5,d0),d1
- add.l d1,(a0)
-#endif
-#if opfreq
- lea counttab+1664,a5
- add.l #1,0(a5,d0)
-#endif
- jmp dispae2(pc,d0)
-
-
-!---------------------------------------------------------------------------
-! BRANCH TABLE FOR SECOND ESCAPED OPCODES
-!---------------------------------------------------------------------------
-
-dispae2:
-bra ldc_q ; bra lae_q ; bra lal_qp ; bra lal_qn
-bra lde_qw ; bra ldf_q ; bra ldl_qpw ; bra ldl_qnw
-bra lil_qpw ; bra lil_qnw ; bra loc_q ; bra loe_qw
-bra lof_q ; bra lol_qpw ; bra lol_qnw ; bra lpi_q
-bra adp_q ; bra asp_qw ; bra beq_q ; bra bge_q
-bra bgt_q ; bra ble_q ; bra blm_q ; bra blt_q
-bra bne_q ; bra bra_q ; bra cal_q ; bra dee_qw
-bra del_qpw ; bra del_qnw ; bra fil_q ; bra gto_q
-bra ine_qw ; bra inl_qpw ; bra inl_qnw ; bra lin_q
-bra sde_q ; bra sdf_q ; bra sdl_qpw ; bra sdl_qnw
-bra sil_qpw ; bra sil_qnw ; bra ste_qw ; bra stf_q
-bra stl_qpw ; bra stl_qnw ; bra zeq_q ; bra zge_q
-bra zgt_q ; bra zle_q ; bra zlt_q ; bra zne_q
-bra zre_qw ; bra zrl_qpw ; bra zrl_qnw
-
-.errnz .-dispae2-220
-
-!------------------------------------------------------------------------------
-! timeinf tables, first the unescaped opcodes
-! these tables are parallel to the tables dispat , dispae1 and dispae2
-! Each entry contains a reasonable estimate of
-! the number of processor state cycles needed to
-! execute that instruction. The exact amount cannot be
-! supplied, since this can depend rather heavily on the
-! size of the object in set, array case instructions etc.
-! The table timeinf also contains, added to each entry,
-! the number of processor state cycles needed to find the instruction.
-! This number is currently 22.Also the number of processor state
-! cycles to return from the instruction is included.
-! The number is computed for
-! the case that all check and runinf options are off.
-!------------------------------------------------------------------------------
-
-#if prof
-
- .data
-
-timeinf:
-.long 33 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 35 ; .long 35
-.long 35 ; .long 35 ; .long 127 ; .long 00
-.long 36 ; .long 42 ; .long 56 ; .long 40
-.long 40 ; .long 42 ; .long 42 ; .long 42
-.long 36 ; .long 39 ; .long 39 ; .long 39
-.long 39 ; .long 39 ; .long 41 ; .long 67
-.long 48 ; .long 48 ; .long 48 ; .long 48
-.long 97 ; .long 48 ; .long 48 ; .long 55
-.long 45 ; .long 45 ; .long 36 ; .long 43
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 211 ; .long 211 ; .long 211 ; .long 211
-.long 213 ; .long 00 ; .long 00 ; .long 66
-.long 00 ; .long 50 ; .long 54 ; .long 54
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-
-timeinf1:
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-
-timeinf2:
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00 ; .long 00
-.long 00 ; .long 00 ; .long 00
-
-#endif
- .text
+++ /dev/null
-!--------------------------------------------------------------------------
-! Laod constant , load local , store local
-!--------------------------------------------------------------------------
-
-loc_0: mov d6,-(sp)
- jmp (a4)
-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:
- asr.w #2,d0 !make the multiplication undone
- mov d0,-(sp)
- jmp (a4)
-loc__1:
- mov #-1,-(sp)
- jmp (a4)
-loc_s0: clr.w d0
- move.b (a3)+,d0
- mov d0,-(sp)
- jmp (a4)
-loc_s_1: mov #-1,d0
- move.b (a3)+,d0
- mov d0,-(sp)
- jmp (a4)
-lpi_l:
- adroff
- move.w (a1),d0
- move.l d0,-(sp)
- jmp (a4)
-lpi_q: jmp (a4)
-
-loc_q: jmp (a4)
-#ifndef lword
- bra e_illins
-#endif
-loc_l: adroff
- move.w (a1),d0
- ext.l d0
- mov d0,-(sp)
- jmp (a4)
-ldc_0: cl -(sp)
- cl -(sp)
- jmp (a4)
-ldc_l:
- adroff
- move.w (a1),d0
- ext.l d0 !ext works only on d register
-4: move.l d0,-(sp) !adapt for l , then "move.2l" signextended
-#ifdef lword
- bmi 0f
- clr.l -(sp)
- bra 1f
-0: move.l #-1,-(sp)
-1:
-#endif
- jmp (a4)
-ldc_q:
-#ifdef lword
- clr.l -(sp)
-#endif
- jmp (a4)
-
-!-------------------------------------------------------------------------
-! offsets should be adapted for wordsize 4 .Use identifiers
-! l3 to l_8 for the offsets in lol_3W to lol__8 . Use the
-! preprocessor for conditional definitions .
-
-lol_0: mov l0(a2),-(sp) ; jmp (a4)
-lol_1W: mov l1(a2),-(sp) ; jmp (a4)
-lol_2W: mov l2(a2),-(sp) ; jmp (a4)
-lol_3W: mov l3(a2),-(sp) ; jmp (a4)
-lol__1W: mov l_1(a2),-(sp) ; jmp (a4)
-lol__2W: mov l_2(a2),-(sp) ; jmp (a4)
-lol__3W: mov l_3(a2),-(sp) ; jmp (a4)
-lol__4W: mov l_4(a2),-(sp) ; jmp (a4)
-lol__5W: mov l_5(a2),-(sp) ; jmp (a4)
-lol__6W: mov l_6(a2),-(sp) ; jmp (a4)
-lol__7W: mov l_7(a2),-(sp) ; jmp (a4)
-lol__8W: mov l_8(a2),-(sp) ; jmp (a4)
-lol_w0: clr.w d0
- move.b (a3)+,d0
-5: asl.l wmu,d0
- mov 16(a2,d0),-(sp)
- jmp (a4)
-
-lol_w_1: move.l #-1,d0
- move.b (a3)+,d0
-2: asl.l wmu,d0
- mov 0(a2,d0),-(sp)
- jmp (a4)
-lol_pw: adroff
- move.w (a1),d0
- bra 5b
-
-lol_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 2b
-lol_qnw: move.l (sp)+,d0
- bra 2b
-lol_qpw: move.l (sp)+,d0
- bra 5b
-
-
-!--------------------------------------------------------------------------
-
-ldl_0: mov l1(a2),-(sp) !offset code
- mov l0(a2),-(sp) !offset code
- jmp (a4)
-ldl_w_1: move.l #-1,d0
- move.b (a3)+,d0
-2: asl.l wmu,d0
- mov word(a2,d0),-(sp)
- mov 0(a2,d0),-(sp)
- jmp (a4)
-ldl_pw: adroff
- move.w (a1),d0
-5: asl.l wmu,d0
- mov l1(a2,d0),-(sp)
- mov l0(a2,d0),-(sp)
- jmp (a4)
-ldl_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 2b
-ldl_qpw: move.l (sp)+,d0
- bra 5b
-ldl_qnw: move.l (sp)+,d0
- bra 2b
-
-!-------------------------------------------------------------------------
-loe_lw: adroff
- move.w (a1),d0
- bra 1f
-loe_qw: move.l (sp)+,d0
- bra 1f
-
-loe_w0: loe_w1: loe_w2: loe_w3: loe_w4:
- sub.w #624,d0
- asl.w #6,d0
- move.b (a3)+,d0
-1: ext.l d0
- asl.l wmu,d0
- mov 0(a6,d0),-(sp)
- jmp (a4)
-
-lde_lw: adroff
- move.w (a1),d0
- bra 1f
-lde_qw: move.l (sp)+,d0
- bra 1f
-
-lde_w0: clr.w d0
- move.b (a3)+,d0
-1: asl.l wmu,d0
- mov word(a6,d0),-(sp)
- mov 0(a6,d0),-(sp)
- jmp (a4)
-
-!------------------------------------------------------------------------------
-lil_0: move.l l0(a2),a0
- mov (a0),-(sp)
- jmp (a4)
-lil_1W: move.l l1(a2),a0
- mov (a0),-(sp)
- jmp (a4)
-lil_pw: adroff
- move.w (a1),d0
- bra 1f
-lil_qpw: move.l (sp)+,d0
- bra 1f
-
-lil_w0: clr.w d0
- move.b (a3)+,d0
-1: asl.l wmu,d0
- move.l l0(a2,d0),a0
- mov (a0),-(sp)
- jmp (a4)
-
-lil_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 1f
-lil_qnw: move.l (sp)+,d0
- bra 1f
-
-lil_w_1: move.l #-1,d0
- move.b (a3)+,d0
-1: asl.l wmu,d0
- move.l 0(a2,d0),a0
- mov (a0),-(sp)
- jmp (a4)
-
-!---------------------------------------------------------------------------
-lof_s0: move.l d6,d0
- move.b (a3)+,d0
- bra 1f
-lof_l: adroff
- move.w (a1),d0
- ext.l d0
- bra 1f
-lof_q: move.l (sp)+,d0
- bra 1f
-lof_1W: move.l #1,d0
-2: asl.w wmu,d0
-1: move.l (sp)+,a0
- mov 0(a0,d0),-(sp)
- jmp (a4)
-lof_2W: move.l #2,d0 ; bra 2b
-lof_3W: move.l #3,d0 ; bra 2b
-lof_4W: move.l #4,d0 ; bra 2b
-ldf_l: adroff
- move.w (a1),d0
- ext.l d0
-2: move.l (sp)+,a0
- mov word(a0,d0),-(sp)
- mov 0(a0,d0),-(sp)
- jmp (a4)
-ldf_q: move.l (sp)+,d0
- bra 2b
-
-!-------------------------------------------------------------------------
-
-lal_p: adroff
- move.w (a1),d0
- bra 1f
-lal_qp: move.l (sp)+,d0
- bra 1f
-lal_0: pea 16(a2)
- jmp (a4)
-lal_w0: clr.w d0
- move.b (a3)+,d0
- asl.l wmu,d0
-1: add.l #16,d0
- bra 3f
-lal_n: adroff
- move.w (a1),d0
- ext.l d0
- bra 3f
-lal_qn: move.l (sp)+,d0
- bra 3f
-lal__1: move.l #-1,d0
-3: pea 0(a2,d0)
- jmp (a4)
-lal_w_1: move.l #-1,d0
-2: move.b (a3)+,d0
- asl.l wmu,d0
- bra 3b
-lal_w_2: move.l #-512,d0
- bra 2b
-lae_l: adroff
- move.w (a1),d0
- bra 1f
-lae_q: move.l (sp)+,d0
- bra 1f
-lae_w0: lae_w1: lae_w2: lae_w3: lae_w4:
-lae_w5: lae_w6:
- sub.w #484,d0
- asl.w #6,d0
- move.b (a3)+,d0
- asl.w wmu,d0
-1: pea 0(a6,d0)
- jmp (a4)
-
-!---------------------------------------------------------------------------
-lxl_1: move.l 16(a2),-(sp)
- jmp (a4)
-lxl_l: adroff
- move.w (a1),d0
- beq 5f
- bgt 1f
- blt e_oddz
-1: sub.l #1,d0
- bra 2f
-lxl_2: move.w #1,d0
-2: move.l a2,a0
-3: move.l 16(a0),a0
- dbra d0,3b
- move.l a0,-(sp)
- jmp (a4)
-5: move.l a2,-(sp)
- jmp (a4)
-
-lxa_1: move.l #0,d0
- bra 3f
-lxa_l: adroff
- move.w (a1),d0
- bgt 1f
- blt e_oddz
- pea 16(a2)
- jmp (a4)
-1: sub.l #1,d0
-3: move.l a2,a0
-2: move.l 16(a0),a0
- dbra d0,2b
- pea 16(a0)
- jmp (a4)
-
-!-----------------------------------------------------------------------
-
-loi_l: adroff
- clr.l d1
- move.w (a1),d1
- bra 8f
-loi_s0: clr.l d1
- move.b (a3)+,d1
-8: cmp.w #1,d1
- beq loi_1
- cmp.w #2,d1
- beq 2f
- move.w d1,d0
- move.w d7,d2
-3: asr.w #1,d0 ; dbcs d2,3b
- bcs e_oddz
- bra 5f
-loi_1W: loi_2W: loi_3W: loi_4W:
- asr.w #2,d0
- sub.w #168,d0
- move.l d0,d1
- asl.w wmu,d1
-5: move.l (sp)+,a0
- add.l d1,a0
- sub.w #1,d0
-1: mov -(a0),-(sp)
- dbra d0,1b
- jmp (a4)
-2: move.l (sp)+,a0
- move.w (a0),d0
- mov d0,-(sp)
- jmp (a4)
-loi_1: move.l (sp)+,a0
- move.w d6,d0
- move.b (a0),d0
- mov d0,-(sp)
- jmp (a4)
-
-los_z: mov (sp)+,d0
- bra 0f
-los_l: adroff
- move.w (a1),d0
-0: checksize
-2: move.l #0,d1 ; move.w (sp)+,d1 ; bra 8b
-4: move.l (sp)+,d1 ; bra 8b
+++ /dev/null
-!---------------------------------------------------------------------
-! STORE GROUP
-!---------------------------------------------------------------------
-
-stl_pw: adroff
- move.w (a1),d0
-3: asl.l wmu,d0
- mov (sp)+,16(a2,d0)
- jmp (a4)
-stl_qpw: move.l (sp)+,d0
- bra 3b
-
-stl_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 1f
-stl_qnw: move.l (sp)+,d0
- bra 1f
-stl_w_1: move.l #-1,d0
- move.b (a3)+,d0
-1: asl.l wmu,d0
- mov (sp)+,0(a2,d0)
- jmp (a4)
-stl_0: mov (sp)+,16(a2) ; jmp (a4)
-stl_1W: mov (sp)+,l1(a2) ; jmp (a4)
-stl__1W: mov (sp)+,l_1(a2) ; jmp (a4)
-stl__2W: mov (sp)+,l_2(a2) ; jmp (a4)
-stl__3W: mov (sp)+,l_3(a2) ; jmp (a4)
-stl__4W: mov (sp)+,l_4(a2) ; jmp (a4)
-stl__5W: mov (sp)+,l_5(a2) ; jmp (a4)
-sdl_w_1: move.l #-1,d0
- move.b (a3)+,d0
-2: asl.l wmu,d0
- mov (sp)+,0(a2,d0)
- mov (sp)+,word(a2,d0)
- jmp (a4)
-sdl_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 2b
-sdl_qnw: move.l (sp)+,d0
- bra 2b
-sdl_qpw: move.l (sp)+,d0
- bra 4f
-sdl_pw: adroff
- move.w (a1),d0
-4: asl.l wmu,d0
- mov (sp)+,l0(a2,d0)
- mov (sp)+,l1(a2,d0)
- jmp (a4)
-
-!------------------------------------------------------------------------
-
-sde_q: move.l (sp)+,d0
- bra 1f
-sde_l: adroff
- move.w (a1),d0
-1: mov (sp)+,0(a6,d0)
- mov (sp)+,word(a6,d0)
- jmp (a4)
-ste_qw: move.l (sp)+,d0
- bra 1f
-ste_lw: adroff
- move.w (a1),d0
- bra 1f
-ste_w2: move.w #512,d0 ; bra 0f
-ste_w1: move.w #256,d0 ; bra 0f
-ste_w0: clr.w d0
-0: move.b (a3)+,d0
-1: asl.l wmu,d0
- mov (sp)+,0(a6,d0)
- jmp (a4)
-
-!-------------------------------------------------------------------------
-
-stf_q: move.l (sp)+,a0
- bra 6f
-stf_l: adroff
- move.l #0,a0
- move.w (a1),a0
- bra 6f
-stf_2W: move.l wrd,a0 ; add.l a0,a0
- bra 6f
-stf_s0: clr.w d0
- move.b (a3)+,d0
- move.l d0,a0
- bra 6f
-stf_1W: move.l wrd,a0
-6: add.l (sp)+,a0
- mov (sp)+,(a0)
- jmp (a4)
-sdf_q: move.l (sp)+,a0
- bra 7f
-sdf_l: adroff
- move.l d6,a0
- move.w (a1),a0
-7: add.l (sp)+,a0
- mov (sp)+,(a0)+
- mov (sp)+,(a0)
- jmp (a4)
-
-
-!-----------------------------------------------------------------------------
-sil_w0: move.w d6,d0
- move.b (a3)+,d0
- asl.l wmu,d0
-5: move.l 16(a2,d0),a0
- mov (sp)+,(a0)
- jmp (a4)
-sil_w_1: move.l #-1,d0
- move.b (a3)+,d0
- asl.l wmu,d0
-2: move.l 0(a2,d0),a0
- mov (sp)+,(a0)
- jmp (a4)
-sil_pw: adroff
- move.w (a1),d0
- bra 5b
-sil_qpw: move.l (sp)+,d0
- bra 5b
-sil_nw: adroff
- move.w (a1),d0
- ext.l d0
- bra 2b
-sil_qnw: move.l (sp)+,d0
- bra 2b
-
-!----------------------------------------------------------------------------
-sti_1: move.l (sp)+,a0
- move.b word-1(sp),(a0) !lsb,msb goed?
- add.l wrd,sp
- jmp (a4)
-sti_l: adroff ; move.w (a1),d0 ; bra 0f
-sti_s0: clr.w d0 ; move.b (a3)+,d0
-0: asr.l #1,d0 ; bne 1f
- bcs sti_1 ; bra e_oddz
-1: bcs e_oddz
-#ifdef lword
- asr.l #1,d0 ; bne 2f
- move.l (sp)+,a0; lea 2(sp),sp
- move.w (sp)+,(a0); jmp (a4)
-2: bcs e_oddz
-#endif
- sub.w #1,d0 ; bra 3f
-sti_1W: sti_2W: sti_3W: sti_4W:
- sub.w #876,d0 ; asr.w #2,d0
-3: move.l (sp)+,a0
-4: mov (sp)+,(a0)+
- dbra d0,4b
- jmp (a4)
-sts_l: adroff ; move.w (a1),d0
-6: checksize
-4: move.l (sp)+,d0; bra 0b
-2: move.w (sp)+,d0; bra 0b
-sts_z: mov (sp)+,d0
- bra 6b
-
-!------------------------------------------------------------------------------
-! POINTER ARITHMETIC
-!------------------------------------------------------------------------------
-adp_l: adroff ; move.w (a1),d0
- ext.l d0
- add.l d0,(sp); jmp (a4)
-adp_q: move.l (sp)+,d0 ; add.l d0,(sp)
- jmp (a4)
-adp_1: add.l #1,(sp); jmp (a4)
-adp_2: add.l #2,(sp); jmp (a4)
-adp_s0: move.l d6,d0 ; move.b (a3)+,d0
- add.l d0,(sp); jmp (a4)
-adp_s_1: move.l #-1,d0 ; move.b (a3)+,d0
- add.l d0,(sp) ; jmp (a4)
-ads_l: adroff ; move.w (a1),d0
- bra 0f
-ads_z: mov (sp)+,d0
-0: checksize
-4: move.l (sp)+,d1 ; add.l d1,(sp) ; jmp (a4)
-2: move.w (sp)+,d1 ; ext.l d1
- add.l d1,(sp) ; jmp (a4)
-ads_1W: mov (sp)+,d0
-#ifndef lword
- ext.l d0
-#endif
- add.l d0,(sp); jmp (a4)
-sbs_l: adroff ; move.w (a1),d0
- bra 0f
-sbs_z: mov (sp)+,d0 !d0 contains objectsize
-0: checksize
-4: move.l (sp)+,d1 ; sub.l d1,(sp)
- jmp (a4)
-2: move.l (sp)+,d1 ; sub.l d1,(sp)
- clr.w (sp)+ ; jmp (a4)
+++ /dev/null
-!----------------------------------------------------------------------------
-! CLEARS , INCREMENTS , DECREMENTS
-!-----------------------------------------------------------------------------
-
-inc_z: move.l sp,a0
-4:
-#if test
- comp und,(a0)
- bne 3f ; bsr e_iund
-3:
-#endif
- ad #1,(a0) ; bvs 9f
- jmp (a4)
-#ifdef lword
-inl__1W: move.l a2,a0 ; sub.l #4,a0 ; bra 4b
-inl__2W: move.l a2,a0 ; sub.l #8,a0 ; bra 4b
-inl__3W: move.l a2,a0 ; sub.l #12,a0 ; bra 4b
-#else
-inl__1W: move.l a2,a0 ; sub.l #2,a0 ; bra 4b
-inl__2W: move.l a2,a0 ; sub.l #4,a0 ; bra 4b
-inl__3W: move.l a2,a0 ; sub.l #6,a0 ; bra 4b
-#endif
-inl_w_1: move.l #-1,d0 ; move.b (a3)+,d0
-2: asl.l wmu,d0
-1: move.l a2,a0 ; add.l d0,a0 ; bra 4b
-inl_pw: adroff ; move.w (a1),d0
-6: asl.l wmu,d0 ; add.l #16,d0
- bra 1b
-inl_qpw: move.l (sp)+,d0 ; bra 6b
-inl_nw: adroff ; move.w (a1),d0
- ext.l d0 ; bra 2b
-inl_qnw: move.l (sp)+,d0 ; bra 2b
-ine_lw: adroff ; move.w (a1),d0 ; bra 5f
-ine_qw: move.l (sp)+,d0 ; bra 5f
-ine_w0: clr.w d0 ; move.b (a3)+,d0
-5: asl.l wmu,d0 ; move.l d0,a0
- add.l a6,a0 ; bra 4b
-
-!---------------------------------------------------------------------------
-
-dec_z: move.l sp,a0
-4:
-#if test
- !let op , test gebruikt voor tst?
- comp und,(a0) ;bne 3f
- bsr e_iund
-3:
-#endif
- subt #1,(a0) ; bvs 9f
- jmp (a4)
-del_w_1: move.l #-1,d0 ; move.b (a3)+,d0
-1: asl.l wmu,d0
-2: move.l a2,a0 ; add.l d0,a0 ; bra 4b
-del_pw: adroff ; move.w (a1),d0
-5: asl.l wmu,d0 ; add.l #16,d0 ; bra 2b
-del_qpw: move.l (sp)+,d0 ; bra 5b
-del_nw: adroff ; move.w (a1),d0
- ext.l d0 ; bra 1f
-del_qnw: move.l (sp)+,d0 ; bra 1f
-dee_w0: clr.w d0 ; move.b (a3)+,d0
-0: asl.l wmu,d0 ; move.l d0,a0
- add.l a6,a0 ; bra 4b
-dee_lw: adroff ; move.w (a1),d0 ; bra 0b
-dee_qw: move.l (sp)+,d0 ; bra 0b
-
-9: bsr e_iovfl !error routine for integer overflow
- jmp (a4)
-
-!----------------------------------------------------------------------------
-
-zrl__1W: cl l_1(a2) ; jmp (a4)
-zrl__2W: cl l_2(a2) ; jmp (a4)
-zrl_w_1: move.l #-1,d0 ; move.b (a3)+,d0
-1: asl.l wmu,d0 ; cl 0(a2,d0)
- jmp (a4)
-zrl_nw: adroff ; move.w (a1),d0
- ext.l d0 ; bra 1b
-zrl_qnw: move.l (sp)+,d0 ; bra 1b
-zrl_pw: adroff ; move.w (a1),d0
-2: asl.l wmu,d0 ; cl 16(a2,d0)
- jmp (a4)
-zrl_qpw: move.l (sp)+,d0 ; bra 2b
-zre_lw: adroff ; move.w (a1),d0 ; bra 7f
-zre_qw: move.l (sp)+,d0 ; bra 7f
-zre_w0: clr.w d0 ; move.b (a3)+,d0
-7: asl.l wmu,d0 ; cl 0(a6,d0)
- jmp (a4)
-zrf_l: adroff ; move.w (a1),d0 ; bra 8f
-zrf_z: mov (sp)+,d0
-8: move.l d7,d1
-3: asr.w #1,d0 ; dbcs d1,3b
- bcs e_oddz ; sub.w #1,d0
-0: cl -(sp) ; dbra d0,0b
- jmp (a4)
-zer_s0: clr.w d0 ; move.b (a3)+,d0 ; bra 8b
-zer_l: adroff ; move.w (a1),d0 ; bra 8b
-zer_z: mov (sp),d0 ; bra 8b
-! The test on illegal argument takes some time , specially in 4byte case.
-
-!-----------------------------------------------------------------------
-! LOGICAL GROUP
-!-------------------------------------------------------------------------
-
-and_1W: mov (sp)+,d1
- an d1,(sp)
- jmp (a4)
-and_l: adroff ; move.w (a1),d0 ; bra 1f
-and_z: mov (sp)+,d0
-1: ble e_oddz ; move.l d0,a0
- move.l d7,d2
-2: asr.l #1,d0 ; dbcs d2,2b ; bcs e_oddz
- add.l sp,a0 ; sub.l #1,d0
-3: mov (sp)+,d1; an d1,(a0)+
- dbra d0,3b ; jmp (a4)
-
-!------------------------------------------------------------------------------
-
-ior_1W: mov (sp)+,d1; inor d1,(sp)
- jmp (a4)
-ior_s0: clr.w d0 ; move.b (a3)+,d0; bra 4f
-ior_l: adroff ; move.w (a1),d0 ; bra 4f
-ior_z: mov (sp)+,d0
-4: ble e_oddz ; move.l d0,a0
- move.l d7,d2
-5: asr.l #1,d0 ; dbcs d2,5b ; bcs e_oddz
- add.l sp,a0 ; sub.l #1,d0
- move.l d6,d1
-3: mov (sp)+,d1
- inor d1,(a0)+; dbra d0,3b
- jmp (a4)
-
-!----------------------------------------------------------------------------
-
-xor_l: adroff ; move.w (a1),d0 ; bra 6f
-xor_z: mov (sp)+,d0
-6: ble e_oddz ; move.l d0,a0
- move.l d7,d2
-8: asr.l #1,d0 ; dbcs d2,8b ; bcs e_oddz
- add.l sp,a0 ; sub.l #1,d0
-7: mov (sp)+,d1
- exor d1,(a0)+; dbra d0,7b
- jmp (a4)
-
-!----------------------------------------------------------------------------
-
-com_l: adroff ; move.w (a1),d0 ; bra 0f
-com_z: mov (sp)+,d0
-0: ble e_oddz ; move.l d7,d2
-1: asr.l #1,d0 ; dbcs d2,1b ; bcs e_oddz
- move.l sp,a0 ; sub.l #1,d0
-2: nt (a0)+ ; dbra d0,2b
- jmp (a4)
-
-!---------------------------------------------------------------------------
-
-rol_l: adroff ; move.w (a1),d0 ; bra 3f
-rol_z: mov (sp)+,d0
-3: ble e_oddz ; move.l d7,d2
-4: asr.l #1,d0 ; dbcs d2,4b
- bcs e_oddz
- sub.l #1,d0
- mov (sp)+,d1
- bmi 2f
-0: move.l sp,a0 !d0 = #words-1 , d1 = shift count
-5: mov (a0),d2 ; rotl d1,d2
- mov d2,(a0)+; dbra d0,5b
- jmp (a4)
-2: nega d1 ; bra 0f
-2: nega d1 ; bra 0b
-ror_l: adroff ; move.w (a1),d0 ; bra 6f
-ror_z: mov (sp)+,d0
-6: ble e_oddz ; move.l d7,d2
-7: asr.l #1,d0 ; dbcs d2,7b
- bcs e_oddz ; sub.l #1,d0
- mov (sp)+,d1
- bmi 2b
-0: move.l sp,a0
-8: mov (a0),d2 ; rotr d1,d2
- mov d2,(a0)+; dbra d0,8b
- jmp (a4)
-
-!-----------------------------------------------------------------------------
-! SET GROUP
-!------------------------------------------------------------------------------
-
-set_s0: clr.w d0 ; move.b (a3)+,d0
-0: ble e_oddz ; clr.l d1
- mov (sp)+,d1; move.l d0,d2
- move.l d7,d3
-1: asr.l #1,d2 ; dbcs d3,1b
- bcs e_oddz ; sub.l #1,d2
-2: cl -(sp) ; dbra d2,2b
- move.l sp,a0 ; move.l d1,d2
- asr.l #3,d2 ; cmp.l d0,d2 !d2 byte number
- bmi 3f ; bsr e_set
- jmp (a4)
-3:
-#ifdef lword
- bchg #1,d2 !0->3,1->2
-#endif
- bchg #0,d2 ; add.l d2,a0
- bset d1,(a0) ; jmp (a4) !d1 mod 8 bit set
-set_l: adroff ; move.w (a1),d0 ; bra 0b
-set_z: mov (sp)+,d0; bra 0b
-
-!----------------------------------------------------------------------------
-
-inn_s0: clr.w d0 ; move.b (a3)+,d0
-0: ble e_oddz
- move.l d6,d1 ; mov (sp)+,d1
- btst #0,d0 ; bne e_oddz
-#ifdef lword
- btst #1,d0 ; bne e_oddz
-#endif
- move.l sp,a0 ; add.l d0,sp
- move.l d1,d2 ; asri #3,d2
- comp d2,d0 ; bhi 3f
- cl -(sp)
-!#if test
-! bsr e_set
-!#endif
- jmp (a4)
-3:
-#ifdef lword
- bchg #1,d2
-#else
- ext.l d2
-#endif
- bchg #0,d2 ; add.l d2,a0
- btst d1,(a0) ; beq 7f
- mov #1,-(sp); jmp (a4)
-7: cl -(sp) ; jmp (a4)
-inn_l: adroff ; move.w (a1),d0 ; bra 0b
-inn_z: mov (sp)+,d0; bra 0b
-
-
+++ /dev/null
-!-----------------------------------------------------------------------------.
-! ARRAY GROUP
-!-------------------------------------------------------------------------------
-!subroutine
-calcarr: move.l (sp)+,d3 !save return address
- move.l (sp)+,a0 !address of array describtor
- mov (sp)+,d0 !index
- subt (a0)+,d0 !relative address
- blt 9f
- comp (a0)+,d0 !check upper bound
- bgt 9f
- move.l #0,d1
- mov (a0),d1
- mulu d1,d0 !objectsize in d1
- move.l (sp)+,a0
- ad d0,a0 !a0 address of array element
- move.l d3,-(sp)
- rts
-9: bsr e_array ;tst.l (sp)+ ; jmp (a4)
-
-aar_1W: bsr calcarr ; move.l a0,-(sp)
- jmp (a4)
-aar_l: adroff ; cmp.w wrd,(a1)
-0: bne e_illins ; bra aar_1W
-aar_z: comp wrd,(sp)+ ; bra 0b
-
-lar_1W: bsr calcarr ; add.l d1,a0
- asr.w #1,d1 ; bcc 5f
- clr.l d1 ; move.b -(a0),d1
- mov d1,-(sp); jmp (a4)
-5:
-#ifdef lword
- asr.w #1,d1 ; bcc 6f
- move.w -(a0),d1; move.l d1,-(sp)
- jmp (a4)
-#endif
-6: sub.l #1,d1
-7: mov -(a0),-(sp); dbra d1,7b
- jmp (a4)
-
-lar_l: adroff ; cmp.w wrd,(a1)
-8: bne e_illins; bra lar_1W
-lar_z: comp wrd,(sp)+ ; bra 8b
-
-sar_1W: bsr calcarr ; asr.w #1,d1
- bcc 5f ; testen (sp)+
- move.b -1(sp),(a0); jmp (a4)
-5:
-#ifdef lword
- asr.w #1,d1 ; bcc 6f
- tst.w (sp)+ ; move.w (sp)+,(a0)
- jmp (a4)
-#endif
-6: sub.l #1,d1
-7: mov (sp)+,(a0)+ ; dbra d1,7b
- jmp (a4)
-sar_z: comp wrd,(sp)+ ; bra 1f
-sar_l: adroff ; cmp.w wrd,(a1)
-1: bne e_illins ; bra sar_1W
-
-!-------------------------------------------------------------------------
-! CONVERT GROUP
-!-------------------------------------------------------------------------w
-
-cii_z: mov (sp)+,d0 ; mov (sp)+,d1 ; !d0 destination size
- !d1 source size
-#if test
- cmp.w wrd,d1 ; bne 0f
- comp und,(sp) ; bne 0f
- bsr e_iund
-#endif
-0: cmp.w d0,d1 ; bne 1f ; jmp (a4)
-1: bge 6f ; mov (sp)+,d2
- cmp.w #1,d1 ; bne 3f !d1<d0
- ext.w d2
-#ifndef lword
- cmp.w #2,d0 ; bne 3f
- move.w d2,-(sp); jmp (a4)
-#endif
-3: ext.l d2 ; move.l d2,-(sp); jmp (a4)
-6:
-#ifdef lword
- bsr e_conv ; add.l #4,sp
-#else
- move.w (sp)+,d2
-#if test
- bne 7f ; tst.w (sp) ; bge 9f
-8: bsr e_conv ; jmp (a4)
-7: comp #-1,d2 ; bne 8b
- tst.w (sp) ; bge 8b
-#endif
-#endif
-9: jmp (a4)
-
-cui_z: mov (sp)+,d0 ; mov (sp)+,d1
- sub.w d1,d0 ; bne 2f
-#if test
- testen (sp) ; bpl 1f
-0: bsr e_conv
-#endif
-1: jmp (a4)
-2:
-#ifdef lword
- sub.l d0,sp ; bsr e_conv
-#else
- bgt 3f ; cmp.w #-2,d0 ; beq 5f
- bsr e_conv
-#if test
- tst.w (sp) ; bne 0b
- tst.w 2(sp) ; bmi 0b
-#endif
-5: sub.l #-2,sp ; jmp (a4)
-3: cmp.w #2,d0 ; beq 4f
- bsr e_conv
-4: clr.w -(sp)
-#endif
- jmp (a4)
-
-ciu_z: mov (sp)+,d0 ; mov (sp)+,d1
-#if test
- cmp.w wrd,d1 ; bne 0f
- comp und,(sp) ; bne 0f
- bsr e_iund
-#endif
-0: sub.w d1,d0 ; bne 1f
- jmp (a4)
-#ifndef lword
-1: bgt 4f ; cmp.w #-2,d0
- beq 5f ; bsr e_conv
-5:
-#if test
- move.w (sp),d1 ; beq 6f
- not.w d1 ; beq 6f
- bsr e_conv
-#endif
-6: add.l #2,sp ; jmp (a4)
-#endif
-4: 1: bclr #0,d0 ; beq 2f
-#ifdef lword
- clr.b 2(sp)
-#else
- clr.b (sp)
-#endif
-2: bclr #1,d0 ; beq 3f
-#ifdef lword
- clr.w (sp)
-#else
- clr.w -(sp)
-#endif
-3: jmp (a4)
-
-cuu_z: mov (sp)+,d0 ; mov (sp)+,d1
- sub.w d1,d0 ; bne 1f
- jmp (a4)
-1:
-#ifdef lword
- bsr e_conv ; sub.l d0,sp
-#else
- blt 3f
-#if test
- cmp.w #2,d0 ; beq 2f
- bsr e_conv
-#endif
-2: clr.w -(sp) ; jmp (a4)
-3:
-#if test
- cmp.w #-2,d0 ; beq 4f
- bsr e_conv
-#endif
-4: tst.w (sp)+
-#if test
- beq 5f ; bsr e_conv
-#endif
-#endif
-5: jmp (a4)
-
-!--------------------------------------------------------------------------
-cuf_z: cfu_z: cff_z: cfi_z: cif_z:
- mov (sp)+,d0 ; subt (sp)+,d0
- ext.l d0
- sub.l d0,sp
-#ifdef FLTRAP
- bra flnim !floating point not implemented
-#else
- jmp (a4)
-#endif
+++ /dev/null
-!----------------------------------------------------------------------------
-! SIGNED INTEGER ARITHMETIC
-!------------------------------------------------------------------------------
-
-adi_l: adroff ; move.w (a1),d0 ; bra 1f
-adi_z: mov (sp)+,d0
-1: sub.w wrd,d0 ; beq adi_1W
- sub.w wrd,d0 ; beq adi_2W
- bra e_oddz
-adi_1W:
-#if test
- comp und,(sp) ; beq 6f
- comp und,word(sp); bne 7f
-6: bsr e_iund
-#endif
-7: mov (sp)+,d0 ; ad d0,(sp)
-#if test
- bvs 9f
-#endif
- jmp (a4)
-adi_2W:
-#ifdef lword
- bsr no8bar ; add.l #8,sp
- jmp (a4)
-#else
- move.l (sp)+,d0 ; add.l d0,(sp)
-#endif
-#if test
- bvs 9f
-#endif
- jmp (a4)
-
-!--------------------------------------------------------------------------
-
-sbi_z: mov (sp)+,d0 ; bra 1f
-sbi_l: adroff ; move.w (a1),d0
-1: sub.w wrd,d0 ; beq sbi_1W
- sub.w wrd,d0 ; beq sbi_2W
- bra e_oddz
-sbi_1W:
-#if test
- comp und,(sp) ; beq 6f
- comp und,word(sp) ; bne 7f
-6: bsr e_iund
-#endif
-7: mov (sp)+,d0 ; subt d0,(sp)
-#if test
- bvs 9f
-#endif
- jmp (a4)
-sbi_2W:
-#ifdef lword
- add.l #8,sp ; bsr no8bar
- jmp (a4)
-#else
- move.l (sp)+,d0 ; sub.l d0,(sp)
-#endif
-#if test
- bvs 9f
-#endif
- jmp (a4)
-9: bsr e_iovfl ; jmp (a4)
-
-!----------------------------------------------------------------------------
-
-mli_z: mov (sp)+,d0 ; bra 0f
-mli_l: adroff ; move.w (a1),d0
-0: sub.w wrd,d0 ; beq mli_1W
- sub.w wrd,d0 ; beq mli_2W
- bra e_oddz
-mli_1W: mov (sp)+,d0
-#if test
- comp und,d0 ; beq 1f
- comp und,(sp) ; bne 2f
-1: bsr e_iund
-#endif
-2:
-#ifdef lword
- move.l (sp)+,d1 ; bra 4f
-#else
- muls (sp),d0 ; move.w d0,(sp)
-#if test
- bpl 3f ; not.l d0
-3: swap d0 ; tst.w d0 ; bne 9b
-#endif
- jmp (a4)
-#endif
-mli_2W:
-#ifdef lword
- bsr no8bar ; add.l #4,sp
- move.l (sp)+,d0 ; add.l #4,sp
- move.l (sp)+,d1
-#else
- move.l (sp)+,d0 ; move.l (sp)+,d1
-#endif
-4: clr.w d5 ; tst.l d0 ; bpl 5f
- neg.l d0 ; not.w d5
-5: tst.l d1 ; bpl 6f
- neg.l d1 ; not.w d5
-6: bsr mlu4
-#if test
- tst.l d4 ; bne 7f
- tst.l d0 ; bpl 8f
-7: bsr e_iovfl
-#endif
-8: tst.w d5 ; beq 0f
- neg.l d0
-0: move.l d0,-(sp)
-!next 4 lines only in case 8 byte arithmetic
-!#ifdef lword
-! bmi 1f ; clr.l -(sp) ; bra 2f
-!1: move.l #-1,-(sp)
-!#endif
-2: jmp (a4)
-
-!subroutine for unsigned 4byte multiplication . Expects multiplier in d0 and
-! multiplicant in d1 . Returns 4 byte result in d0 . If d4=0 overflow did
-! not occur on the multiplication , else it did .
-
- .define mlu4
- .text
-
-mlu4: move.l d1,d3 ; move.l d0,d2
- swap d2 ; swap d3
-#if test
- move.l d3,d4 ; mulu d2,d4
-#endif
- mulu d0,d3 ; swap d3
- mulu d1,d2 ; swap d2
-#if test
- or.w d3,d4 ; or.w d2,d4
-#endif
- clr.w d3 ; clr.w d2
- mulu d1,d0 ; add.l d3,d0
-#if test
- bvc 1f ; bset #0,d4
-#endif
-1: add.l d2,d0
-#if test
- bvc 2f ; bset #0,d4
-#endif
-2: rts
-
-!---------------------------------------------------------------------------
-
-dvi_z: mov (sp)+,d0 ; bra 0f
-dvi_l: adroff ; move.w (a1),d0
-0: sub.w wrd,d0 ; beq dvi_1W
- sub.w wrd,d0 ; beq dvi_2W
- bra e_oddz
-dvi_1W:
-#ifdef lword
- bsr dvi4 ; move.l d1,-(sp)
-#else
- bsr dvi2 ; move.w d1,-(sp)
-#endif
- jmp (a4)
-dvi_2W:
-#ifdef lword
- bsr no8bar ; tst.l (sp)+
- move.l (sp)+,(sp) ; bsr dvi4
- move.l d1,-(sp) ; clr.l -(sp)
-#else
- bsr dvi4 ; move.l d1,-(sp)
-#endif
- jmp (a4)
-
-rmi_z: mov (sp)+,d0 ; bra 1f
-rmi_l: adroff ; move.w (a1),d0
-1: sub.l wrd,d0 ; beq rmi_1W
- sub.l wrd,d0 ; beq rmi_2W
- bra e_oddz
-rmi_1W:
-#ifdef lword
- bsr dvi4 ; move.l d3,-(sp)
-#else
- bsr dvi2 ; swap d1
- move.w d1,-(sp)
-#endif
- jmp (a4)
-rmi_2W:
-#ifdef lword
- bsr no8bar ; tst.l (sp)+
- move.l (sp)+,(sp) ; bsr dvi4
- move.l d3,-(sp) ; clr.l -(sp)
-#else
- bsr dvi4 ; move.l d3,-(sp)
-#endif
- jmp (a4)
-
-! 2byte division . In d1: quotient=low word ; remainder=high word
-dvi2: move.l (sp)+,d2
- move.w (sp)+,d0 !divisor
- move.w (sp)+,d1 ; ext.l d1 !dividend
-#if test
- cmp.w und,d1 ; bne 1f
- bsr e_iund
-1: cmp.w und,d0 ; bne 2f
- bsr e_iund
-2: tst.w d0 ; bne 3f
- bsr e_idivz ; move.l und,d1 ; bra 4f
-3:
-#endif
- divs d0,d1
-4: move.l d2,-(sp) ; rts
-
-! long signed division . quotient in d1 , remainder in d3
-dvi4: move.l (sp)+,d5
- move.l (sp)+,d0 !divisor
- move.l (sp)+,d1 !dividend
-#ifdef lword
- cmp.l und,d0 ; beq 0f
- cmp.l und,d1 ; bne 1f
-0: bsr e_iund
-1:
-#endif
- clr.l d4 !sign in d4
- tst.l d0 ; bpl 1f
- neg.l d0 ; not.w d4
-1: tst.l d1 ; bpl 2f
- neg.l d1
- not.w d4 ; swap d4
- not.w d4 ; swap d4
-2: bsr dvu4
- tst.w d4 ; beq 3f
- neg.l d1 !quotient
-3: tst.l d4 ; bpl 4f
- neg.l d3 !remainder
-4: move.l d5,-(sp) ; rts
-
-!Expects d0 divisor , d1 dividend. Gives d1 quotient ,d3 remainder
-
- .define dvu4
- .text
-dvu4:
-#if test
- tst.l d0 ; bne 1f
- bsr e_idivz
-1:
-#endif
- clr.l d3 ; move.l #32,d2
-3: lsl.l #1,d1 ; roxl.l #1,d3
- cmp.l d0,d3 ; blt 4f
- sub.l d0,d3 ; add.l #1,d1
-4: sub.w #1,d2 ; bgt 3b
- rts
-
-!----------------------------------------------------------------------------
-
-ngi_z: mov (sp)+,d0 ; bra 0f
-ngi_l: adroff ; move.w (a1),d0
-0: sub.l wrd,d0 ; bne 2f
-#if test
- comp und,(sp) ; bne 1f
- bsr e_iund
-1:
-#endif
- nega (sp) ; jmp (a4)
-2: cmp.l wrd,d0 ; beq 3f
- bra e_oddz
-3:
-#ifdef lword
- bsr no8bar ; not.l (sp)
- neg.l 4(sp)
-#else
- neg.l (sp)
-#endif
-#if test
- bvc 4f ; bsr e_iovfl
-4:
-#endif
- jmp (a4)
-
-!--------------------------------------------------------------------------
-
-sli_z: mov (sp)+,d0 ; bra 0f
-sli_l: adroff ; move.w (a1),d0
-0: sub.w wrd,d0 ; beq sli_1W
- sub.w wrd,d0 ; beq sli2
- bra e_oddz
-sli_1W: mov (sp)+,d0 !d0 contains the shift count
- bmi 5f
-9: mov (sp)+,d1 !integer to shift
-#if test
- comp und,d0 ; bne 1f
- bsr e_iund
-1:
-#endif
- asle d0,d1 ! ASLE
-#if test
- bvc 2f ; bsr e_iovfl
-2:
-#endif
- mov d1,-(sp) ; jmp (a4)
-sli2:
-#ifdef lword
- bsr no8bar ; move.l (sp)+,d1
- move.l (sp)+,d2 ; move.l (sp)+,d0
-3: asl.l #1,d0 ; roxl.l #1,d2
- sub.l #1,d1 ; bgt 3b
- move.l d0,-(sp) ; move.l d2,-(sp)
-#else
- move.w (sp)+,d0
- bmi 6f
-8: move.l (sp),d1
- asl.l d0,d1
-#if test
- bvc 4f ; bsr e_iovfl
-4:
-#endif
- move.l d1,(sp)
-#endif
- jmp (a4)
-5: nega d0 ; bra 8f
-#ifndef lword
-6: neg.w d0 ; bra 9f
-#endif
-
-!------------------------------------------------------------------------------
-7: nega d0 ; bra 9b
-#ifndef lword
-6: neg.w d0 ; bra 8b
-#endif
-
-sri_z: mov (sp)+,d0 ; bra 0f
-sri_l: adroff ; move.w (a1),d0
-0: sub.w wrd,d0 ; bne sri2
- mov (sp)+,d0
- bmi 7b
-8: mov (sp)+,d1
-#if test
- comp und,d0 ; bne 1f
- bsr e_iund
-1:
-#endif
- asri d0,d1
-#if test
- bvc 2f ; bsr e_iovfl
-2:
-#endif
- mov d1,-(sp) ; jmp (a4)
-sri2: sub.w wrd,d0 ; beq 3f
- bra e_oddz
-3:
-#ifdef lword
- bsr no8bar ; move.l (sp)+,d1
- move.l (sp)+,d2 ; move.l (sp),d0
- sub.l #1,d1
-4: asr.l #1,d2 ; roxr.l #1,d0 ; dbra d1,4b
- move.l d0,(sp) ; move.l d2,-(sp)
-#else
- move.w (sp)+,d0
- bmi 6b
-9: move.l (sp),d1
- asr.l d0,d1
-#if test
- bvc 5f ; bsr e_iovfl
-5:
-#endif
- move.l d1,(sp)
-#endif
- jmp (a4)
+++ /dev/null
-!------------------------------------------------------------------------------
-! UNSIGNED ARITHMETIC
-!-----------------------------------------------------------------------------
-
-adu_z: mov (sp)+,d0 ; bra 0f
-adu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d1 ; add.w d1,(sp)
- jmp (a4)
-4: move.l (sp)+,d1; add.l d1,(sp)
- jmp (a4)
-
-sbu_z: mov (sp)+,d0 ; bra 0f
-sbu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d1 ; sub.w d1,(sp)
- jmp (a4)
-4: move.w (sp)+,d1 ; sub.l d1,(sp)
- jmp (a4)
-
-!------------------------------------------------------------------------------
-
-mlu_z: mov (sp)+,d0 ; bra 0f
-mlu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d0 ; mulu (sp),d0
- move.w d0,(sp) ; jmp (a4)
-4: move.l (sp)+,d0 ; move.l (sp),d1
- bsr mlu4 ; move.l d0,(sp)
- jmp (a4)
-
-!----------------------------------------------------------------------------
-
-dvu_z: mov (sp)+,d0 ; bra 0f
-dvu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d1 ; beq 3f
- move.w (sp),d0 ; divu d1,d0
- move.w d0,(sp) ; jmp (a4)
-3: bsr e_idivz ; move.w #-1,(sp)
- jmp (a4)
-4: move.l (sp)+,d0 ; move.l (sp),d1
- bsr dvu4 ; move.l d1,(sp)
- jmp (a4)
-
-!----------------------------------------------------------------------------
-
-rmu_z: mov (sp)+,d0 ; bra 0f
-rmu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d1 ; beq 3f
- move.w (sp),d0 ; divu d1,d0
- swap d0 ; move.w d0,(sp)
- jmp (a4)
-3: bsr e_idivz ; clr.w (sp)
- jmp (a4)
-4: move.l (sp)+,d0 ; move.l (sp),d1
- bsr dvu4 ; move.l d3,(sp)
- jmp (a4)
-
-!------------------------------------------------------------------------.
-
-slu_z: mov (sp)+,d0 ; bra 0f
-slu_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d0
- bmi 7f
-3: move.w (sp),d1
- lsl.w d0,d1 ; move.w d1,(sp)
- jmp (a4)
-4: mov (sp)+,d0
- bmi 9f
-5: move.l (sp),d1
- lsl.l d0,d1 ; move.l d1,(sp)
- jmp (a4)
-
-7: neg.w d0 ; bra 3f
-9: nega d0 ; bra 5f
-7: neg.w d0 ; bra 3b
-9: nega d0 ; bra 5b
-
-sru_z: mov (sp)+,d0 ; bra 0f
-sru_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d0
- bmi 7b
-3: move.w (sp),d1
- lsr.w d0,d1 ; move.w d1,(sp)
- jmp (a4)
-4: mov (sp)+,d0
- bmi 9b
-5: move.l (sp),d1
- lsr.l d0,d1 ; move.l d1,(sp)
- jmp (a4)
-
-!------------------------------------------------------------------------------
-! DUMMY FLOATING POINT ROUTINES
-!------------------------------------------------------------------------------
-adf_l: sbf_l: mlf_l: dvf_l:
- adroff ; move.w (a1),d0
-1: add.l d0,sp
-#ifdef FLTRAP
- bra flnim
-#else
- jmp (a4)
-#endif
-adf_z: sbf_z: mlf_z: dvf_z:
- mov (sp)+,d0 ; bra 1b
-adf_s0: sbf_s0: mlf_s0: dvf_s0:
- move.l #0,d0 ; move.b (a3)+,d0
- bra 1b
-fef_l: sub.l wrd,sp
-fif_l: ngf_l: adroff
-fef_z:
-#ifdef FLTRAP
- bra flnim
-#else
- jmp (a4)
-#endif
-ngf_z: fif_z: add.l wrd,sp ; bra fef_z
+++ /dev/null
-!-------------------------------------------------------------------------
-! TEST AND BRANCH GROUP
-!-------------------------------------------------------------------------
-
-tlt_z: testen (sp)+ ; blt true ; cl -(sp) ; jmp (a4)
-tle_z: testen (sp)+ ; ble true ; cl -(sp) ; jmp (a4)
-teq_z: testen (sp)+ ; beq true ; cl -(sp) ; jmp (a4)
-tne_z: testen (sp)+ ; bne true ; cl -(sp) ; jmp (a4)
-tge_z: testen (sp)+ ; bge true ; cl -(sp) ; jmp (a4)
-tgt_z: testen (sp)+ ; bgt true ; cl -(sp) ; jmp (a4)
-
-true: mov #1,-(sp) ; jmp (a4)
-
-zlt_s0: testen (sp)+ ; blt bra_s0 ; bra nobr2
-zlt_l: testen (sp)+ ; blt bra_l ; bra nobr3
-zlt_q: move.l (sp)+,d0
- testen (sp)+ ; blt 1f ; jmp (a4)
-zle_s0: testen (sp)+ ; ble bra_s0 ; bra nobr2
-zle_l: testen (sp)+ ; ble bra_l ; bra nobr3
-zle_q: move.l (sp)+,d0
- testen (sp)+ ; ble 1f ; jmp (a4)
-zeq_s0: testen (sp)+ ; beq bra_s0 ; bra nobr2
-zeq_s1: testen (sp)+ ; beq bra_s1 ; bra nobr2
-zeq_l: testen (sp)+ ; beq bra_l ; bra nobr3
-zeq_q: move.l (sp)+,d0
- testen (sp)+ ; beq 1f ; jmp (a4)
-zne_s0: testen (sp)+ ; bne bra_s0 ; bra nobr2
-zne_s_1: testen (sp)+ ; bne bra_s_1 ; bra nobr2
-zne_l: testen (sp)+ ; bne bra_l ; bra nobr3
-zne_q: move.l (sp)+,d0
- testen (sp)+ ; bne 1f ; jmp (a4)
-zge_s0: testen (sp)+ ; bge bra_s0 ; bra nobr2
-zge_l: testen (sp)+ ; bge bra_l ; bra nobr3
-zge_q: move.l (sp)+,d0
- testen (sp)+ ; bge 1f ; jmp (a4)
-zgt_s0: testen (sp)+ ; bgt bra_s0 ; bra nobr2
-zgt_l: testen (sp)+ ; bgt bra_l ; bra nobr3
-zgt_q: move.l (sp)+,d0
- testen (sp)+ ; bgt 1f ; jmp (a4)
-
-blt_s0: comp (sp)+,(sp)+ ; blt bra_s0 ; bra nobr2
-blt_l: comp (sp)+,(sp)+ ; blt bra_l ; bra nobr3
-blt_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; blt 1f ; jmp (a4)
-ble_s0: comp (sp)+,(sp)+ ; ble bra_s0 ; bra nobr2
-ble_l: comp (sp)+,(sp)+ ; ble bra_l ; bra nobr3
-ble_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; ble 1f ; jmp (a4)
-beq_s0: comp (sp)+,(sp)+ ; beq bra_s0 ; bra nobr2
-beq_l: comp (sp)+,(sp)+ ; beq bra_l ; bra nobr3
-beq_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; beq 1f ; jmp (a4)
-bne_s0: comp (sp)+,(sp)+ ; bne bra_s0 ; bra nobr2
-bne_l: comp (sp)+,(sp)+ ; bne bra_l ; bra nobr3
-bne_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; bne 1f ; jmp (a4)
-bge_s0: comp (sp)+,(sp)+ ; bge bra_s0 ; bra nobr2
-bge_l: comp (sp)+,(sp)+ ; bge bra_l ; bra nobr3
-bge_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; bge 1f ; jmp (a4)
-bgt_s0: comp (sp)+,(sp)+ ; bgt bra_s0 ; bra nobr2
-bgt_l: comp (sp)+,(sp)+ ; bgt bra_l ; bra nobr3
-bgt_q: move.l (sp)+,d0
- comp (sp)+,(sp)+ ; bgt 1f ; jmp (a4)
-
-bra_s0:
- move.l d6,d0
-0: move.b (a3)+,d0
-1: add.l d0,a3 ; jmp (a4)
-bra_l: move.b (a3)+,-(sp) ; move.b (a3)+,1(sp)
- move.w (sp)+,d0 ; ext.l d0
- bra 1b
-bra_q:
- move.l (sp)+,d0 ; bra 1b
-bra_s1: move.w #0x100,d0 ; bra 0b
-bra_s_1: move.l #-1,d0 ; bra 0b
-bra_s_2: move.l #-0x200,d0 ; bra 0b
-nobr2: add.l #1,a3 ; jmp (a4)
-nobr3: add.l #2,a3 ; jmp (a4)
-
-!---------------------------------------------------------------------------
-! COMPARE GROUP
-!-----------------------------------------------------------------------------
-
-cmi_z: mov (sp)+,d0 ; bra 0f
-cmi_l: adroff ; move.w (a1),d0
-0: sub.w wrd,d0 ; beq cmi_1W
- sub.w wrd,d0 ; beq cmi_2W
- bra e_oddz
-cmi_1W: comp (sp)+,(sp)+ ; bgt 1f ; beq 2f
-3: mov #-1,-(sp) ; jmp (a4)
-1: mov #1,-(sp) ; jmp (a4)
-2: cl -(sp) ; jmp (a4)
-cmi_2W:
-#ifdef lword
- bsr no8bar ; bra e_oddz
-#endif
- cmp.l (sp)+,(sp)+ ; blt 3b ; beq 2b
- bra 1b
-
-cmu_z: mov (sp)+,d0 ; bra 4f
-cmu_l: adroff ; move.w (a1),d0
-4: sub.w wrd,d0 ; bne 5f
- comp (sp)+,(sp)+ ; bcs 3b
- beq 2b ; bra 1b
-5: sub.w wrd,d0 ; bne e_oddz
-#ifdef lword
- bsr no8bar ; bra e_oddz
-#endif
-cmp_z: cmp.l (sp)+,(sp)+ ; bcs 3b
- beq 2b ; bra 1b
-
-cms_l: adroff ; move.w (a1),d0
- bra 0f
-cms_z: mov (sp)+,d0 ; bra 0f
-cms_s0: move.l d6,d0 ; move.b (a3)+,d0
-0: move.l d0,d1 ; move.l sp,a0
- asri wmu,d1 ; subt #1,d1
- add.l d0,sp ; move.l sp,d2
-1: comp (a0)+,(sp)+ ; bne 2f
- dbra d1,1b
- mov d6,-(sp) ; jmp (a4)
-2: add.l d0,d2 ; move.l d2,sp
- move.l #1,d1 ; mov d1,-(sp)
- jmp (a4)
-
-
-! DUMMY FLOAT ROUTINES. POINTER ADJUSTMENT AND WARNING
-
-cmf_s0: move.l d6,d0 ; move.b (a3)+,d0
-9: add.w d0,d0 ; add.l d0,sp
- cl -(sp)
-#ifdef FLTRAP
- bra flnim
-#else
- jmp (a4)
-#endif
-cmf_l: adroff ; move.w (a1),d0 ; bra 9b
-cmf_z: mov (sp)+,d0 ; bra 9b
-
-!-------------------------------------------------------------------------
-! CALL AND RETURN GROUP
-!----------------------------------------------------------------------------
-
-cai_z: move.l (sp)+,d0 ; bra 1f
-cal_q: move.l (sp)+,d0 ; bra 1f
-cal_l: adroff ; move.w (a1),d0 ; bra 1f
-cal_s0: move.w d6,d0 ; move.b (a3)+,d0 ; bra 1f
-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:
- asr.w #2,d0 ; sub.w #0x3F,d0
-lblcal:
-1: cmp.l nproc,d0 ; bhi e_badpc
- asl.l #3,d0
-#if flow + count + prof
- move.l d0,d1 ; asl.l #1,d1
- add.l d1,d0 !PROC DES. 24 BYTES
-#endif
- move.l (a6),-(sp)
- move.l 4(a6),-(sp) ; move.l a3,-(sp)
- link a2,#0 ; move.l d0,a0
- add.l pd,a0 !a0 points at proc. des.
-#if prof+count+flow
- tst.l 20(a0) !A FILE NAME DEFINED IN THIS PROC
- bne 4f !YES ? CONTINUE
- move.l 8(sp),20(a0) !NO ? TAKE OLD FILE NAME
-4: move.l curproc,8(sp) !SAVE OLD PROCEDURE DESCRIPTOR
- move.l a0,curproc !CONTINUE WITH NEW ONE
- move.l 8(a0),d0 !COUNT POINTER MINUS LINE NUMBER
- sub.l 12(a0),d0 !OF FIRST LINE IN countfld
- move.l d0,countfld
-#endif
- move.l (a0)+,d1 ; sub.l d1,sp
- claimstack ; add.l d1,sp
- tst.l d1 ; beq 3f
- sub.l #1,d1 ; asr.l wmu,d1
-2: mov und,-(sp) ; dbra d1,2b
-3: move.l (a0),a3 ; jmp (a4)
-
-ret_l: adroff ; move.w (a1),d0
- bra 1f
-ret_s0: move.l d6,d0 ; move.b (a3)+,d0
- bra 1f
-ret_1W: move.w d6,d0 ; bra 5f
-1: blt e_oddz ; beq ret_0
- comp #32,d0 ; ble 2f
- bsr e_badlfr
-2: sub.w #1,d0 ; asr.w wmu,d0
-5: move.w d0,retsize !RETSIZE CONTAINS
-3: mov (sp)+,(a1)+ ; dbra d0,3b ! #WORDS-1
- lea retarea,a1 ; bra 4f
-ret_0: move.w #-1,retsize
-4: unlk a2 ; cmp.l a2,d6
- beq hlt_z ; move.l (sp)+,a3
- move.l (sp)+,a0 !FILE OR PROC DES BASE IN a0
-#if count+flow+prof
- move.l a0,curproc !SAVE PROC DES BASE CUR PROC
- move.l 8(a0),d0 !d0 IS COUNT
- sub.l 12(a0),d0 !d0 IS COUNT-FIRST LINE
- move.l d0,countfld !RESTORE POINTER
- add.l (sp),d0 !ADD LINE NUMBER
- move.l d0,countptr
-#if prof
- beq 5f
- asl.l #2,d0
- add.l ltime,d0
- move.l d0,profile !profile POINTS AT COUNT
-5:
-#endif
- move.l 20(a0),a0 !POINTER TO FILE NAME IN a0
-#endif
- move.l a0,4(a6) !OLD FILE ADDRESS
- move.l (sp)+,(a6) !OLD LINE NUMBER
- jmp (a4)
-
-lfr_1W: move.w d6,d0 ; move.l wrd,d1
-0: cmp.w retsize,d0 ; beq 1f
- bsr e_badlfr
-1: add.l d1,a1
-2: mov -(a1),-(sp) ; dbra d0,2b
-5: jmp (a4)
-lfr_l: move.b (a3)+,-(sp) ; move.b (a3)+,1(sp)
- move.w (sp)+,d0 ; bra 3f
-lfr_s0: move.l d6,d0 ; move.b (a3)+,d0
-3: move.l d7,d2 ; move.l d0,d1
-4: asr.w #1,d0 ; bcs e_illins
- dbra d2,4b ; beq 5b
- sub.w #1,d0 ; bra 0b
-lfr_2W: move.l wrd,d1 ; add.l d1,d1
- move.l #1,d0 ; bra 0b
-
-e_badlfr: mov 0xD,-(sp) ; bra error
+++ /dev/null
-!---------------------------------------------------------------------------
-! MISCELLANEOUS
-!----------------------------------------------------------------------------
-ass_z: mov (sp)+,d0 ; bra 5f
-ass_l: move.b (a3)+,-(sp) ; move.b (a3)+,1(sp)
- move.w (sp)+,d0
-5: checksize
- bra e_oddz
-4: move.l (sp)+,d0 ; bpl 3f
- asr.l wmu,d0 ; bra 8f
-2: move.w (sp)+,d0 ; bpl 3f
- asr.w #1,d0 ; ext.l d0
- bra 8f
-
-asp_1W: asp_2W: asp_3W: asp_4W: asp_5W:
- sub.w #176,d0
-#ifndef lword
- asr.l #1,d0
-#endif
-3: add.l d0,sp ; jmp (a4)
-asp_w0: move.l d6,d0 ; move.b (a3)+,d0
-5: asl.l wmu,d0 ; bra 3b
-asp_lw: move.b (a3)+,-(sp) ; move.b (a3)+,1(sp)
- move.w (sp)+,d0 ; ext.l d0
-6: bmi 8f
- asl.l wmu,d0 ; bra 3b
-8: neg.l d0 ; sub.l #1,d0
-1: mov und,-(sp) ; dbra d0,1b
- jmp (a4)
-asp_qw: move.l (sp)+,d0 ; bra 6b
-
-!-----------------------------------------------------------------------------
-bls_z: mov (sp)+,d0 ; bra 0f
-bls_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d0 ; bra 0f
-4: move.l (sp)+,d0 ; bra 0f
-
-blm_q: move.l (sp)+,d0 ; bra 0f
-blm_l: adroff ; move.w (a1),d0
- bra 0f
-blm_s0: move.l d6,d0 ; move.b (a3)+,d0
-0: move.l d0,d2 ; asr.w wmu,d2
- beq 5f ; move.l a1,d1
- sub.w #1,d2 ; move.l (sp)+,a0 !dest. address
- move.l (sp)+,a1 ; cmp.l a0,a1
-!a1 contains source address. beware of overlap of pieces
- beq 3f ; bcs 2f
-1: mov (a1)+,(a0)+ ; dbra d2,1b
-3: move.l d1,a1
-5: jmp (a4)
-2: add.l d0,a1 ; add.l d0,a0
-4: mov -(a1),-(a0) ; dbra d2,4b
- bra 3b
-
-!----------------------------------------------------------------------------
-csa_z: mov (sp)+,d0 ; bra 0f
-csa_l: adroff ; move.w (a1),d0
-0: sub.l wrd,d0 ; bne e_illins
-csa_1W: move.l (sp)+,a0 ; mov (sp)+,d0
- ext.l d0
- add.l #4,a0 ; subt (a0),d0
- blt 6f
- comp word(a0),d0 ; bhi 6f
- asl.l #2,d0 ; add.l wrd,d0
- move.l word(a0,d0),d1 ; bne 5f
-6: sub.l #4,a0 ; move.l (a0),d1
- beq e_case
-5: move.l d1,a3 ; jmp (a4)
-
-csb_z: mov (sp)+,d0 ; bra 0f
-csb_l: adroff ; move.w (a1),d0
-0: comp wrd,d0 ; bne e_illins
-csb_1W: move.l (sp)+,a0 ; mov (sp)+,d0
- mov 4(a0),d1 ; sub.l #1,d1
- move.l a0,a3
-!Use a3 as a general register
- move.l wrd,d2 ; add.l #4,d2
-1: add.l d2,a0 ; comp (a0),d0
- dbeq d1,1b ; bne 2f
- move.l word(a0),d1 ; beq e_case
- move.l d1,a3 ; jmp (a4)
-2: move.l (a3),d1 ; beq e_case
- move.l d1,a3 ; jmp (a4)
-
-!-----------------------------------------------------------------------------
-dch_z: move.l (sp)+,a0 ; move.l (a0),-(sp)
- move.l ml,a0 ; cmp.l (sp),a0
- bls e_badptr ; jmp (a4)
-
-lpb_z: add.l #16,(sp) ; jmp (a4)
-
-!----------------------------------------------------------------------------
-
-dup_1W: mov (sp),-(sp) ; jmp (a4)
-dup_l: adroff ; move.w (a1),d0
- bra 1f
-dus_z: mov (sp)+,d0 ; bra 0f
-dus_l: adroff ; move.w (a1),d0
-0: checksize
-2: move.w (sp)+,d0 ; bra 1f
-4: move.l (sp)+,d0
-1: ble e_oddz ; bclr #0,d0
- move.l sp,a0 ; add.l d0,a0
- asr.l wmu,d0 ; sub.l #1,d0
-3: mov -(a0),-(sp) ; dbra d0,3b
- jmp (a4)
-!We do not test if d0 is indeed a word multiple . This can eventually be done
-!in the usual way.
-
-!-----------------------------------------------------------------------------
-exg_z: mov (sp)+,d0 ; bra 0f
-exg_l: adroff ; move.w (a1),d0
- bra 0f
-exg_s0: move.l d6,d0 ; move.b (a3)+,d0
-0: move.l d7,d1 ; move.l d0,a0
-1: asri #1,d0 ; dbcs d1,1b
- bcs e_oddz ; sub.l #1,d0
- add.l a0,sp ; add.l sp,a0
-2: mov -(sp),d1 ; mov -(a0),(sp)
- mov d1,(a0) ; dbra d0,2b
- jmp (a4)
-
-gto_q: move.l (sp)+,a0 ; bra 3f
-gto_l: move.l d6,a0 ; move.b (a3)+,-(sp)
- move.b (a3)+,1(sp) ; move.w (sp)+,a0
-3: add.l a6,a0 ; move.l (a0)+,a3
- move.l (a0)+,sp ; move.l (a0),a2
- jmp (a4)
-
-lim_z: move.w ignmask,-(sp) ; jmp (a4)
-sim_z: move.w (sp)+,ignmask ; jmp (a4)
-
- .bss
-ignmask: .space 2
- .define ignmask
- .text
-
-!---------------------------------------------------------------------------
-lor_s0: move.l d6,d0 ; move.b (a3)+,d0
- bne 1f ; move.l a2,-(sp)
- jmp (a4)
-1: sub.w #1,d0 ; bne 2f
- move.l sp,-(sp) ; jmp (a4)
-2: sub.w #1,d0 ; bne e_illins
- move.l hp,-(sp) ; jmp (a4)
-
-str_s0: move.l d6,d0 ; move.b (a3)+,d0
- bne 1f ; move.l (sp)+,a2
- jmp (a4)
-1: sub.w #1,d0 ; bne 2f
- move.l (sp)+,sp ; claimstack
- jmp (a4)
-2: sub.w #1,d0 ; bne e_illins
- move.l (sp)+,d1 ; cmp.l nd,d1
- bcc 3f !break
- cmp.l tblmax,d1 ; bcs 4f
-5: move.l d1,hp ; jmp (a4)
-3: move.l d1,-(sp) ; add.l #1280,(sp)
- bsr _break ; testen (sp)+
-4: bne e_heap ; bra 5b
-
-!----------------------------------------------------------------------------
-rck_z: mov (sp)+,d0 ; bra 0f
-rck_l: adroff ; move.w (a1),d0
-0: sub.l wrd,d0 ; beq rck_1W
- sub.l wrd,d0 ; bne e_oddz
- move.l (sp)+,a0
- mov (sp),d0 ; comp (a0),d0 ; blt 9f
- add.l wrd,a0 ; bra 1f
-rck_1W: move.l (sp)+,a0
- mov (sp),d0 ; comp (a0),d0 ; blt 9f
-1: comp word(a0),d0 ; bgt 9f
- jmp (a4)
-9: bra e_range
-!Temp. solution until trp_z is implemented
-
-!--------------------------------------------------------------------------
-nop_z:
-lblnop: lea nopln+16,a0 ; move.l (a6),d1
- bsr itoa
- lea nopln+33,a0 ; move.l sp,d1
- bsr itoa
- move.l #45,-(sp)
- pea nopln ; mov #1,-(sp)
- bsr _write
- add.l wrd+4,sp
- jmp (a4)
-
- .data
-nopln: .asciz "line number nop sp \n"
- .align 2
- .text
-!unsigned to ascii for integers , a0 is address of first character
-! d1 contains integer. Output is 11 characters of which the first is a space.
-
- .define itoa
- .text
-
-itoa: move.l #9,d4 ; add.l #11,a0
- move.l #10,d0
-0: bsr dvu4 ; add.w #48,d3
- move.b d3,-(a0) ; tst.l d1
- dbeq d4,0b
-1: move.b #32,-(a0) ; dbra d4,1b
- rts
-
-!------------------------------------------------------------------------------
-fil_q: move.l (sp)+,a0 ; bra 3f
-fil_l: adroff ; move.w (a1),d0
- move.l d0,a0
-3: add.l a6,a0 ; cmp.l 4(a6),a0
- beq 0f
-#if flow+count+prof
- move.l curproc,a5
- move.l 8(a5),d0
- sub.l 12(a5),d0
- move.l d0,countfld !START COUNTPTR FOR THIS PROC
- move.l a0,20(a5) !FILE POINTER IN PROC DES
-#endif
- move.l a0,4(a6)
-0: jmp (a4)
-
-!-----------------------------------------------------------------------------
-lni_z: add.l #1,(a6)
-#if count+flow+prof
- add.l #1,countptr
-#if prof
- add.l #4,profile
-#endif
-#endif
- bra 8f
-lin_l: adroff ; move.w (a1),d0 ; bra 1f
-lin_q: move.l (sp)+,d0 ; bra 1f
-lin_s0: move.l #0,d0 ; move.b (a3)+,d0
-1: cmp.l (a6),d0 ; beq 9f
- move.l d0,(a6)
-#if count+flow+prof
- move.l countfld,d1
- add.l d0,d1
- move.l d1,countptr
-#if prof
- asl.l #2,d1
- add.l ltime,d1
- move.l d1,profile
-#endif
-#endif
-8:
-#if last
- bsr nexttab ; move.l 4(a6),(a5)+ !store new line
- move.l (a6),(a5) !number in buffer lasttable
-#endif
-#if count
- move.l countptr,d1 !LINE NUMBER IN d1
- asl.l #2,d1 !MULTIPLY BY 4
- move.l lcount,a0
- add.l #1,0(a0,d1) !ADD 1 TO THE CORRESPONDING COUNT
-#endif
-#if flow
- move.l countptr,d1 !LINE NUMBER IN d1
- move.l #8,d0
- bsr dvu4
-!QUOTIENT IN d1 REST IN d3
- move.l lflow,a0
- bset d3,0(a0,d1)
-!ATTENTION BIT 0 CORR TO LINE 0
-#endif
-!9: bra nop_z
-9: jmp (a4)
-!----------------------------------------------------------------------------
-mon_z: mov (sp)+,d0 ; bmi e_badmon
- cmp.l #64,d0 ; bge e_badmon
- move.l a4,-(sp) ; asl.l #2,d0
- add.l #syscal,d0 ; move.l d0,a0
- move.l (a0),a0 ; jmp (a0)
-
- .data
-syscal:
-.long e_badmon ; .long hlt_z ; .long _fork ; .long _read
-.long _write ; .long _open ; .long _close ; .long _wait
-.long _creat ; .long _link ; .long _unlink ; .long e_badmon
-.long _chdir ; .long e_badmon ; .long _mknod ; .long _chmod
-.long _chown ; .long _break ; .long _stat ; .long _lseek
-.long _getpid ; .long _mount ; .long _umount ; .long _setuid
-.long _getuid ; .long _stime ; .long _ptrace ; .long _alarm
-.long _fstat ; .long _pause ; .long _utime ; .long e_badmon
-.long e_badmon ; .long _access ; .long _nice ; .long _ftime
-.long _sync ; .long _kill ; .long e_badmon ; .long e_badmon
-.long e_badmon ; .long _dup ; .long _pipe ; .long _times
-.long _profil ; .long e_badmon ; .long _setgid ; .long _getgid
-.long _sigtrp ; .long e_badmon ; .long e_badmon ; .long _acct
-.long e_badmon ; .long _lock ; .long _ioctl ; .long e_badmon
-.long _mpxcall ; .long e_badmon ; .long e_badmon ; .long _exece
-.long _umask ; .long _chroot ; .long e_badmon ; .long e_badmon
-
- .text
+++ /dev/null
-e_array: cl -(sp) ; bra error
-e_range: mov #0x1,-(sp) ; bra error
-e_set: mov #0x2,-(sp) ; bra error
-e_iovfl: mov #0x3,-(sp) ; bra error
-e_fovfl: mov #0x4,-(sp) ; bra error
-e_funfl: mov #0x5,-(sp) ; bra error
-e_idivz: mov #0x6,-(sp) ; bra error
-e_fdivz: mov #0x7,-(sp) ; bra error
-e_iund: mov #0x8,-(sp) ; bra error
-e_fund: mov #0x9,-(sp) ; bra error
-e_conv: mov #0xA,-(sp) ; bra error
-e_stack: mov #0x10,-(sp) ; bra fatal
-e_heap: mov #0x11,-(sp) ; bra fatal
-e_illins: mov #0x12,-(sp) ; bra fatal
-e_oddz: mov #0x13,-(sp) ; bra fatal
-e_case: mov #0x11,-(sp) ; bra fatal
-e_memflt: mov #0x15,-(sp) ; bra fatal
-e_badptr: mov #0x16,-(sp) ; bra fatal
-e_badpc: mov #0x17,-(sp) ; bra fatal
-e_badlae: mov #0x18,-(sp) ; bra error
-e_badmon: mov #0x19,-(sp) ; bra error
-e_badlin: mov #0x1A,-(sp) ; bra error
-e_badgto: mov #0x1B,-(sp) ; bra error
-
-flnim: mov #0xB,-(sp) ; bra error
-no8bar: mov #0xC,-(sp) ; bra error
- .define e_memflt
-!---------------------------------------------------------------------------
-! ERRORS AND TRAPS
-!----------------------------------------------------------------------------
-fatal: clr.l -(sp) !dummy return address
- pea hlt_z !RETURN FROM FATAL HALTS
- mov 8(sp),-(sp)
-
-error: movem.l d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6,-(sp)
- mov 60(sp),d0 !ERROR NUMBER IN d0
- lea retsize,a5
- move.l #16,d1
-1: move.w -(a5),-(sp)
- dbra d1,1b
- cmp.w #0xB,d0
- bge 0f !FATAL ERROR , START ERROR HANDLING
- move.l #0x1,d1
- asl.l d0,d1
- move.w ignmask,d2
- not.w d2
- and.w d2,d1
- bne 0f
- move.l #16,d1
- lea retsize,a5
-1: move.w (sp)+,(a5)+
- dbra d1,1b
- movem.l (sp)+,d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
-
- add.l wrd,sp !REMOVE ERROR NUMBER
- rts
-
-0: move.l uerrorp,a0
- cmp.l #-1,a0
- beq notrap
- mov d0,-(sp)
- move.l uerrorp,-(sp)
- move.l #-1,uerrorp !USER MUST SET TRAP AGAIN
- bra cai_z
-
-!-----------------------------------------------------------------------------
-rtt_z: move.l a2,sp
- add.l #0x10,sp !REMOVE RETURN STATUS BLOCK
- add.l wrd,sp !REMOVE ERROR NUMBER
- move.l #16,d0
- lea retsize,a5
-1: move.w (sp)+,(a5)+
- dbra d0,1b
- movem.l (sp)+,d0/d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
- add.l wrd,sp
- rts
-
-trp_z: sub.l #4,sp
- mov 4(sp),(sp) !COPY ERROR NUMBER
- move.l a4,word(sp) !RETURN ADDRESS TO MAIN LOOP
- bra error
-
-sig_z: move.l (sp),d0
- move.l uerrorp,(sp)
- move.l d0,uerrorp
- jmp (a4)
-
- .data
-uerrorp: .long 0x-1
- .text
-
-!-----------------------------------------------------------------------------
-!FIRST INFORMATION ABOUT THE KIND OF THE ERROR
-notrap: add.l #38,sp
- movem.l (sp)+,d1/d2/d3/d4/d5/d6/d7/a0/a1/a2/a3/a4/a5/a6
-notrap1: comp #28,d0 !ERROR NUMBER STILL IN d0
-!still to make a routine that prints the number of a user set error
-1: mulu #21,d0
- lea emerr,a0
- move.l #20,-(sp)
- pea 0(a0,d0)
- mov #2,-(sp) !STANDARD ERROR
- bsr _write
- add.l wrd+4,sp
-!NEXT INFORMATION ABOUT THE LINE NUMBER
- move.l (a6),d1
- lea emess+14,a0
- bsr itoa
- move.l #30,-(sp)
- pea emess
- mov #2,-(sp)
- bsr _write
- add.l wrd+4,sp
-!NOW INFORMATION ABOUT THE FILES
-2: move.l 4(a6),a0
- cmp.l #0,a0
- beq 5f
- move.l a0,a5
- sub.l #4,sp
- move.l a5,-(sp)
- move.l #-1,d0
-1: add.l #1,d0
- tst.b (a5)+
- bne 1b
- move.l d0,4(sp)
- mov #2,-(sp)
- bsr _write
- add.l wrd+4,sp
-5: move.w #0x0A,-(sp)
- move.l #2,-(sp)
- pea 4(sp)
- mov #2,-(sp)
- bsr _write
- add.l wrd+6,sp
- comp #0xB,(sp)
- beq 1f
-
- move.l #-1,argc
- clr.l -(sp) !dummy return address
- bra hlt_z
-
-1: add.l wrd,sp
- jmp (a4)
-
-!---------------------------------------------------------------------------
-! EXIT HANDLING
-!--------------------------------------------------------------------------
-hlt_z: add.l #4,sp !remove return address
-#if prof
- .data
-emprof: .asciz "em_profile\0"
- .align 2
- .bss
-profile: .space 4
-ltime: .space 4
-profsiz: .space 4
- .text
- mov #0x1B6,-(sp)
- pea emprof
- bsr _creat
- testen (sp)+
- mov (sp)+,d0
- move.l profsiz,-(sp)
- move.l ltime,-(sp) !LTIME IS POINTER AT TABLE
- mov d0,-(sp)
- bsr _write
- add.l wrd+4,sp
-#endif
-#if flow
- mov #0x1B6,-(sp)
- pea emflow
- bsr _creat
- testen (sp)+
- mov (sp)+,d0
- move.l flowsiz,-(sp)
- move.l lflow,-(sp)
- mov d0,-(sp)
- bsr _write
- add.l wrd+4,sp
- .data
-emflow: .asciz "em_flow\0"
- .align 2
- .bss
-lflow: .space 4
-flowsiz: .space 4
- .text
-#endif
-#if count
- mov #0x1B6,-(sp)
- pea emcount
- bsr _creat
- testen (sp)+
- mov (sp)+,d0
- move.l countsiz,-(sp)
- move.l lcount,-(sp)
- mov d0,-(sp)
- bsr _write
- add.l wrd+4,sp
- .data
-emcount: .asciz "em_count\0"
- .align 2
- .bss
-lcount: .space 4
-countsiz: .space 4
-#endif
-#if opfreq
- .data
-emopf: .asciz "em_opfreq\0"
- .align
- .bss
-counttab: .space 1884
- .text
- mov #0x1B6,-(sp)
- pea emopf
- bsr _creat
- testen (sp)+
- mov (sp)+,d0
- move.l #1884,-(sp)
- pea counttab
- mov d0,-(sp)
- bsr _write
- add.l wrd+4,sp
-#endif
-#if count+flow+prof
- .bss
-countfld: .space 4 !COUNT NUMBER - NUMBER OF LINE 1 OF PROC
-countptr: .space 4 !COUNT NUMBER OF CURRENT LINE
-#endif
-#if last
- .text
- mov #0x1B6,-(sp)
- pea emlast
- bsr _creat
- testen (sp)+
- mov (sp)+,d6 !d6 contains file descriptor
- cmp.l #-1,linused-4 !test if buffer is fully used
- beq 0f
- bsr nexttab
- bra 1f
-0: lea lasttable,a5
-1: tst.l (a5)
- bne 2f !exists entry in table
- move.l #22,-(sp) !here case no lines processed
- pea mess1
- mov d6,-(sp)
- bsr _write
- add.l wrd+4,sp
- bra 9f
-2: move.l #7,-(sp) !announce new file name
- pea mess2
- mov d6,-(sp)
- bsr _write
- add.l wrd+4,sp
- move.l (a5),d7
- move.l d7,a0 !keep file pointer in d7
- clr.l (a5)+ !this will stop the printing
- move.l #-1,d1 !d1 will contain length of file name
-3: add.l #1,d1
- tst.b (a0)+
- bne 3b
- move.l d1,-(sp)
- move.l d7,-(sp)
- mov d6,-(sp)
- bsr _write
- add.l wrd+4,sp
-4: move.l (a5),d1 !next print line numbers
- lea mess3,a0
- bsr itoa
- move.l #12,-(sp)
- pea mess3
- mov d6,-(sp)
- bsr _write
- add.l wrd+4,sp
- bsr nexttab
- tst.l (a5) !in case 0 no more lines
- beq 9f
- cmp.l (a5),d7
- bne 2b !new file name
- clr.l (a5)+ !skip file name
- bra 4b !only new line
-9:
- .data
-emlast: .asciz "em_last"
-mess1: .asciz "no line processed yet\n"
-mess2: .asciz "\nfile :"
-mess3: .asciz " \n"
- .align 2
- .bss
-lasttable: .space 128
-linused: .space 4
-#endif
- .text
-halt: bsr _exit
-
- .data
-emerr:
-.asciz "ARRAY BOUND ERROR \n"
-.asciz "RANGE BOUND ERROR \n"
-.asciz "SET BOUND ERROR \n"
-.asciz "INTEGER OVERFLOW \n"
-.asciz "FLOATING OVERFLOW \n"
-.asciz "FLOATING UNDERFLOW \n"
-.asciz "INT. DIV. BY ZERO \n"
-.asciz "DIVIDE BY 0.0 \n"
-.asciz "UNDEFINED INTEGER \n"
-.asciz "UNDEFINED FLOAT \n"
-.asciz "CONVERSION ERROR \n"
-.asciz "NO FLOATING POINT \n"
-.asciz "NO 8 BYTE ARITH. \n"
-.asciz "NO LOAD FILE \n"
-.asciz "LOAD FILE ERROR \n"
-.asciz "PROGRAM TOO LARGE \n"
-.asciz "STACK OVERFLOW \n"
-.asciz "HEAP OVERFLOW \n"
-.asciz "ILLEGAL INSTRUCTION\n"
-.asciz "ILLEGAL SIZE ARG. \n"
-.asciz "CASE ERROR \n"
-.asciz "ADDRESS NON EX. MEM\n"
-.asciz "BAD POINTER USED \n"
-.asciz "PR COUNT. OUT RANGE\n"
-.asciz "BAD ARG. OF LAE \n"
-.asciz "BAD MONITOR CALL \n"
-.asciz "ARG OF LIN TOO HIGH\n"
-.asciz "GTO DESCR. ERROR \n"
-.asciz "BAD RETURN SIZE \n"
-emess:
-.asciz "ON SOURCE LINE OF\n"
-.align 2
-!-----------------------------------------------------------------------------
-! SUBROUTINES FOR THE INTERPRETOR
-!------------------------------------------------------------------------------
- .text
-#if last
-nexttab: move.l linused,a5
- add.l #8,a5
- cmp.l #linused,a5 !top of buffer reached?
- bne 1f !if so back to bottom
- sub.l #128,a5
-1: move.l a5,linused
- rts
-#endif
+++ /dev/null
-_sigtrp: mov (sp)+,d1 !trapno in d1
- mov (sp)+,d4 !signo in d4
- extend d4
- extend d1
- comp #16,d4
- bhi sig_bad
- tst.l d4
- beq sig_bad
- move.l d4,a0
- add.l a0,a0
- add.l a0,a0
- lea sig_trp-4(a0),a5
- move.l (a5),d2 !previous trap number in d2
- comp #256,d1 !-2 and -1 special
- bcc 1f
- move.l sig_adr-4(a0),d3 !Get the pointer to the trap-
- bne 2f !procedure to give as argument to
-sig_bad: mov 22,-(sp) !_signal. If pointer 0 trapping is
- mov 22,-(sp) !not legal
- jmp (a4)
-1: comp #-3,d1 !-2:reset default , -3: ignore
- bmi sig_bad
- move.l d1,d3
- ad #2,d3 !0:reset default for signal, -1: ignore
-2: move.l d1,(a5) !set new trapno
- move.l d3,-(sp) !set arguments to signal:
- mov d4,-(sp) !pointer ,signo to be trapped
- bsr _signal
- cl -(sp) !set code for no error
- .data
-sig_adr: .long sig1 ; .long sig2 ; .long sig3 ; .long 0
- .long 0 ; .long 0 ; .long 0 ; .long 0
- .long 0 ; .long 0 ; .long sig11 ; .long sig12
- .long sig13 ; .long sig14 ; .long sig15 ; .long sig16
-sig_trp: .long -2 ; .long -2 ; .long -2 ; .long -2
- .long -2 ; .long -2 ; .long -2 ; .long -2
- .long -2 ; .long -2 ; .long 21 ; .long 25
- .long -2 ; .long -2 ; .long -2 ; .long -2
- .text
-!the next procedures map the catched signal to em errors. The em error
-!procedure will handle this.
-sig1: sig2: sig3: sig8: sig13: sig14: sig15: sig16:
- pea retutrap
- mov d1,-(sp)
- bra error
-retutrap: rtr
-
-sig12: pea sig12
- mov #12,-(sp)
- bsr _signal
- bsr e_badmon
- rtr
-sig11: move.l 4(a1),d0
- sub.l sp,d0
- bcs e_memflt !in this case error handling possible
- move.l ml,sp !refresh stack and stop .
- bra notrap1
-
+++ /dev/null
-!THIS FILE CONTAINS THE SYSTEM CALLS FOR PMDS-II AS SUBROUTINES FOR THE
-!EM-INTERPRETER. a1 CONTAINS A POINTER TO THE RETURN AREA . EACH SUBROUTINE
-!EXPECTS ITS DATA IN THE FORM EM PRODUCES AND GIVES ITS RESULTS AS EM
-!REQUIRES
-
-_exit: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 1
-
-_fork: move.l (sp),(a1)
- trap #0
- .short 2
- lea 4(sp),sp
- bcs 2f
- tst.l d0 !PID OF CHILD IN PARENT, 0 IN CHILD
- bne 1f
- trap #0
- .short 20
- mov d1,-(sp) !PID OF PARENT IN d1
- mov #1,-(sp) !(PID OF CHILD IN D0),FLAG 1 IN CHILD
- bra 0f
-1: mov d0,-(sp) !PID OF CHILD IN d0
- cl -(sp) !FLAG 0 IN PARENT
-0: cl -(sp)
- bra 3f
-2: mov d0,-(sp)
- mov d0,-(sp)
-3: move.l (a1),a0
- jmp (a0)
-!_fork is special
-
-_read: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 3
-sys0: lea 16(sp),sp
- bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: move.l d0,-(sp)
- cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
-_write: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 4
- bra sys0
-
-_open: move.l (sp),(a1)
-#ifndef lword
- bsr st243
-#endif
- trap #0
- .short 5
-sys1: lea 12(sp),sp
-sys5: bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: mov d0,-(sp)
- cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
-_close: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 6
-sys3: lea 8(sp),sp
-sys4: bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
-_wait: move.l (sp),(a1)
- trap #0
- .short 7
-sys6: lea 4(sp),sp
- bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: mov d1,-(sp) ! ??
- mov d0,-(sp)
- cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
-_creat: move.l (sp),(a1)
-#ifndef lword
- bsr st243
-#endif
- trap #0
- .short 8
- bra sys1
-
-_link: move.l (sp),(a1)
- trap #0
- .short 9
- lea 12(sp),sp
- bra sys4
-
-_unlink: move.l (sp),(a1)
- trap #0
- .short 10
- bra sys3
-
-_chdir: move.l (sp),(a1)
- trap #0
- .short 12
- bra sys3
-
-_mknod: move.l (sp),(a1)
-#ifndef lword
- bsr st244
-#endif
- trap #0
- .short 14
- lea 16(sp),sp
- bra sys4
-
-_chmod: move.l (sp),(a1)
-#ifndef lword
- bsr st243
-#endif
- trap #0
- .short 15
- lea 12(sp),sp
- bra sys4
-
-_chown: move.l (sp),(a1)
-#ifndef lword
- bsr st244
-#endif
- trap #0
- .short 16
- lea 16(sp),sp
- bra sys4
-
-_break: move.l (sp),(a1)
- trap #0
- .short 17
- lea 8(sp),sp
- bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: move.l -4(sp),nd
- cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
- .data
-nd: .long endbss
- .text
-
-_stat: move.l (sp),(a1)
- trap #0
- .short 18
- lea 12(sp),sp
- bra sys4
-
-_lseek: move.l (sp),(a1)
-#ifndef lword
- bsr st245
-#endif
- trap #0
- .short 19
- lea 16(sp),sp
- bcc 1f
- mov d0,-(sp)
- mov d0,-(sp)
- bra 2f
-1: move.l d1,-(sp)
- mov d0,-(sp)
- cl -(sp)
-2: move.l (a1),a0
- jmp (a0)
-
-
-_getpid: move.l (sp),(a1)
- trap #0
- .short 20
- add.l #4,sp
- mov d0,-(sp)
- move.l (a1),a0
- jmp (a0)
-
-_mount: move.l (sp),(a1)
-#ifndef lword
- bsr st246
-#endif
- trap #0
- .short 21
- lea 16(sp),sp
- bra sys4
-
-_umount: move.l (sp),(a1)
- trap #0
- .short 22
- bra sys3
-
-_setuid: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 23
- bra sys3
-
-_getuid: move.l (sp),(a1)
- trap #0
- .short 24
-sys7: add.l #4,sp
- mov d1,-(sp)
- mov d0,-(sp)
- move.l (a1),a0
- jmp (a0)
-
-_stime: move.l (sp),(a1)
- trap #0
- .short 25
- bra sys3
-
-_ptrace: move.l (sp),(a1)
-#ifndef lword
- bsr st247
-#endif
- trap #0
- .short 26
- lea 20(sp),sp
- bra sys5
-
-_alarm: move.l (sp),(a1)
-#ifndef lword
- sub.l #2,sp
- clr.w 4(sp)
-#endif
- trap #0
- .short 27
- lea 8(sp),sp
- mov d0,-(sp)
- move.l (a1),a0
- jmp (a0)
-
-_fstat: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 28
- lea 12(sp),sp
- bra sys4
-
-_pause: trap #0
- .short 29
- rts
-
-_utime: move.l (sp),(a1)
- trap #0
- .short 30
- lea 12(sp),sp
- bra sys4
-
-_access: move.l (sp),(a1)
-#ifndef lword
- bsr st248
-#endif
- trap #0
- .short 33
- lea 12(sp),sp
- bra sys4
-
-_nice:
-#ifndef lword
- bsr 241
-#endif
- trap #0
- .short 34
- move.l (sp)+,(sp)
- rts
-
-_ftime: move.l (sp),(a1)
- trap #0
- .short 35
- bra sys3
-
-_sync: trap #0
- .short 36
- rts
-
-_kill: move.l (sp),(a1)
-#ifndef lword
- bsr st248
-#endif
- trap #0
- .short 37
- lea 12(sp),sp
- bra sys4
-
-_dup: move.l (sp),(a1)
-#ifndef lword
- bsr st248
-#endif
- trap #0
- .short 38
- bra sys1
-
-_pipe: move.l (sp),(a1)
- trap #0
- .short 42
- bra sys6
-
-_times: trap #0
- .short 43
- move.l (sp),a0
- add.l #8,sp
- jmp (a0)
-
-_profil: trap #0
- .short 44
- move.l (sp),a0
- lea 20(sp),sp
- jmp (a0)
-
-_setgid: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 46
- bra sys3
-
-_getgid: move.l (sp),(a1)
- trap #0
- .short 47
- bra sys7
-
-
-_signal: move.l (sp)+,retaddr
- mov (sp)+,d4
- extend d4
- move.l d4,-(sp)
- move.l retaddr,-(sp)
- trap #0
- .short 48
- mov d0,-(sp)
- bne 1f
- mov d0,-(sp)
-1: move.l retaddr,a0
- jmp (a0)
- .data
-retaddr: .long 0
- .text
-
-_acct: move.l (sp),(a1)
- trap #0
- .short 51
- bra sys3
-_lock: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 53
- bra sys3
-
-_ioctl: move.l (sp),(a1)
-#ifndef lword
- bsr st248
-#endif
- trap #0
- .short 54
- lea 16(sp),sp
- bra sys4
-
-_mpxcall: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 56
- lea 12(sp),sp
- bra sys4
-
-_exece: move.l (sp),(a1)
- trap #0
- .short 59
- lea 16(sp),sp
- bra sys4
-
-_umask: move.l (sp),(a1)
-#ifndef lword
- bsr st241
-#endif
- trap #0
- .short 60
- add.l #8,sp
- mov d0,-(sp)
- move.l (a1),a0
- jmp (a0)
-
-_chroot: move.l (sp),(a1)
- trap #0
- .short 61
- bra sys3
-
-
-!----------------------------------------------------------------------------
-! STACK ADJUSTMENT FOR THE TWO BYTE INTERPRETER
-!-----------------------------------------------------------------------------
-#ifndef lword
-
-st241: sub.l #2,sp
- move.l 2(sp),(sp)
- move.l 6(sp),4(sp)
- move.w 10(sp),d0
- ext.l d0
- move.l d0,8(sp)
- rts
-
-st243: sub.l #2,sp
- move.l 2(sp),(sp)
- move.l 6(sp),4(sp)
- move.l 10(sp),8(sp)
- move.w 14(sp),d0
- ext.l d0
- move.l d0,12(sp)
- rts
-
-st244: move.l (sp),-(sp)
- move.l 8(sp),4(sp)
- move.l 12(sp),8(sp)
- move.w 16(sp),d0
- ext.l d0
- move.l d0,12(sp)
- move.w 18(sp),d0
- ext.l d0
- move.l d0,16(sp)
- rts
-
-st245: move.l (sp),-(sp)
- move.l 8(sp),4(sp)
- move.w 12(sp),d0
- ext.l d0
- move.l d0,8(sp)
- move.l 14(sp),12(sp)
- move.w 18(sp),d0
- ext.l d0
- move.l d0,16(sp)
- rts
-
-st246: sub.l #2,sp
- move.l 2(sp),(sp)
- move.l 6(sp),4(sp)
- move.l 10(sp),8(sp)
- move.l 14(sp),12(sp)
- move.w 18(sp),d0
- ext.l d0
- move.l d0,16(sp)
- rts
-
-st247: sub.l #6,sp
- move.l 6(sp),(sp)
- move.l 10(sp),4(sp)
- move.w 14(sp),d0
- ext.l d0
- move.l d0,8(sp)
- move.w 16(sp),d0
- ext.l d0
- move.l d0,12(sp)
- move.l 18(sp),16(sp)
- move.w 22(sp),d0
- ext.l d0
- move.l d0,20(sp)
- rts
-
-st248: move.l (sp),-(sp)
- move.l 8(sp),4(sp)
- move.w 12(sp),d0
- ext.l d0
- move.l d0,8(sp)
- move.w 14(sp),d0
- ext.l d0
- move.l d0,12(sp)
- rts
-
-#endif
+++ /dev/null
- .text
-end:
- .bss
-endbss:
- .data
-enddata:
+++ /dev/null
-rm temp.c
-cat header deffile $1 >> temp.c
-cpp -P temp.c >$2
+++ /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 /* save all registers in markblock */
-
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == TEM_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");
-#ifdef ACK_ASS
- fprintf(codefile,".long %s\n",str);
-#else
- l = atol(str);
- fprintf(codefile,"\t%o;%o\n",(int)(l>>16),(int)l);
-#endif
-}
-
-/*
- * The next function is difficult to do when not running on a PDP 11 or VAX
- * The strategy followed is to assume the code generator is running on a PDP 11
- * unless the ACK_ASS define is on.
- * In the last case floating point constants are simply not handled
- */
-
-con_float() {
-#ifdef ACK_ASS
- static int been_here;
-
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- fprintf(codefile,".long\t");
- if (argval == 8)
- fprintf(codefile,"F_DUM,");
- fprintf(codefile,"F_DUM\n");
- if ( !been_here++)
- fprintf(stderr,"Warning : dummy float-constant(s)\n");
-#else
- 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++);
-#endif
-}
-
-#ifdef REGVARS
-
-char Rstring[10];
-full lbytes;
-struct regadm {
- char *ra_str;
- long ra_off;
-} regadm[2];
-int n_regvars;
-
-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[0] = 0;
- n_regvars=0;
-}
-
-f_regsave() {
- register i;
-
- if (n_regvars==0 || lbytes==0) {
-#ifdef REGPATCH
- fprintf(codefile,"mov r2,-(sp)\nmov r4,-(sp)\n");
-#endif
- fprintf(codefile,"mov r5,-(sp)\nmov sp,r5\n");
- if (lbytes == 2)
- fprintf(codefile,"tst -(sp)\n");
- else if (lbytes!=0)
- fprintf(codefile,"sub $0%o,sp\n",lbytes);
- for (i=0;i<n_regvars;i++)
- fprintf(codefile,"mov %s,-(sp)\n",regadm[i].ra_str);
- } else {
- if (lbytes>6) {
- fprintf(codefile,"mov $0%o,r0\n",lbytes);
- fprintf(codefile,"jsr r5,PR%s\n",Rstring);
- } else {
- fprintf(codefile,"jsr r5,PR%d%s\n",lbytes,Rstring);
- }
- }
- for (i=0;i<n_regvars;i++)
- if (regadm[i].ra_off>=0)
- fprintf(codefile,"mov 0%lo(r5),%s\n",regadm[i].ra_off,
- regadm[i].ra_str);
-}
-
-regsave(regstr,off,size) char *regstr; long off; {
-
- fprintf(codefile,"%c Local %ld into %s\n",COMMENTCHAR,off,regstr);
-/* commented away
-#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);
-end of commented away */
-
- strcat(Rstring,regstr);
- regadm[n_regvars].ra_str = regstr;
- regadm[n_regvars].ra_off = off;
- n_regvars++;
-}
-
-regreturn() {
-
-#ifdef REGPATCH
- fprintf(codefile,"jmp eret\n");
-#else
- fprintf(codefile,"jmp RT%s\n",Rstring);
-#endif
-}
-
-#endif
-
-prolog(nlocals) full nlocals; {
-
-#ifndef REGVARS
-#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);
-#else
- lbytes = nlocals;
-#endif
-}
-
-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) ;
-#ifdef ACK_ASS
- fprintf(codefile,".define %s\n",argstr) ;
-#else
- fprintf(codefile,".globl %s\n",argstr) ;
-#endif
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
+++ /dev/null
-/* $Header$ */
-
-/* The next define switches between codegeneration for an ACK assembler
- * or for the standard UNIX V7 assembler.
- * If on code is generated for the ACK assembler.
- */
-/* #define ACK_ASS /* code for ACK assembler */
-
-#ifdef ACK_ASS
-#define COMMENTCHAR '!'
-#define ex_ap(y) fprintf(codefile,".extern %s\n",y)
-#else
-#define COMMENTCHAR '/'
-#define ex_ap(y) fprintf(codefile,".globl %s\n",y)
-#endif
-#define in_ap(y) /* nothing */
-
-#define newplb(x) fprintf(codefile,"%s:\n",x)
-#define newilb(x) fprintf(codefile,"%s:\n",x)
-#define newdlb(x) fprintf(codefile,"%s:\n",x)
-#ifdef ACK_ASS
-#define newlbss(l,x) fprintf(codefile,"%s:.space 0%o\n",l,x);
-#else
-#define newlbss(l,x) fprintf(codefile,"%s:.=.+0%o\n",l,x);
-#endif
-
-#define cst_fmt "$0%o"
-#define off_fmt "0%o"
-#define ilb_fmt "I%03x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "0%o+hol%d"
-
-#ifdef ACK_ASS
-#define con_cst(x) fprintf(codefile,".short 0%o\n",x)
-#define con_ilb(x) fprintf(codefile,".short %s\n",x)
-#define con_dlb(x) fprintf(codefile,".short %s\n",x)
-#else
-#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)
-#endif
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#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];
-char *index();
-
-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 $06,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]=='0' &&
- buf[6]=='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]=='0' && 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 */
-/* #define UNTESTED \* include untested rules */
-
-#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~" | | |
-#ifdef UNTESTED
-los !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,los2~" | | |
-#endif
-
-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)}) | | |
-lae lol ads sti $3==2 && inreg($2)==2 | |
- | {regconst2, regvar($2), $1} | sti $4 |
-lae lol ads loi $3==2 && inreg($2)==2 | |
- | {regconst2, regvar($2), $1} | loi $4 |
-#endif
-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]}) | | |
-... | regconst2 source1or2 |
- INDSTORE
- move(%[2],{regind1,%[1.reg],%[1.ind]}) | | |
-... | ADDR_EXTERNAL source1or2 |
- INDSTORE
- move(%[2],{relative1,%[1.ind]}) | | |
-... | ADDR_LOCAL source1or2 |
- INDSTORE
- move(%[2],{regind1, lb, tostring(%[1.ind])}) | | |
-... | relative2 source1or2 |
- INDSTORE
- move(%[2],{reldef1,%[1.ind]}) | | |
-... | regind2 source1or2 |
- INDSTORE
- move(%[2],{reginddef1,%[1.reg],%[1.ind]}) | | |
-sti $1==4 | dadres2 FLT_REG |
- INDSTORE
- "movfo %[2],*%[1]"
- samecc | | |
-... | dadres2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],*%[1]\nseti"
- samecc | | |
-... | regconst2 FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | regconst2 ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](%[1.reg])\nseti"
- samecc | | |
-... | ADDR_LOCAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind](r5)"
- samecc | | |
-... | ADDR_LOCAL ftolong |
- INDSTORE
- "setl\nmovfi %[2.reg],%[1.ind](r5)\nseti"
- samecc | | |
-... | ADDR_EXTERNAL FLT_REG |
- INDSTORE
- "movfo %[2],%[1.ind]"
- samecc | | |
-... | 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 | dadres2 DBL_REG |
- INDSTORE
- "movf %[2],*%[1]"
- samecc | | |
-... | regconst2 DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](%[1.reg])"
- samecc | | |
-... | ADDR_LOCAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind](r5)"
- samecc | | |
-... | ADDR_EXTERNAL DBL_REG |
- INDSTORE
- "movf %[2],%[1.ind]"
- samecc | | |
-... | SCR_REG regdef8 |
- INDSTORE
- "mov (%[2.reg]),(%[1])+"
- "mov 2(%[2.reg]),(%[1])+"
- "mov 4(%[2.reg]),(%[1])+"
- "mov 6(%[2.reg]),(%[1])"
- erase(%[1]) | | |
-... | 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 CONST2+ADDR_EXTERNAL+ADDR_LOCAL+regconst2 SCR_REG |
- | %[1] %[2] | adi 2 |
-... | NC source2-REG CONST2+ADDR_EXTERNAL+ADDR_LOCAL |
- allocate(%[1],REG=%[1]) | %[2] %[a] | adi 2 |
-... | NC source1 CONST2+ADDR_EXTERNAL+ADDR_LOCAL |
- allocate(%[1],REG={CONST2, 0})
- "bisb %[1],%[a]" | %[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]
-
-ldc adi $2==4 && highw(1)==0 | SCR_REG SCR_REG |
- "add $$%(loww(1)%),%[2]"
- "adc %[1]"
- erase(%[1]) erase(%[2]) | %[2] %[1] | |
-ldc adi $2==4 | SCR_REG SCR_REG |
- "add $$%(loww(1)%),%[2]"
- "adc %[1]"
- "add $$%(highw(1)%),%[1]"
- erase(%[1]) erase(%[2]) | %[2] %[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]
-#ifdef UNTESTED
-adi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,adi~" | | |
-#endif
-loc sbi $2==2 | | | | loc 0-$1 adi 2 |
-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]
-ldc sbi $2==4 && highw(1)==0 | SCR_REG SCR_REG |
- "sub $$%(loww(1)%),%[2]"
- "sbc %[1]"
- erase(%[1]) erase(%[2]) | %[2] %[1] | |
-ldc sbi $2==4 | SCR_REG SCR_REG |
- "sub $$%(loww(1)%),%[2]"
- "sbc %[1]"
- "sub $$%(highw(1)%),%[1]"
- erase(%[1]) erase(%[2]) | %[2] %[1] | |
-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]
-#ifdef UNTESTED
-sbi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sbi~" | | |
-#endif
-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 | |
-#ifdef UNTESTED
-mli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mli~" | | |
-#endif
-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 | |
-#ifdef UNTESTED
-dvi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvi~" | | |
-#endif
-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 | |
-#ifdef UNTESTED
-rmi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmi~" | | |
-#endif
-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)
-#ifdef UNTESTED
-ngi !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ngi~" | | |
-#endif
-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] | |
-#ifdef UNTESTED
-sli !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sli~" | | |
-#endif
-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] | |
-#ifdef UNTESTED
-sri !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sri~" | | |
-#endif
-
-/************************************************
- * 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 | |
-#ifdef UNTESTED
-mlu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,mlu~" | | |
-#endif
-loc dvu $1>0 && $1<=32767 && $2==2 | source2 |
- allocate(%[1],REG_PAIR)
- move(%[1],%[a.2])
- "clr %[a.1]"
- "div $$$1,%[a.1]" | %[a.1] | |
-dvu $1==2 | | remove(all)
- "jsr pc,dvu2~" | r0 | |
-dvu $1==4 | | remove(all)
- "jsr pc,dvu4~" | r1 r0 | |
-#ifdef UNTESTED
-dvu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,dvu~" | | |
-#endif
-loc rmu $1>0 && $1<=32767 && $2==2 | source2 |
- allocate(%[1],REG_PAIR)
- move(%[1],%[a.2])
- "clr %[a.1]"
- "div $$$1,%[a.1]" | %[a.2] | |
-rmu $1==2 | | remove(all)
- "jsr pc,rmu2~" | r1 | |
-rmu $1==4 | | remove(all)
- "jsr pc,rmu4~" | r1 r0 | |
-#ifdef UNTESTED
-rmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rmu~" | | |
-#endif
-slu | | | | sli $1 |
-loc slu | | | | loc $1 sli $2 |
-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) | | |
-#ifdef UNTESTED
-sru !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,sru~" | | |
-#endif
-
-/************************************************
- * 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]
-#ifdef UNTESTED
-adf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,adf~" | | |
-#endif
-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]
-#ifdef UNTESTED
-sbf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,sbf~" | | |
-#endif
-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]
-#ifdef UNTESTED
-mlf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,mlf~" | | |
-#endif
-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]
-#ifdef UNTESTED
-dvf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,dvf~" | | |
-#endif
-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)
-#ifdef UNTESTED
-ngf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,ngf~" | | |
-#endif
-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]
-#ifdef UNTESTED
-fif !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fif~" | | |
-#endif
-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)
-#ifdef UNTESTED
-fef !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,fef~" | | |
-#endif
-
-/****************************************
- * 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}) | | |
-ldl ldc adi sdl $1==$4 && $3==4 && highw(2)==0 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add $$%(loww(2)%),2+$1(r5)"
- "adc $1(r5)" | | |
-ldl ldc adi sdl $1==$4 && $3==4 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "add $$%(loww(2)%),2+$1(r5)"
- "adc $1(r5)"
- "add $$%(highw(2)%),$1(r5)" | | |
-ine | | remove(posextern)
- "inc $1"
- setcc({relative2,$1}) | | |
-lde ldc adi sde $1==$4 && $3==4 && highw(2)==0 | |
- remove(posextern)
- "add $$%(loww(2)%),2+$1"
- "adc $1" | | |
-lde ldc adi sde $1==$4 && $3==4 | |
- remove(posextern)
- "add $$%(loww(2)%),2+$1"
- "adc $1"
- "add $$%(highw(2)%),$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)%)"
- setcc({regdef2, regvar($1)}) | | |
-lil dec sil $1==$3 && inreg($1)==2 | | INDSTORE
- "dec *%(regvar($1)%)"
- setcc({regdef2, regvar($1)}) | | |
-lol adi stl $2==2 && $1==$3 && inreg($1)==2 | source2 |
- remove(regvar($1))
- "add %[1],%(regvar($1)%)"
- erase(regvar($1)) | | |
-lol lol adp stl loi $1==$2 && $2==$4 && inreg($1)==2 && $3==1 && $5==1 | |
- allocate(REG={CONST2, 0})
- remove(regvar($1))
- "bisb (%(regvar($1)%))+,%[a]" | %[a] | |
-lol lol adp stl loi $1==$2 && $2==$4 && inreg($1)==2 && $3==2 && $5==2 | |
- allocate(REG)
- remove(regvar($1))
- "mov (%(regvar($1)%))+,%[a]" | %[a] | |
-lol sti lol adp stl $1==$3 && $3==$5 && inreg($1)==2 && $2==1 && $4==1 | source1or2|
- remove(regvar($1))
- "movb %[1],(%(regvar($1)%))+" | | |
-sil lol adp stl $1==$2 && $2==$4 && inreg($1)==2 && $3==2 | source2 |
- remove(regvar($1))
- "mov %[1],(%(regvar($1)%))+" | | |
-lol lol adp stl $1==$2 && $2==$4 && inreg($1)==2 | |
- allocate(REG=regvar($1)) | %[a]
- | lol $2 adp $3 stl $2 |
-lol lol adp stl $1==$2 && $2==$4 | |
- allocate(REG={LOCAL2, $1, 2}) | %[a]
- | lol $2 adp $3 stl $2 |
-lol inl $1==$2 && inreg($1)==2 | |
- allocate(REG=regvar($1)) | %[a]
- | inl $2 |
-lol inl $1==$2 | |
- allocate(REG={LOCAL2, $1, 2}) | %[a]
- | inl $2 |
-lol del $1==$2 && inreg($1)==2 | |
- allocate(REG=regvar($1)) | %[a]
- | del $2 |
-lol del $1==$2 | |
- allocate(REG={LOCAL2, $1, 2}) | %[a]
- | del $2 |
-lol adp stl $1==$3 && $2==1 && inreg($1)==2 | |
- remove(regvar($1))
- "inc %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && $2==0-1 && inreg($1)==2 | |
- remove(regvar($1))
- "dec %(regvar($1)%)"
- erase(regvar($1)) | | |
-lol adp stl $1==$3 && inreg($1)==2 | |
- remove(regvar($1))
- "add $$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-lil lil adp sil $2==$4 && inreg($1)==2 | |
- allocate(REG={regdef2, regvar($1)})
- | %[a] | lil $2 adp $3 sil $2 |
-lil adp sil $1==$3 && $2==1 && inreg($1)==2 | |
- INDSTORE
- "inc *%(regvar($1)%)" | | |
-lil adp sil $1==$3 && $2==0-1 && inreg($1)==2 | |
- INDSTORE
- "dec *%(regvar($1)%)" | | |
-lil adp sil $1==$3 && inreg($1)==2 | |
- INDSTORE
- "add $$$2,*%(regvar($1)%)" | | |
-lol lof inc lol stf $1==$4 && $2==$5 && inreg($1)==2 | |
- INDSTORE
- "inc $2(%(regvar($1)%))"
- setcc({regind2, regvar($1), tostring($2)}) | | |
-lol lof dec lol stf $1==$4 && $2==$5 && inreg($1)==2 | |
- INDSTORE
- "dec $2(%(regvar($1)%))"
- setcc({regind2, regvar($1), tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 && inreg($1)==2 && $3==1 | |
- INDSTORE
- "inc $2(%(regvar($1)%))"
- setcc({regind2, regvar($1), tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 && inreg($1)==2 && $3==0-1 | |
- INDSTORE
- "dec $2(%(regvar($1)%))"
- setcc({regind2, regvar($1), tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 && inreg($1)==2 | |
- INDSTORE
- "add $3,$2(%(regvar($1)%))"
- setcc({regind2, regvar($1), tostring($2)}) | | |
-#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)"
- setcc({reginddef2, lb, tostring($1)}) | | |
-lil dec sil $1==$3 | | INDSTORE
- "dec *$1(r5)"
- setcc({reginddef2, lb, tostring($1)}) | | |
-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 && $2==0-1 | |
- remove(indordef)
- remove(locals, %[ind] <= $1 && %[ind]+%[size] > $1)
- "dec $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}) | | |
-lil lil adp sil $2==$4 | |
- allocate(REG={reginddef2, lb, tostring($1)})
- | %[a] | lil $2 adp $3 sil $2 |
-lil adp sil $1==$3 && $2==1 | |
- INDSTORE
- "inc *$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lil adp sil $1==$3 && $2==0-1 | |
- INDSTORE
- "dec *$1(r5)"
- setcc({LOCAL2,$1,2}) | | |
-lil adp sil $1==$3 | |
- INDSTORE
- "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 && $2==1 | |
- remove(posextern)
- "inc $1"
- setcc({relative2,$1}) | | |
-loe adp ste $1==$3 && $2==0-1 | |
- remove(posextern)
- "dec $1"
- setcc({relative2,$1}) | | |
-loe adp ste $1==$3 | |
- remove(posextern)
- "add $$$2,$1"
- setcc({relative2,$1}) | | |
-loe loi loe loi adp loe sti $3==$6 && $2==2 && $4==2 && $7==2 | |
- allocate(REG={reldef2, $1})
- | %[a] | loe $3 loi $4 adp $5 loe $6 sti $7 |
-loe loi adp loe sti $1==$4 && $2==2 && $5==2 && $3==1 | |
- INDSTORE
- "inc *$1"
- setcc({reldef2,$1}) | | |
-loe loi adp loe sti $1==$4 && $2==2 && $5==2 && $3==0-1 | |
- INDSTORE
- "dec *$1"
- setcc({reldef2,$1}) | | |
-loe loi adp loe sti $1==$4 && $2==2 && $5==2 | |
- INDSTORE
- "add $$$3,*$1"
- setcc({reldef2,$1}) | | |
-lol lof inc lol stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={LOCAL2, $1, 2})
- "inc $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-lol lof dec lol stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={LOCAL2, $1, 2})
- "dec $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 && $3==1 | |
- INDSTORE
- allocate(REG={LOCAL2, $1, 2})
- "inc $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 && $3==0-1 | |
- INDSTORE
- allocate(REG={LOCAL2, $1, 2})
- "dec $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-lol lof adp lol stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={LOCAL2, $1, 2})
- "add $3,$2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe lof inc loe stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={relative2, $1})
- "inc $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe lof dec loe stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={relative2, $1})
- "dec $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe lof adp loe stf $1==$4 && $2==$5 && $3==1 | |
- INDSTORE
- allocate(REG={relative2, $1})
- "inc $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe lof adp loe stf $1==$4 && $2==$5 && $3==0-1 | |
- INDSTORE
- allocate(REG={relative2, $1})
- "dec $2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe lof adp loe stf $1==$4 && $2==$5 | |
- INDSTORE
- allocate(REG={relative2, $1})
- "add $3,$2(%[a])"
- setcc({regind2, %[a], tostring($2)}) | | |
-loe ine $1==$2 | |
- allocate(REG={relative2, $1}) | %[a]
- | ine $2 |
-loe dee $1==$2 | |
- allocate(REG={relative2, $1}) | %[a]
- | dee $2 |
-loe loe adp ste $1==$2 && $2==$4 | |
- allocate(REG={relative2, $1}) | %[a]
- | loe $2 adp $3 ste $2 |
-#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 *
- ****************************************/
-
-#ifdef UNTESTED
-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~" | | |
-#endif
-
-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 ciu | | | | loc $1 loc $2 cuu |
-loc loc cui | | | | loc $1 loc $2 cuu |
-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)
-ldc and $2==4 && highw(1)==0 | source2 SCR_REG |
- "bic $$%(~loww(1)%),%[2]"
- erase(%[2]) | {CONST2, 0} %[1] | |
-ldc and $2==4 && highw(1)==0-1 | source2 SCR_REG |
- "bic $$%(~loww(1)%),%[2]"
- erase(%[2]) | %[2] %[1] | |
-ldc and $2==4 | SCR_REG SCR_REG |
- "bic $$%(~highw(1)%),%[1]"
- "bic $$%(~loww(1)%),%[2]"
- erase(%[1]) erase(%[2]) | %[2] %[1] | |
-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]
-ldc ior $2==4 && highw(1)==0 | source2 SCR_REG |
- "bis $$%(loww(1)%),%[2]"
- erase(%[2]) | %[2] %[1] | |
-ldc ior $2==4 && highw(1)==0-1 | source2 SCR_REG |
- "bis $$%(loww(1)%),%[2]"
- erase(%[2]) | {CONST2, 0-1} %[1] | |
-ldc ior $2==4 | SCR_REG SCR_REG |
- "bis $$%(highw(1)%),%[1]"
- "bis $$%(loww(1)%),%[2]"
- erase(%[1]) erase(%[2]) | %[2] %[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) | | |
-#ifdef UNTESTED
-rol !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,rol~"
- erase(r0) | | |
-#endif
-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) | | |
-#ifdef UNTESTED
-ror !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,ror~"
- erase(r0) | | |
-#endif
-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 | |
-#ifdef UNTESTED
-inn !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "mov (sp)+,r1"
- "jsr pc,inn~"
- erase(r01) | r0 | |
-#endif
-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) | | |
-#ifdef UNTESTED
-aar !defined($1) | | remove(all)
- "jsr pc,iaar~" | | |
-#endif
-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) | | |
-#ifdef UNTESTED
-sar !defined($1) | | remove(all)
- "jsr pc,isar~" | | |
-#endif
-lar $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jsr pc,lar~"
- erase(r01) | | |
-#ifdef UNTESTED
-lar !defined($1) | | remove(all)
- "jsr pc,ilar~" | | |
-#endif
-
-/****************************************
- * 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] | |
-ldc cmi zlt highw(1)==0 && loww(1)==0 && $2==4 | source2 source2 |
- | %[1] | zlt $3 |
-ldc cmi zge highw(1)==0 && loww(1)==0 && $2==4 | source2 source2 |
- | %[1] | zge $3 |
-cmi $1==4 | | remove(all)
- "jsr pc,cmi4~" | r0 | |
-#ifdef UNTESTED
-cmi !defined($1) | source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmi~"
- erase(r0) | r0 | |
-#endif
-cmf defined($1) | | remove(ALL)
- move({CONST2,$1},r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-#ifdef UNTESTED
-cmf !defined($1)| source2 |
- remove(ALL)
- move(%[1],r0)
- "jsr pc,cmf~"
- erase(r0) | r0 | |
-#endif
-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 | |
-#ifdef UNTESTED
-cmu !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cmu~"
- erase(r0) | r0 | |
-#endif
-cms $1==2 | | | | cmi $1 |
-ldc cms zeq $2==4 && loww(1)==0 && highw(1)==0 | source2 SCR_REG |
- remove(all)
- "bis %[1],%[2]"
- "jeq $3" | | |
-ldc cms zne $2==4 && loww(1)==0 && highw(1)==0 | source2 SCR_REG |
- remove(all)
- "bis %[1],%[2]"
- "jne $3" | | |
-ldc cms zeq $2==4 | source2 source2 |
- remove(all)
- "cmp $$%(loww(1)%),%[2]"
- "bne 1f"
- "cmp $$%(highw(1)%),%[1]"
- "jeq $3"
- "1:" | | |
-ldc cms zne $2==4 | source2 source2 |
- remove(all)
- "cmp $$%(loww(1)%),%[2]"
- "jne $3"
- "cmp $$%(highw(1)%),%[1]"
- "jne $3" | | |
-cms defined($1) | | remove(all)
- move({CONST2,$1},r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-#ifdef UNTESTED
-cms !defined($1)| source2 |
- remove(all)
- move(%[1],r0)
- "jsr pc,cms~"
- erase(r0) | r0 | |
-#endif
-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 | NC source1 source1 |
- remove(all)
- "cmpb %[2],%[1]"
- "jeq $1" | | |
-... | source2 source2 |
- remove(all)
- "cmp %[2],%[1]"
- "jeq $1" | | |
-bne | NC source1 source1 |
- remove(all)
- "cmpb %[2],%[1]"
- "jne $1" | | |
-... | 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 | source1 source1or2 |
- remove(all)
- "bitb %[1],%[2]"
- "jeq $2" | | |
-... | source1or2 source1 |
- remove(all)
- "bitb %[1],%[2]"
- "jeq $2" | | |
-... | source2 source2 |
- remove(all)
- "bit %[1],%[2]"
- "jeq $2" | | |
-and zne $1==2 | source1 source1or2 |
- remove(all)
- "bitb %[1],%[2]"
- "jne $2" | | |
-... | source1or2 source1 |
- remove(all)
- "bitb %[1],%[2]"
- "jne $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 | NC xsource2 | | | |
-... | | 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" | | |
-#ifdef UNTESTED
-ass !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "add (sp)+,sp" | | |
-#endif
-
-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 | SCR_REG SCR_REG SCR_REG |
- "asr %[1]\nbeq 2f"
- "1:mov (%[3])+,(%[2])+\nsob %[1],1b\n2:"
- erase(%[1]) erase (%[2]) erase(%[3]) | | |
-#ifdef UNTESTED
-bls !defined($1)| source2 SCR_REG SCR_REG SCR_REG |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "asr %[2]\nbeq 2f"
- "1:mov (%[4])+,(%[3])+\nsob %[2],1b\n2:"
- erase(%[2]) erase (%[3]) erase(%[4]) | | |
-#endif
-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~" | | |
-#ifdef UNTESTED
-csa !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csa~" | | |
-#endif
-lae csb $2==2 | NC source2 |
- remove(all)
- move(%[1],r1)
- move({ADDR_EXTERNAL,$1},r0)
- "jmp csb~" | | |
-... | |
- remove(all)
- move({ADDR_EXTERNAL,$1},r0)
- "mov (sp)+,r1"
- "jmp csb~" | | |
-
-csb $1==2 | |
- remove(all)
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-#ifdef UNTESTED
-csb !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "mov (sp)+,r1"
- "jmp csb~" | | |
-#endif
-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) | | |
-#ifdef UNTESTED
-dus !defined($1)| source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- "mov (sp)+,r0"
- "jsr pc,dup~"
- erase(r01) | | |
-#endif
-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~" | | |
-#ifdef UNTESTED
-rck !defined($1)| source2 source2 |
- remove(all)
- "cmp %[1],$$2"
- "beq 1f;jmp unknown~;1:"
- move(%[2],r0)
- "jsr pc,rck~" | | |
-#endif
-#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
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=pdp" "SUF=o" "ASAR=ar"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-LIBM="PREF=m" "SRC=lang/cem/libcc/libm"
-LIBLN="PREF=ln" "SRC=lang/cem/libcc/libln"
-
-install: cpstdio cpgen cplibm cplibln
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-cplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tailcp
-cplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmplibm cmplibln
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-cmplibm:
- make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tail
- -../../compare tail_m
-cmplibln:
- make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tail
- -../../compare tail_ln
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.o
+++ /dev/null
-tail_em.s.a
-RT.s
-adf.s
-adi.s
-and.s
-cff.s
-cfi.s
-cif.s
-cii.s
-ciu.s
-cmf.s
-cmi.s
-cmi4.s
-cms.s
-cmu.s
-cmu4.s
-csa.s
-csb.s
-dup.s
-dvf.s
-dvi.s
-dvi4.s
-dvu.s
-dvu2.s
-dvu4.s
-eret.s
-exg.s
-fef.s
-fif.s
-gto.s
-hlt.s
-iaar.s
-aar.s
-ilar.s
-inn.s
-isar.s
-lar.s
-los2.s
-mlf.s
-mli.s
-mli4.s
-mlu.s
-mlu4.s
-mon.s
-ngf.s
-ngi.s
-nop.s
-prf.s
-printf.s
-rck.s
-ret.s
-rmi.s
-rmi4.s
-rmu.s
-rmu2.s
-rmu4.s
-rol.s
-ror.s
-sar.s
-sbf.s
-sbi.s
-set.s
-setfl.s
-sigtrp.s
-sim.s
-sli.s
-sri.s
-sru.s
-sto2.s
-strhp.s
-unknown.s
-trp.s
-xor.s
-save.s
+++ /dev/null
-
-install: cp
-
-cp: all
- ../../install head_em
- ../../install tail_em
- rm -f head_em tail_em
-
-cmp: all
- -../../compare head_em
- -../../compare tail_em
- rm -f head_em tail_em
-
-distr:
- arch cr `head -1 LIST` `tail +2 LIST`
-
-all: head_em tail_em
-
-head_em: head_em.s
- pdp -c head_em.s ; mv head_em.o head_em
-
-tail_em:
- march . tail_em
-
-clean:
- rm -f *.o
-opr:
- make pr | opr
-pr:
- @pr `pwd`/Makefile `pwd`/head_em.s
- pr -l33 `tail +1 LIST|sort`
+++ /dev/null
-/ $Header$
- .globl PRr2,PR2r2,PR4r2,PR6r2
- .globl PRr2r4,PR2r2r4,PR4r2r4,PR6r2r4
- .globl RT,RTr2,RTr2r4
-
-PR6r2: mov $6,r0;br PRr2
-PR4r2: mov $4,r0;br PRr2
-PR2r2: mov $2,r0
-PRr2: mov r5,r1
- mov sp,r5
- sub r0,sp
- mov r2,-(sp)
- mov r1,pc
-
-PR2r2r4:mov $2,r0;br PRr2r4
-PR4r2r4:mov $4,r0;br PRr2r4
-PR6r2r4:mov $6,r0
-PRr2r4: mov r5,r1
- mov sp,r5
- sub r0,sp
- mov r2,-(sp)
- mov r4,-(sp)
- mov r1,pc
-
-RTr2r4:
- mov (sp)+,r4
-RTr2:
- mov (sp)+,r2
-RT:
- mov r5,sp
- mov (sp)+,r5
- rts pc
+++ /dev/null
-/ $Header$
-.text
-.globl aar~
-
-/r0 : descriptor address
-/r1 : element number
-/base address is on stack
-aar~:
- sub (r0),r1
- mul 04(r0),r1
- add r1,02(sp)
- rts pc
+++ /dev/null
-/ $Header$
-.text
-.globl adf~
-.globl setfloat~
-
-/size in r0
-adf~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp)+,r0
- addf (sp)+,r0
- movf r0,-(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl adi~
-.globl unknown~
-
-/size in r0
-adi~:
- mov (sp)+,r1
- cmp r0,$04
- bgt 1f
- cmp r0,$02
- bgt 2f
- add (sp)+,(sp)
- jmp (r1)
-2: add (sp)+,02(sp)
- add (sp)+,02(sp)
- adc (sp)
- jmp (r1)
-1:
- jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl and~
-
-/ size in r0
-and~:
- mov (sp)+,r3
- mov sp,r1
- add r0,r1
- asr r0
-1: com (sp)
- bic (sp)+,(r1)+
- sob r0,1b
- jmp (r3)
+++ /dev/null
-/ $Header$
-.globl blm~
-.globl save~,retu~
-
-/ Size in r0
-blm~:
- jsr pc,save~
- mov (sp)+,r2
- mov (sp)+,r3
- mov r0,r1
- asr r0
- beq 2f
-/ Now avoid wrong copy.
-/ The pieces may overlap !
- cmp r3,r2
- beq 2f
- blt 3f
-1:
- mov (r3)+,(r2)+
- sob r0,1b
-2:
- jmp retu~
-3:
- add r1,r3
- add r1,r2
-4:
- mov -(r3),-(r2)
- sob r0,4b
- br 2b
+++ /dev/null
-/ $Header$
-.text
-.globl cff~
-.globl setfloat~
-
-cff~:
- mov (sp)+,r1
- mov (sp)+,r0
- cmp (sp)+,r0
- beq 1f
- jsr pc,setfloat~
- movof (sp)+,r0
- movf r0,-(sp)
- setd
-1: jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl cfi~
-.globl setfloat~,setint~
-
-cfi~:
- mov (sp)+,r1
- mov (sp)+,r0
- jsr pc,setint~
- mov (sp)+,r0
- jsr pc,setfloat~
- movf (sp)+,r0
- movfi r0,-(sp)
- setd;seti
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl cif~,cuf~
-.globl setint~,setfloat~
-
-cif~:
- mov (sp)+,r1
- mov (sp)+,r0
- jsr pc,setfloat~
- mov (sp)+,r0
-1: jsr pc,setint~
- movif (sp)+,r0
- movf r0,-(sp)
- setd;seti
- jmp (r1)
-cuf~:
- mov (sp)+,r1
- mov (sp)+,r0
- jsr pc,setfloat~
- mov (sp)+,r0
- cmp r0,$02
- bne 1b
- clr -(sp)
- mov $04,r0
- br 1b
+++ /dev/null
-/ $Header$
-.text
-.globl cii~
-
-/convert int to int
-/ 1 byte -> ? : sign extension
-cii~:
- mov (sp)+,r3
- mov (sp)+,r0
- sub (sp)+,r0
- ble 1f
- asr r0
- bcc 2f
- movb (sp),r1
- mov r1,(sp)
-2: tst r0
- beq 3f
- tst (sp)
-4: sxt -(sp)
- sob r0,4b
-1: sub r0,sp / if out of sob loop r0==0
-3: jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl cuu~
-cuu~:
- mov (sp)+,r1
- mov (sp)+,r0
- sub (sp)+,r0
- ble 1f
- asr r0
-2: clr -(sp)
- sob r0,2b
-1: sub r0,sp / if out of sob loop r0==0
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl cmf~
-.globl setfloat~
-
-cmf~:
- jsr pc,setfloat~
- mov (sp)+,r1
- movf (sp)+,r0
- movf (sp)+,r1
- clr r0
- cmpf r0,r1
- setd
- cfcc
- beq 1f
- blt 2f
- dec r0
- jmp (r1)
-2: inc r0
-1: jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl cmi~
-.globl cmi4~,unknown~
-
-/ Size in r0
-cmi~:
- cmp r0,$02
- bne 1f
- mov (sp)+,r1
- mov (sp)+,r0
- sub (sp)+,r0
- neg r0
- jmp (r1)
-1: cmp r0,$04
- bne 2f
- jmp cmi4~
-2: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl cmi4~
-
-cmi4~:
- mov (sp)+,r1
- clr r0
- cmp (sp),4(sp)
- bgt 1f
- blt 2f
- cmp 2(sp),6(sp)
- bhi 1f
- beq 3f
-2:
- inc r0
- br 3f
-1:
- dec r0
-3:
- add $10,sp
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl cms~
-.globl save~,retu~
-
-cms~:
- jsr pc,save~
- mov r0,r2
- add sp,r2
- mov r2,r4
- add r0,r4
- asr r0
-2: cmp (sp)+,(r2)+
- bne 1f
- sob r0,2b
-1: mov r4,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl cmu~
-.globl unknown~,cmu4~
-
-cmu~:
- cmp r0,$02
- bne 3f
- mov (sp)+,r1
- clr r0
- cmp (sp)+,(sp)+
- beq 2f
- bhi 1f
- inc r0
- br 2f
-1:
- dec r0
-2:
- jmp (r1)
-3: cmp r0,$04
- bne 2f
- jmp cmu4~
-2: jmp unknown~
+++ /dev/null
-/ $Header$
- .text
- .globl cmu4~
-cmu4~:
- mov (sp)+,r1
- clr r0
- cmp (sp),4(sp)
- bhi 1f
- blo 2f
- cmp 2(sp),6(sp)
- bhi 1f
- beq 3f
-2:
- inc r0
- br 3f
-1:
- dec r0
-3:
- add $10,sp
- jmp (r1)
+++ /dev/null
-if pdp -c $1 1>&2
-then echo `basename $1 $2`.o
-else exit 1
-fi
+++ /dev/null
-/ $Header$
-.text
-.globl csa~
-.globl fat~
-
-ECASE = 20.
-
-csa~:
- sub 02(r0),r1
- blt 1f
- cmp 04(r0),r1
- blo 1f
- asl r1
- add r1,r0
- mov 06(r0),r1
- beq 2f
- jmp (r1)
-1: mov (r0),r0
- beq 2f
- jmp (r0)
-2: mov $ECASE,-(sp)
- jmp fat~
+++ /dev/null
-/ $Header$
-.text
-.globl csb~
-.globl fat~
-
-ECASE = 20.
-
-csb~:
- mov (r0)+,-(sp)
- mov (r0)+,r3
- beq 1f
-3: cmp (r0)+,r1
- beq 2f
- tst (r0)+
- sob r3,3b
-1: mov (sp)+,r1
- br 4f
-2: tst (sp)+
- mov (r0),r1
-4: beq 5f
- jmp (r1)
-5: mov $ECASE,-(sp)
- jmp fat~
+++ /dev/null
-/ $Header$
-.text
-.globl dup~
-
-dup~:
- mov (sp)+,r3
- mov sp,r1
- add r0,r1
- asr r0
-1: mov -(r1),-(sp)
- sob r0,1b
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl dvf~
-.globl setfloat~
-
-dvf~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp)+,r0
- movf (sp)+,r1
- divf r0,r1
- movf r1,-(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl dvi~
-.globl unknown~,dvi4~
-
-dvi~:
- mov (sp)+,r3
- cmp r0,$04
- bgt 1f
- beq 2f
- mov 02(sp),r1
- sxt r0
- div (sp)+,r0
- mov r0,(sp)
- br 3f
-2: jsr pc,dvi4~
- mov r1,-(sp)
- mov r0,-(sp)
-3: jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl dvi4~
-.globl save~,retu~
-
-dvi4~:
- jsr pc,save~
- mov 02(sp),r3
- sxt r4
- bpl 1f
- neg r3
-1: cmp r4,(sp)
- bne hardldiv
- mov 06(sp),r2
- mov 04(sp),r1
- bge 2f
- neg r1
- neg r2
- sbc r1
- com r4
-2: mov r4,-(sp)
- clr r0
- div r3,r0
- mov r0,-(sp)
- mov r1,r0
- mov r1,r4
- mov r2,r1
- div r3,r0
- bvc 3f
- mov r2,r1
- mov r4,r0
- sub r3,r0
- div r3,r0
- tst r1
- sxt r1
- add r1,r0
-3: mov r0,r1
- mov (sp)+,r0
- br 4f
-hardldiv:
- clr -(sp)
- mov 010(sp),r2
- mov 06(sp),r1
- bpl 5f
- com (sp)
- neg r1
- neg r2
- sbc r1
-5: clr r0
- mov 02(sp),r3
- bge 6f
- neg r3
- neg 04(sp)
- sbc r3
- com (sp)
-6: mov $16.,r4
-9: clc
- rol r2
- rol r1
- rol r0
- cmp r3,r0
- bhi 7f
- bcs 8f
- cmp 04(sp),r1
- blos 8f
-7: sob r4,9b
- br 1f
-8: sub 04(sp),r1
- sbc r0
- sub r3,r0
- inc r2
- sob r4,9b
-1:
- mov r2,r1
- clr r0
-4: tst (sp)+
- beq 1f
- neg r0
- neg r1
- sbc r0
-1: add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl dvu~
-.globl unknown~,dvu4~,dvu2~
-
-dvu~:
- mov (sp)+,r3
- cmp r0,$04
- bgt 1f
- beq 2f
- jsr pc,dvu2~
- mov r0,-(sp)
- br 3f
-2: jsr pc,dvu4~
- mov r1,-(sp)
- mov r0,-(sp)
-3: jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl dvu2~
-dvu2~:
- clr r0
- mov 04(sp),r1
- tst 02(sp)
- blt 1f
- div 02(sp),r0
-2: mov (sp)+,r1
- add $04,sp
- jmp (r1)
-1: cmp 02(sp),r1
- bhi 2b
- inc r0
- br 2b
+++ /dev/null
-/ $Header$
-.text
-.globl dvu4~
-.globl save~,retu~
-
-dvu4~:
- jsr pc,save~
- clr r0
- tst (sp)
- bne harddvu4
- tst 02(sp)
- blt harddvu4
- mov 06(sp),r2
- mov 04(sp),r1
- mov 02(sp),r3
- div r3,r0
- mov r0,-(sp)
- mov r1,r0
- mov r1,r4
- mov r2,r1
- div r3,r0
- bvc 1f
- mov r2,r1
- mov r4,r0
- sub r3,r0
- div r3,r0
- tst r1
- sxt r1
- add r1,r0
-1: mov r0,r1
- mov (sp)+,r0
- br 2f
-harddvu4:
- mov 06(sp),r2
- mov 04(sp),r1
- mov (sp),r3
- mov $17.,r4
- br 3f
-6: rol r2
- rol r1
- rol r0
-3: cmp r3,r0
- bhi 4f
- blo 5f
- cmp 02(sp),r1
- blos 5f
-4: clc
- sob r4,6b
- br 7f
-5: sub 02(sp),r1
- sbc r0
- sub r3,r0
- sec
- sob r4,6b
-7: rol r2
- bcc 8f
- mov $01,r0
- br 9f
-8: clr r0
-9: mov r2,r1
-2: add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
- .globl eret
-
-eret:
- mov r5,sp
- mov (sp)+,r5
- mov (sp)+,r4
- mov (sp)+,r2
- rts pc
+++ /dev/null
-/ $Header$
- .text
- .globl exg~
-exg~: jsr pc,save~
- mov sp,r4
- sub r0,sp
- mov sp,r3
- mov r0,r1
-1:
- mov (r4)+,(r3)+
- sob r0,1b
- asr r1
- mov sp,r4
-1:
- mov (r4)+,(r3)+
- sob r1,1b
- mov r4,sp
- jmp retu~
-
+++ /dev/null
-/ $Header$
-.text
-.globl fef~
-.globl setfloat~
-
-fef~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp),r0
- movei r0,-(sp)
- movie $0,r0
- movf r0,02(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl fif~
-.globl setfloat~
-
-fif~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp)+,r0
- modf (sp)+,r0
- movf r0,-(sp)
- movf r1,-(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl gto~
-
-gto~:
- mov (sp)+,r4
- mov 4(r4),r5
- mov 2(r4),sp
- mov (r4),pc
-/
-/ mov (sp)+,r3
-/1: cmp 4(r3),r5
-/ jeq 2f
-/ mov 2(r5),r4
-/ mov 4(r5),r2
-/ mov (r5),r5
-/ br 1b
-/2: mov 2(r3),sp
-/ jmp *(r3)
+++ /dev/null
-/ $Header$
- .globl LINO_AD,FILN_AD
- .globl ERANGE,ESET,EHEAP,EILLINS,ECASE
- .globl hol0,trppc~,trpim~,reghp~
-
-rti = 2
-stst = 170300 ^ tst
-
-.float = 1 / this should be parameterized somehow
-.hardfp = 1 / only relevant if .float on
-
-LINO_AD = 0.
-FILN_AD = 4.
-
-ERANGE = 1.
-ESET = 2.
-EFOVFL = 4.
-EFUNFL = 5.
-EFDIVZ = 7.
-EFUND = 9.
-ECONV = 10.
-EHEAP = 17.
-EILLINS = 18.
-ECASE = 20.
-
-.if .float
-/ .globl fltused; fltused:
-.if 1 - .hardfp
-/ sys 48.;4.;fptrap / if not commented it will appear as undefined
-.endif
- sys 48.;8.;sig8
- ldfps $7600
-.endif
- mov 2(sp),r0
- clr -2(r0)
- mov sp,r0
- sub $4,sp
- mov 4(sp),(sp)
- tst (r0)+
- mov r0,2(sp)
-1:
- tst (r0)+
- bne 1b
- cmp r0,*2(sp)
- blo 1f
- tst -(r0)
-1:
- mov r0,4(sp)
- jsr pc,_m_a_i_n
-/ next two lines for as long as tail needs printf
-/ mov r0,-(sp)
-/ jsr pc,*$_exit
- sys 1.
-
- .data
-hol0: 0;0 / line no
- 0;0 / file
-trppc~: 0
-trpim~: 0
-reghp~: _end
-
- .text
-sig8:
-.if .float
- mov r0,-(sp)
- stst r0
- mov 1f(r0),-(sp)
- jsr pc,trp~
- sys 48.;8.;sig8
- mov (sp)+,r0
- rti
-
- .data
-1: EILLINS; EILLINS; EFDIVZ; ECONV; EFOVFL; EFUNFL; EFUND; EILLINS
- .text
-.endif
+++ /dev/null
-/ $Header$
-.text
-.globl hlt~
-
-exit = 1
-
-hlt~:
- mov (sp)+,r0
- bne 1f
- sys exit
-1: 4
+++ /dev/null
-/ $Header$
-.text
-.globl iaar~
-.globl aar~,trp~
-
-EILLINS = 18.
-
-iaar~:
- mov (sp)+,r0
- cmp (sp)+,$02
- bne 1f
- mov 02(sp),r1
- mov r0,02(sp)
- mov (sp)+,r0
- jmp aar~
-1: mov $EILLINS,-(sp)
- jsr pc,trp~
- add $06,sp
- jmp (r0)
+++ /dev/null
-/ $Header$
-.text
-.globl ilar~
-.globl lar~,trp~
-
-EILLINS = 18.
-
-ilar~:
- mov (sp)+,r0
- cmp (sp)+,$02
- bne 1f
- mov 02(sp),r1
- mov r0,02(sp)
- mov (sp)+,r0
- jmp lar~
-1: mov $EILLINS,-(sp)
- jsr pc,trp~
- add $06,sp
- jmp (r0)
+++ /dev/null
-/ $Header$
-.text
-.globl inn~
-
-inn~:
- mov r0,-(sp)
- clr r0
- div $010,r0
- cmp r0,(sp)
- bcc 1f
- add sp,r0
- bitb bits(r1),4(r0)
- beq 1f
- mov $01,r0
- br 2f
-1: clr r0
-2: mov 02(sp),r1
- add (sp)+,sp
- tst (sp)+
- jmp (r1)
-.data
-bits: .byte 1,2,4,10,20,40,100,200
+++ /dev/null
-/ $Header$
-.text
-.globl isar~
-.globl sar~,trp~
-
-EILLINS = 18.
-
-isar~:
- mov (sp)+,r0
- cmp (sp)+,$02
- bne 1f
- mov 02(sp),r1
- mov r0,02(sp)
- mov (sp)+,r0
- jmp sar~
-1: mov $EILLINS,-(sp)
- jsr pc,trp~
- add $06,sp
- jmp (r0)
+++ /dev/null
-/ $Header$
-.text
-.globl lar~
-
-lar~:
- mov (sp)+,r3
- sub (r0),r1
- mov 04(r0),r0
- mul r0,r1
- add (sp)+,r1
- add r0,r1
- asr r0
- beq 1f
-2: mov -(r1),-(sp)
- sob r0,2b
- jmp (r3)
-1: clr r0
- bisb -(r1),r0
- mov r0,-(sp)
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl los2~
-
-los2~:
- mov (sp)+,r3
- cmp r0,$01
- bne 1f
- clr -(sp)
- bisb (r1),(sp)
- jmp (r3)
-1: add r0,r1
- asr r0
-2: mov -(r1),-(sp)
- sob r0,2b
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl mlf~
-.globl setfloat~
-
-mlf~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp)+,r0
- mulf (sp)+,r0
- movf r0,-(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl mli~
-.globl unknown~,mli4~
-
-mli~:
- cmp r0,$04
- bgt 1f
- beq 2f
- mov (sp)+,r0
- mov (sp)+,r1
- mul (sp)+,r1
- mov r1,-(sp)
- jmp (r0)
-2: mov (sp)+,r3
- jsr pc,mli4~
- mov r1,-(sp)
- mov r0,-(sp)
- jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl mli4~
-.globl save~,retu~
-
-mli4~:
- jsr pc,save~
- mov 02(sp),r2
- sxt r1
- sub (sp),r1
- mov 06(sp),r0
- sxt r3
- sub 04(sp),r3
- mul r0,r1
- mul r2,r3
- add r1,r3
- mul r2,r0
- sub r3,r0
- add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl mlu~
-.globl unknown~,mlu4~
-
-mlu~:
- cmp r0,$04
- bgt 1f
- beq 2f
- mov (sp)+,r0
- mov (sp)+,r1
- mul (sp)+,r1
- mov r1,-(sp)
- jmp (r0)
-2: mov (sp)+,r3
- jsr pc,mlu4~
- mov r1,-(sp)
- mov r0,-(sp)
- jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl mlu4~
-.globl save~,retu~
-
-mlu4~:
- jsr pc,save~
- clr r0
- mov 02(sp),r1
- mov 06(sp),r3
- mul r3,r0
- tst r3
- bge 1f
- ashc $15.,r0
-1: mov 02(sp),r3
- clr r2
- mul 04(sp),r2
- add r3,r0
- mov 06(sp),r3
- clr r2
- mul (sp),r2
- add r3,r0
- add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl mon~
-.globl sigtrp~,save~,retu~,save1~
-
-indir = 0
-fork = 2
-getpid = 20.
-sigtrp = 48.
-EBADMON = 25.
-
-HBMASK = 0177400
-REG01M = 030
-REG1M = 020
-ERRMASK = 040
-
-/ Associated with every monitor call is a descriptor.
-/ The low order three bits describe how values are returned,
-/ the next two bits specify if arguments are expected in
-/ r0 and/or r1, the next bit is not used, and the next
-/ three bits specify the number of arguments disregarding
-/ arguments in registers.
-
-mon~:
- cmp 02(sp),$sigtrp
- bne 1f
- jmp sigtrp~
-1: jsr pc,save~
- mov (sp)+,r4
- mov r4,r2
- asl r4
- mov args(r4),r3
- mov r3,r4
- bit $ERRMASK,r4
- bne err
- cmp r2,$fork
- bne 2f
- jbr fork~
-2: bic $HBMASK,r2
- bis $sys,r2
- mov r2,9f
- bit $REG01M,r3
- beq 1f
- mov (sp)+,r0
- bit $REG1M,r3
- beq 1f
- mov (sp)+,r1
-1: ash $-6,r3
- beq 2f
- mov $[9f+2],r2
-1: mov (sp)+,(r2)+
- sob r3,1b
-2: sys indir ; 9f
- bcs 2f
- clr r3
-4: asr r4
- bcc 1f
- mov r0,-(sp)
-1: asr r4
- bcc 1f
- mov r1,-(sp)
-1: asr r4
- bcc 1f
- clr -(sp)
-1: jmp retu~
-2: mov r0,-(sp)
- mov r0,-(sp)
- jmp retu~
-fork~:
- sys fork
- br 1f
- bcs 2b
- clr r1
- br 4b
-1: mov $1,r1
- br 4b
-err:
- mov $EBADMON,-(sp)
- jsr pc,trp~
- tst (sp)+
- jmp retu~
-.data
-.even
-9: .=.+12.
-args: ERRMASK / 0 : error
- 010 / 1 : exit(st); ---
- 07 / 2 : fork(); e10
- 0215 / 3 : read(addr,nb,fild); e-0
- 0215 / 4 : write(addr,nb,fild); e-0
- 0205 / 5 : open(str,flag); e-0
- 014 / 6 : close(fild); e--
- 07 / 7 : wait(); e10
- 0205 / 8 : creat(str,mode); e-0
- 0204 / 9 : link(str1,str2); e--
- 0104 /10 : unlink(str); e--
- ERRMASK /11 : error
- 0104 /12 : chdir(str); e--
- 03 /13 : time(); -10
- 0304 /14 : mknod(str,mode,addr); e--
- 0204 /15 : chmod(str,mode); e--
- 0304 /16 : chown(str,owner,grp); e--
- ERRMASK /17 : error
- 0204 /18 : stat(str,buf); e--
- 0217 /19 : lseek(high,low,fild); e10
- 01 /20 : getpid(); --0
- 0304 /21 : mount(str1,str2,fl); e--
- 0104 /22 : umount(str); e--
- 014 /23 : setuid(uid); e--
- 03 /24 : getuid(); -01
- 024 /25 : stime(high,low); e--
- 0315 /26 : ptrace(pid,addr,req,d); e-0
- 011 /27 : alarm(sec); --0
- 0114 /28 : fstat(buf,fild); e--
- 0 /29 : pause(); ---
- 0204 /30 : utime(str,timep); e--
- ERRMASK /31 : error
- ERRMASK /32 : error
- 0204 /33 : access(str,mode): e--
- 010 /34 : nice(incr); ---
- 0100 /35 : ftime(bufp); ---
- 0 /36 : sync(); ---
- 0114 /37 : kill(sig,pid); e--
- ERRMASK /38 : error
- ERRMASK /39 : error
- ERRMASK /40 : error
- 025 /41 : dup(fild,newfild); e-0
- 07 /42 : pipe(); e10
- 0100 /43 : times(buf); ---
- 0400 /44 : profil(buff,siz,off,sc); ---
- ERRMASK /45 : error
- 014 /46 : setgid(gid); e--
- 03 /47 : getgid(); -01
- 0 /48 : sigtrp(trap,sig); e-0; SPECIAL TREATMENT
- ERRMASK /49 : error
- ERRMASK /50 : error
- 0104 /51 : acct(file); e--
- 0304 /52 : phys(seg,siz,phaddr); e--
- 0104 /53 : lock(flag); e--
- 0304 /54 : ioctl(fild,req,argp); e--
- ERRMASK /55 : error
- 0204 /56 : mpxcall(cmd,vec); e--
- ERRMASK /57 : error
- ERRMASK /58 : error
- 0304 /59 : exece(name,argv,envp); e--
- 0104 /60 : umask(complmode); e--
- 0104 /61 : chroot(str); e--
+++ /dev/null
-/ $Header$
-.text
-.globl ngf~
-.globl setfloat~
-
-ngf~:
- jsr pc,setfloat~
- negf 2(sp)
- setd
- rts pc
+++ /dev/null
-/ $Header$
-.text
-.globl ngi~
-.globl unknown~
-
-ngi~:
- mov (sp)+,r1
- cmp r0,$02
- bgt 1f
- neg (sp)
- jmp (r1)
-1: cmp r0,$04
- bgt 2f
- neg (sp)
- neg 02(sp)
- sbc (sp)
- jmp (r1)
-2: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl nop~
-.globl hol0,prf~
-
-nop~:
- mov hol0,-(sp)
- mov $fmt,-(sp)
- jsr pc,prf~
- add $04,sp
- rts pc
-.data
-fmt: <test %d\n\0>
+++ /dev/null
-/ $Header$
-.text
-.globl prf~
-.globl save~,retu~,hol0,_printf
-
-prf~:
- jsr pc,save~
- mov hol0,-(sp)
- mov hol0+4,r0
- beq 1f
- mov r0,r2
- mov $40.,r1
-3: movb (r2)+,r3
- beq 2f
- cmpb r3,$0177
- bge 1f
- cmpb r3,$040
- blt 1f
- sob r1,3b
- clrb (r2)
-2: mov sp,r1
- mov r1,-(sp)
- mov r0,-(sp)
- mov $fmt,-(sp)
- jsr pc,_printf
- add $010,sp
- jsr pc,_printf
- jmp retu~
-1: mov $name,r0
- br 2b
-
-.data
-fmt: <"%s", sp = %d, line %d: \0>
-name: <_unknown file_\0>
+++ /dev/null
-/ $Header$
-.text
-.globl _printf
-
-write = 4
-
-_printf:
- mov r2,-(sp)
- mov r3,-(sp)
- mov r4,-(sp)
- mov sp,r3
- mov $buff,r4
- add $010,r3
- mov (r3)+,r2
-prloop:
- movb (r2)+,r0
- beq ready
- cmpb r0,$045
- bne 1f
- movb (r2)+,r0
- cmpb r0,$0144
- beq 2f
- cmpb r0,$0163
- beq 3f
-1: movb r0,(r4)+
- br prloop
-2: mov (r3)+,r1
- bge 4f
- movb $055,(r4)+
- neg r1
-4: jsr pc,printn
- br prloop
-printn:
- clr r0
- div $010,r0
- beq 5f
- mov r1,-(sp)
- mov r0,r1
- jsr pc,printn
- mov (sp)+,r1
-5: add $060,r1
- movb r1,(r4)+
- rts pc
-3: mov (r3)+,r1
-7: movb (r1)+,r0
- bne 6f
- br prloop
-6: movb r0,(r4)+
- br 7b
-ready:
- movb r0,(r4)+
- sub $buff,r4
- mov $01,r0
- mov $buff,9f
- mov r4,9f+2
- sys write
-9: 0; 0
- mov (sp)+,r4
- mov (sp)+,r3
- mov (sp)+,r2
- rts pc
-.data
-buff: .=.+256.
+++ /dev/null
-/ $Header$
-.text
-.globl rck~
-.globl trp~
-
-ERANGE = 1
-
-rck~:
- mov (sp)+,r1
- cmp (sp),(r0)
- blt 1f
- cmp (sp),02(r0)
- ble 2f
-1: mov $ERANGE,-(sp)
- jsr pc,trp~
-2: jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl ret~,lfr~,retar
-.globl unknown~
-
-/ Size in r0
-ret~:
- mov r0,r1
- beq 1f
- asr r1
- add $retar,r0
- cmp r0,$retend
- bhi 9f
-3: mov (sp)+,-(r0)
- sob r1,3b
-1: mov r5,sp
- mov (sp)+,r5
- rts pc
-9: jmp unknown~
-lfr~:
- mov (sp)+,r3
- asr r0
- beq 4f
- mov $retar,r1
-5: mov (r1)+,-(sp)
- sob r0,5b
-4: jmp (r3)
-
-.data
-retar: .=.+16.
-retend:
+++ /dev/null
-/ $Header$
-.text
-.globl rmi~
-.globl unknown~,rmi4~
-
-rmi~:
- mov (sp)+,r3
- cmp r0,$04
- bgt 1f
- beq 2f
- mov 02(sp),r1
- sxt r0
- div (sp)+,r0
- mov r1,(sp)
- br 3f
-2: jsr pc,rmi4~
- mov r1,-(sp)
- mov r0,-(sp)
-3: jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl rmi4~
-.globl save~,retu~
-
-rmi4~:
- jsr pc,save~
- mov 02(sp),r3
- sxt r4
- bpl 1f
- neg r3
-1: cmp r4,(sp)
- bne hardrmi4
- mov 06(sp),r2
- mov 04(sp),r1
- mov r1,r4
- bge 2f
- neg r1
- neg r2
- sbc r1
-2: mov r4,-(sp)
- clr r0
- div r3,r0
- mov r1,r0
- mov r1,r4
- mov r2,r1
- div r3,r0
- bvc 3f
- mov r2,r1
- mov r4,r0
- sub r3,r0
- div r3,r0
- tst r1
- beq 3f
- add r3,r1
-3: tst (sp)+
- bpl 4f
- neg r1
-4: sxt r0
- br 9f
-hardrmi4:
- mov 06(sp),r2
- mov 04(sp),r1
- bpl 5f
- neg r1
- neg r2
- sbc r1
-5: clr r0
- mov (sp),r3
- bge 6f
- neg r3
- neg 02(sp)
- sbc r3
-6: mov $16.,r4
-1: clc
- rol r2
- rol r1
- rol r0
- cmp r3,r0
- bhi 7f
- bcs 8f
- cmp 02(sp),r1
- blos 8f
-7: sob r4,1b
- br 2f
-8: sub 02(sp),r1
- sbc r0
- sub r3,r0
- sob r4,1b
-2: tst 04(sp)
- bge 9f
- neg r0
- neg r1
- sbc r0
-9: add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl rmu~
-.globl rmu2~,rmu4~,unknown~
-
-rmu~:
- mov (sp)+,r3
- cmp r0,$04
- bgt 1f
- beq 2f
- cmp r0,$02
- bne 1f
- jsr pc,rmu2~
- mov r1,-(sp)
- jmp (r3)
-2: jsr pc,rmu4~
- mov r1,-(sp)
- mov r0,-(sp)
- jmp (r3)
-1: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl rmu2~
-
-rmu2~:
- mov 04(sp),r1
- tst 02(sp)
- blt 1f
- clr r0
- div 02(sp),r0
-2: mov (sp)+,r0
- add $04,sp
- jmp (r0)
-1: cmp 02(sp),r1
- bhi 2b
- sub 02(sp),r1
- br 2b
+++ /dev/null
-/ $Header$
-.text
-.globl rmu4~
-.globl save~,retu~
-
-rmu4~:
- jsr pc,save~
- clr r0
- tst (sp)
- bne hardrmu4
- tst 02(sp)
- blt hardrmu4
- mov 06(sp),r2
- mov 04(sp),r1
- mov 02(sp),r3
- div r3,r0
- mov r1,r0
- mov r1,r4
- mov r2,r1
- div r3,r0
- bvc 1f
- mov r2,r1
- mov r4,r0
- sub r3,r0
- div r3,r0
- tst r1
- beq 1f
- add r3,r1
-1: clr r0
- br 2f
-hardrmu4:
- mov 06(sp),r2
- mov 04(sp),r1
- mov (sp),r3
- mov $17.,r4
- br 3f
-6: clc
- rol r2
- rol r1
- rol r0
-3: cmp r3,r0
- bhi 4f
- bcs 5f
- cmp 02(sp),r1
- blos 5f
-4: sob r4,6b
- br 2f
-5: sub 02(sp),r1
- sbc r0
- sub r3,r0
- sob r4,6b
-2: add $010,sp
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl rol~
-.globl save~,retu~
-
-rol~:
- jsr pc,save~
- mov (sp)+,r3
-3: add r0,sp
- mov r0,r1
- asr r1
- clc
-1: rol -(sp)
- sob r1,1b
- bcc 2f
- mov sp,r1
- add r0,r1
- bis $01,-(r1)
-2: sob r3,3b
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl ror~
-.globl save~,retu~
-
-ror~:
- asr r0
- jsr pc,save~
- mov (sp)+,r3
-3: mov sp,r1
- mov r0,-(sp)
- clc
-1: ror (r1)+
- sob r0,1b
- bcc 2f
- bis $0100000,02(sp)
-2: mov (sp)+,r0
- sob r3,3b
- jmp retu~
+++ /dev/null
-/ $Header$
-.text
-.globl sar~
-
-sar~:
- mov (sp)+,r3
- sub (r0),r1
- mov 04(r0),r0
- mul r0,r1
- add (sp)+,r1
- asr r0
- beq 1f
-2: mov (sp)+,(r1)+
- sob r0,2b
- jmp (r3)
-1: movb (sp)+,(r1)
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl save~,retu~,savearea
-
-save~:
- mov r5,savearea
- mov $[savearea+2],r5
- mov r4,(r5)+
- mov r3,(r5)+
- mov r2,(r5)+
- mov (sp)+,r2
- mov (sp)+,(r5)+
- jmp (r2)
-retu~:
- mov -(r5),-(sp)
- mov -(r5),r2
- mov -(r5),r3
- mov -(r5),r4
- mov -(r5),r5
- rts pc
-
-.data
-.even
-savearea:
- .=.+12.
+++ /dev/null
-/ $Header$
-.text
-.globl sbf~
-.globl setfloat~
-
-sbf~:
- mov (sp)+,r1
- jsr pc,setfloat~
- movf (sp)+,r0
- subf (sp)+,r0
- negf r0
- movf r0,-(sp)
- setd
- jmp (r1)
+++ /dev/null
-/ $Header$
-.text
-.globl sbi~
-.globl unknown~
-
-sbi~:
- mov (sp)+,r1
- cmp r0,$04
- bgt 1f
- cmp r0,$02
- bgt 2f
- sub (sp)+,(sp)
- jmp (r1)
-2: sub (sp)+,02(sp)
- sub (sp)+,02(sp)
- sbc (sp)
- jmp (r1)
-1:
- jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl set~
-.globl save~,retu~,trp~
-
-ESET = 2
-
-set~:
- jsr pc,save~
- mov r0,r2
- asr r0
-1: clr -(sp)
- sob r0,1b
- div $8.,r0
- cmp r0,r2
- blo 2f
- mov $ESET,-(sp)
- jsr pc,trp~
- jmp retu~
-2: add sp,r0
- bisb bits(r1),(r0)
- jmp retu~
-
-.data
-bits: .byte 1,2,4,10,20,40,100,200
+++ /dev/null
-/ $Header$
-.text
-.globl setfloat~,setint~
-.globl unknown~
-
-setfloat~:
- cmp r0,$8.
- bne 1f
- rts pc
-1: cmp r0,$04
- bne 3f
- setf
-2: rts pc
-3: jmp unknown~
-setint~:
- cmp r0,$04
- bne 4f
- setl
- rts pc
-4: cmp r0,$02
- bne 3b
-5: rts pc
+++ /dev/null
-/ $Header$
-.text
-.globl sigtrp~
-.globl trp~,save~,retu~
-
-indir = 0
-signal = 48.
-
-rti = 2
-
-sig1: mov sig.trp+0.,-(sp)
- br 1f
-sig2: mov sig.trp+2.,-(sp)
- br 1f
-sig3: mov sig.trp+4.,-(sp)
- br 1f
-sig4: mov sig.trp+6.,-(sp)
- br 1f
-sig5: mov sig.trp+8.,-(sp)
- br 1f
-sig6: mov sig.trp+10.,-(sp)
- br 1f
-sig7: mov sig.trp+12.,-(sp)
- br 1f
-sig10: mov sig.trp+18.,-(sp)
- br 1f
-sig11: mov sig.trp+20.,-(sp)
- br 1f
-sig12: mov sig.trp+22.,-(sp)
- br 1f
-sig13: mov sig.trp+24.,-(sp)
- br 1f
-sig14: mov sig.trp+026.,-(sp)
- br 1f
-sig15: mov sig.trp+028.,-(sp)
- br 1f
-sig16: mov sig.trp+030.,-(sp)
- br 1f
-1:
- jsr pc,trp~
- rti
-
-sigtrp~:
- jsr pc,save~
- tst (sp)+
- mov (sp)+,r1
- mov (sp)+,r0
- ble sig.bad
- cmp r0,$16.
- bhi sig.bad
- mov r0,call+02
- asl r0
- mov sig.trp-2(r0),r3
- cmp r1,$256.
- bhis 1f
- mov sig.adr-2(r0),r2
- bne 2f
-sig.bad:
- mov $-1,r0
-sigbad:
- mov r0,-(sp)
- mov r0,-(sp)
- jmp retu~
-1: cmp r1,$-3
- blo sig.bad
- mov r1,r2
- inc r2
- inc r2
-2: mov r1,sig.trp-2(r0)
- mov r2,call+04
- sys indir ; call
- bcs sigbad
- asr r0
- bcc 1f
- mov $-3,-(sp)
- clr -(sp)
- jmp retu~
-1: mov r3,-(sp)
- clr -(sp)
- jmp retu~
-
-.data
-call: sys signal; 0; 0
-sig.trp:
- -2; -2; -2; -2
- -2; -2; -2; -2
- -2; -2; -2; -2
- -2; -2; -2; -2
-sig.adr:
- sig1; sig2; sig3; sig4
- sig5; sig6; sig7; 0
- 0; sig10; sig11; sig12
- sig13; sig14; sig15; sig16
+++ /dev/null
-/ $Header$
-.text
-.globl sim~
-.globl trpim~
-
-.float = 1
-
-sim~:
- mov (sp)+,r3
- mov (sp)+,r0
- mov r0,trpim~
-.if .float
- stfps r1
- bis $07400,r1
- bit $020,r0
- beq 0f
- bic $01000,r1
-0: bit $040,r0
- beq 0f
- bic $02000,r1
-0: bit $01000,r0
- beq 0f
- bic $04000,r1
-0: bit $02000,r0
- beq 0f
- bic $0400,r1
-0: ldfps r1
-.endif
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl sli~
-.globl unknown~
-
-sli~:
- mov (sp)+,r3
- cmp r0,$02
- bgt 1f
- mov (sp)+,r1
- mov (sp)+,r0
- ash r1,r0
- mov r0,-(sp)
- jmp (r3)
-1: cmp r0,$04
- bgt 2f
- mov 02(sp),r0
- mov 04(sp),r1
- ashc (sp)+,r0
- mov r0,(sp)
- mov r1,02(sp)
- jmp (r3)
-2: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl sri~
-.globl unknown~
-
-/ Size in r0
-sri~:
- mov (sp)+,r3~
- cmp r0,$02
- bgt 1f
- mov (sp)+,r1
- mov (sp)+,r0
- neg r1
- ash r1,r0
- mov r0,-(sp)
- jmp (r3)
-1: cmp r0,$04
- bgt 2f
- mov 02(sp),r0
- mov 04(sp),r1
- neg (sp)
- ashc (sp)+,r0
- mov r0,(sp)
- mov r1,02(sp)
- jmp (r3)
-2: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl sru~,slu~
-.globl unknown~
-
-sru~:
- neg 2(sp)
-slu~:
- mov (sp)+,r3
- cmp r0,$02
- bgt 1f
- mov 2(sp),r1
- clr r0
- ashc (sp)+,r0
-2: mov r1,-(sp)
- jmp (r3)
-1: cmp r0,$04
- bgt 3f
- mov 02(sp),r0
- mov 04(sp),r1
- tst (sp)
- beq 4f
- ashc $-1,r0
- bic $0100000,r0
- inc (sp)
- beq 4f
- ashc (sp)+,r0
-4: mov r0,(sp)
- mov r1,02(sp)
- jmp (r3)
-3: jmp unknown~
+++ /dev/null
-/ $Header$
-.text
-.globl sto2~
-
-sto2~:
- mov (sp)+,r3
- cmp r0,$01
- bne 1f
- movb (sp),(r1)
- tst (sp)+
- jmp (r3)
-1: asr r0
-2: mov (sp)+,(r1)+
- sob r0,2b
- jmp (r3)
+++ /dev/null
-/ $Header$
-.text
-.globl strhp~
-.globl fat~,reghp~,_end
-indir = 0
-
-break = 17.
-EHEAP = 17.
-
-strhp~:
- mov (sp)+,r0
- mov (sp)+,r1
- mov r1,reghp~
- cmp r1,2f+2
- blos 1f
- add $01777,r1
- bic $01777,r1
- mov r1,2f+2
- sys indir ; 2f
- bcs 3f
-1: jmp (r0)
-3: mov $EHEAP,-(sp)
- jmp fat~
-.data
-2: sys break; _end
+++ /dev/null
-/ $Header$
-.text
-.globl trp~,fat~
-.globl trppc~,trpim~,savearea,retar
- write=4.
-
-fat~:
- jsr pc,trp~
- 4
-
-trp~:
- mov r0,-(sp)
- mov 04(sp),r0
- mov 02(sp),04(sp)
- mov (sp),02(sp)
- mov r1,(sp)
- cmp r0,$16.
- jhis 0f
- mov $01,r1
- ashc r0,r1
- bit r1,trpim~
- bne 8f
-0: mov r2,-(sp)
- mov r3,-(sp)
- mov r4,-(sp)
- movf r0,-(sp)
- movf r1,-(sp)
- movf r2,-(sp)
- movf r3,-(sp)
- stfps -(sp)
- mov $savearea,r2
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov $retar,r2
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov (r2)+,-(sp)
- mov r0,-(sp)
- mov trppc~,r0
- beq 9f
- clr trppc~
- jsr pc,(r0)
- tst (sp)+
- mov $retar+16.,r2
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov $savearea+12.,r2
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- mov (sp)+,-(r2)
- ldfps (sp)+
- movf (sp)+,r3
- movf (sp)+,r2
- movf (sp)+,r1
- movf (sp)+,r0
- mov (sp)+,r4
- mov (sp)+,r3
- mov (sp)+,r2
-8: mov (sp)+,r1
- mov (sp)+,r0
- rts pc
-9: mov (sp)+,r0
- mov $buf+11,r1
- mov $4,r2
-1: mov r0,r3
- bic $177770,r3
- bisb r3,-(r1)
- ash $-3,r0
- sob r2,1b
- mov $2,r0
- sys write;buf;11.
- 4
-
-.data
-buf: <err 00000\n>
+++ /dev/null
-/ $Header$
-.text
-.globl unknown~
-.globl fat~
-
-EILLSIZ = 19.
-
-unknown~:
- mov $EILLSIZ,-(sp)
- jmp fat~
+++ /dev/null
-/ $Header$
-.globl xor~
-.globl save~,retu~
-
-xor~:
- jsr pc,save~
- mov sp,r1
- add r0,r1
- asr r0
-1:
- mov (sp)+,r2
- xor r2,(r1)+
- sob r0,1b
- jmp retu~
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=pdp -Rbe-p2" "SUF=o" "ASAR=ar"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I/usr/em/h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.o
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=pdp -Rbe-p2" "SUF=s" "ASAR=ar"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-LIBDIR=../lib
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- cmp head_pc $(LIBDIR)/head_pc
- cmp tail_pc $(LIBDIR)/tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-CFLAGS=-O
-
-cv: cv.o
- $(CC) -o cv -n cv.o
-
-pmcv: pmcv.o
- $(CC) -o pmcv -n pmcv.o
-
-install: ins_cv ins_pmcv
-ins_cv: cv
- ../../install cv
-ins_pmcv: pmcv
- ../../install pmcv
-
-cmp: cmp_cv cmp_pmcv
-cmp_cv: cv
- -../../compare cv
-cmp_pmcv: pmcv
- -../../compare pmcv
-
-opr:
- make pr | opr
-
-pr:
- @pr `pwd`/cv.c `pwd`/pmcv.c
-
-clean:
- -rm -f *.o *.old cv pmcv
+++ /dev/null
-/* The format of the a.out files produced by the assemblers
- is machine dependent.
- This program acts as a gateway between two machines and it's effect
- is independent of the machine it executes on.
- The a.out file is assumed to be made on a pdp-11
- while the target machine is a Philip Microcomputer Development system
-
-*/
-
-#include <stdio.h>
-
-main(argc,argv) char **argv ; {
- char i_addr[4];
- short count;
- char i_count[2];
-
- if (argc != 3) {
- fprintf(stderr,"Usage: %s pdp-a.out VU-pmds-a.out\n",argv[0]);
- exit(-1);
- }
- if (freopen(argv[1],"r",stdin)==NULL) {
- perror(argv[1]);
- exit(-1);
- }
- if (freopen(argv[2],"w",stdout)==NULL) {
- perror(argv[2]);
- exit(-1);
- }
- while (fread(&i_addr,sizeof i_addr,1,stdin)==1) {
- putchar(i_addr[1]) ; putchar(i_addr[0]) ;
- putchar(i_addr[3]) ; putchar(i_addr[2]) ;
- if (fread(&i_count,sizeof i_count,1,stdin)!=1)
- exit(fprintf(stderr,"foo\n"));
- putchar(i_count[1]) ; putchar(i_count[0]) ;
- count= ((i_count[1]&0377)<<8) | (i_count[0]&0377) ;
- while (count--) {
- putchar(getchar());
- }
- }
- return 0;
-}
+++ /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_reg)
- 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_reg)
- 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
- */
-
-#ifndef newplb /* retrofit for older mach.h */
-#define newplb newilb
-#endif
-
-#ifdef fmt_id
-#ifdef id_first
-It is an error to define both fmt_id and id_first.
-Read the documentation.
-#endif
-#endif
-
-#ifdef fmt_ilb
-#ifdef ilb_fmt
-It is an error to define both fmt_ilb and ilb_fmt.
-Read the documentation.
-#endif
-#endif
-
-/* 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 += TEM_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 != TEM_WSIZE)
- fatal("bad word size");
- getarg(ptyp(sp_cst2));
- if (argval != TEM_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;
- if (r_off >= 0)
- r_off += TEM_BSIZE;
- 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)));
- newplb(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:
-#ifdef fmt_ilb
- fmt_ilb(procno,((int) argval),argstr);
-#else
- sprintf(argstr,ilb_fmt,procno,(int)argval);
-#endif
- 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:
-#ifdef fmt_id
- fmt_id(str,argstr);
-#else
- p = argstr;
- if (strsiz < 8 || str[0] == id_first)
- *p++ = id_first;
- sprintf(p,"%.*s",strsiz,str);
-#endif
- 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 % TEM_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 % TEM_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)TEM_PSIZE);
- case sp_dlb1:
- case sp_dlb2:
- case sp_dnam:
- case sp_doff:
- part_flush();
- con_dlb(argstr);
- return((long)TEM_PSIZE);
- case sp_cstx:
- con_part(TEM_WSIZE,(word)argval);
- return((long)TEM_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 > TEM_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[BUFSIZ];
-
- 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);
- erasereg(tp2->t_att[0].ar);
- 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
-
-#ifndef NORCSID
-static char rcsid[] = "$Header$";
-#endif
-
-#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
- */
-extern string myalloc();
-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],(long)-TEM_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();
-}
-
-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
- */
-
-extern 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,a5,a6,a7,a8) char *s; {
-
- fatal(s,a1,a2,a3,a4,a5,a6,a7,a8);
-}
-
-fatal(s,a1,a2,a3,a4,a5,a6,a7,a8) char *s; {
-
- fprintf(stderr,"Error: ");
- fprintf(stderr,s,a1,a2,a3,a4,a5,a6,a7,a8);
- 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 TEM_WSIZE
-TEM_WSIZE should be defined at this point
-#endif
-#ifndef TEM_PSIZE
-TEM_PSIZE should be defined at this point
-#endif
-#if TEM_WSIZE>4 || TEM_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 TEM_WSIZE>2 || TEM_PSIZE>2
-#define full long
-#else
-#define full int
-#endif
-
-#if TEM_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$
-
-MACH=MACHINE
-MACHFL=-c.$(SUF) -O -L
-SUB =
-PREF=pc
-ASAR=arch
-SRC=lang/pc/libpc
-HOME = ../../..
-HEADSRC=$(HOME)/$(SRC)/head_$(PREF).e
-
-all: head tail
-
-head: head_$(PREF) $(HOME)/h/*.h
-
-tail: tail_$(PREF)$(SUB) $(HOME)/h/*.h
-
-headcp: head
- ../../install head_$(PREF)
- rm -f head_$(PREF)
-
-tailcp: tail
- ../../install tail_$(PREF)$(SUB)
- rm -f tail_$(PREF)$(SUB)
-
-cp: headcp tailcp
-
-head_$(PREF): $(HEADSRC)
- cp $(HEADSRC) head_$(PREF).e
- $(MACH) $(MACHFL) head_$(PREF).e
- mv head_$(PREF).$(SUF) head_$(PREF)
- -rm -f head_$(PREF).[ekm$(SUF)]
-
-tail_$(PREF)$(SUB):
- @echo translation test
- @$(MACH) $(MACHFL) $(HOME)/mach/proto/libg/barrier.c
- @-rm barrier.[oeskm]
- @echo OK
- -rm -f tail_$(PREF)$(SUB)
- MACH="$(MACH)" MACHFL="$(MACHFL) -LIB" ASAR=$(ASAR) \
- march $(HOME)/$(SRC) tail_$(PREF)$(SUB)
+++ /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$ --------
-The file "table" is too large. The "cgg" program cannot generate
-"tables.h" and "tables.c" on a PDP 11/44.
-Therefore the distribution includes two files "tables1.c" and "tables1.h",
-which you can copy to "tables.c" and "tables.h".
-Make sure "tables.c" and "tables.h" are newer than "table",
-before trying again. They also must be newer than the "cgg" program
-(../../../lib/cgg).
+++ /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
- *
- */
-
-/* Machine dependent back end routines for the VAX using 4-byte words
- */
-
-con_part(sz,w) register sz; word w; {
-
- /* Byte order: | 3 | 2 | 1 | 0 | */
-
- /* Align new bytes on boundary of its on size. */
- while (part_size % sz) part_size++;
-
- if (part_size == EM_WSIZE)
- part_flush();
- if (sz == 1 || sz == 2) {
- /* Smaller than a machineword. */
- w &= (sz == 1 ? 0xFF : 0xFFFF);
- w <<= 8 * part_size;
- part_word |= w;
- } else {
- assert(sz == 4);
- part_word = w;
- }
- part_size += sz;
-} /* con_part */
-
-con_mult(sz) word sz; {
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- fprintf(codefile,".long\t%s\n",str);
-}
-
-mes(mesno) word mesno ; {
- while (getarg(any_ptyp) != sp_cend );
-}
-
-con_float() {
-
- /* Insert a dot at the right position, if it is not present,
- * to make the floating point constant acceptable to the assembler.
- */
- register char * c;
- extern char * index();
-
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- if (argval == 8)
- fprintf(codefile,".double\t0d");
- else fprintf(codefile,".float\t0f");
-
- if (index(str,'.') != (char *) 0) {
- fprintf(codefile,"%s\n",str);
-
- /* There must be a dot after the `e' or - if the `e' is not present -
- * at the end.
- */
- } else if ((c = index(str,'e')) != (char *) 0) {
- *c++ = '\0';
- fprintf(codefile,"%s.e%s\n",str,c--);
- *c = 'e';
- } else fprintf(codefile,"%s.\n",str);
-} /* con_float */
-
-#ifndef REGVARS
-prolog(nlocals) full nlocals; {
-
- fprintf(codefile,"\tpushl\tfp\n\tmovl\tsp,fp\n");
- if (nlocals == 0)
- return;
- if (nlocals == 4)
- fprintf(codefile,"\tclrl\t-(sp)\n");
- else if (nlocals == 8)
- fprintf(codefile,"\tclrq\t-(sp)\n");
- else
- fprintf(codefile,"\tsubl2\t$%ld,sp\n",nlocals);
-}
-
-#endif REGVARS
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".data" /* SEGBSS */
-};
-
-#ifdef REGVARS
-int EM_BSIZE; /* Difference between AB and LB. */
-static int nlocals; /* Number of local variables. */
-
-#define NR_REG 8 /* Number of registers. */
-#define FIRST_REG 4
-#define LAST_REG (FIRST_REG + NR_REG - 1)
-
-prolog(n) { /* Save number of locals. */
- nlocals = n;
-}
-
-/*
- * Structure to store information about the registers to be stored.
- */
-static struct s_reg {
- char * sr_str; /* Name of register used. */
- long sr_off; /* Offset from LB. */
- int sr_size;/* Size in bytes. */
-} a_reg[NR_REG + 1], *p_reg;
-
-i_regsave() { /* Initialize saving of registers. */
- EM_BSIZE = 0;
- p_reg = a_reg;
-}
-
-regsave(str, off, size) char * str; long off; int size; {
-
- /* Called for each register to be saved. */
-
- p_reg->sr_str = str;
- p_reg->sr_off = off;
- (p_reg++)->sr_size = size;
- fprintf(codefile,
- "\t# Local %ld, size %d, to register %s\n",
- off, size, str
- );
-}
-
-f_regsave() {
-
- register struct s_reg * p;
- register int mask;
- register int i;
- register int count;
-
- mask = 0;
- count = p_reg - a_reg;
- for (p = a_reg; p < p_reg; p++) {
- /* For each register to be saved, set a bit in the
- * mask corresponding to its number.
- */
- i = atoi(p->sr_str + 1);
- if (p->sr_size <= 4)
- mask |= (1 << i);
- else {
- mask |= (3 << i);
- count++;
- }
- }
-
- /* Generate code to save registers. */
- if (count > 2)
- fprintf(codefile, "pushr\t$%d\n", mask);
- else
- for (i = FIRST_REG; i <= LAST_REG; i++) {
- /* For all registers that can be used,
- * see if it must be saved, and do that as cheap
- * as possible.
- */
- if (((mask >> i) & 03) == 03) {
- fprintf(codefile, "movq\tr%d,-(sp)\n",i);
- break;
- } else if ((1 << i) & mask) {
- if (count == 1)
- fprintf(codefile,"pushl\tr%d\n",i);
- else
- fprintf(codefile,"pushr\t$%d\n",mask);
- break;
- }
- }
-
- /* Save a word indicating which registers were saved.
- * The count uniquely specifies which registers were saved, because
- * registers are always allocated consecutively within a class,
- * starting from FIRST_REG. I only have one class.
- */
- fprintf(codefile, "pushl\t$%d\n", count);
-
- /* Compute AB - LB. */
- EM_BSIZE = 4 * count + 12;
-
- /* Now finish the procedure prolog. */
- fprintf(codefile, "pushl\tfp\nmovl\tsp,fp\n");
-
- /* Emit code to initialize parameters in registers. */
- for (p = a_reg; p < p_reg; p++) {
- if (p->sr_off >= 0) {
- if (p->sr_size == 4) {
- fprintf(codefile,
- "movl\t%ld(fp),%s\n",
- p->sr_off + EM_BSIZE, p->sr_str
- );
- } else if (p->sr_size == 8) {
- fprintf(codefile,
- "movq\t%ld(fp),%s\n",
- p->sr_off + EM_BSIZE, p->sr_str
- );
- }
- }
- }
-
- /* Generate room for locals. */
- if (nlocals == 0)
- return;
- if (nlocals == 4)
- fprintf(codefile,"clrl\t-(sp)\n");
- else if (nlocals == 8)
- fprintf(codefile,"clrq\t-(sp)\n");
- else
- fprintf(codefile,"subl2\t$%ld,sp\n",nlocals);
-
-} /* f_regsave */
-
-regreturn() {
-
- fprintf(codefile, "jmp\t.return\n");
-} /* regreturn */
-
-regscore(off, size, typ, score, totyp) long off; {
-
- register int i;
-
- i = score; /* Local/parameter is used score times. */
-
- /* If the offset doesn't fit in a byte, word-offset is used,
- * which is one byte more expensive.
- */
- if (off > 109 || off < -128) i *= 2; /* Word offset. */
-
- /* 109: guestimate. We don't know AB -LB yet.
- * 109 is the number if there are two registervariables.
- */
-
- /* Compute cost of initialization for parameters. */
- if (off > 109)
- i -= 5;
- else if (off >= 0)
- i -= 4;
-
- if (typ == reg_pointer)
- i += score; /* Sometimes saves an instruction. */
- else if (typ == reg_loop)
- i += 5;
-
- i -= 2; /* Cost of save. */
-
- /* Actually the first registers are more expensive, but then
- * the following registers are cheaper.
- */
-
- return (i);
-} /* regscore */
-
-#endif REGVARS
+++ /dev/null
-/* $Header$ */
-#define ex_ap(x) fprintf(codefile,".globl\t%s\n",x)
-#define in_ap(x) /* nothing */
-
-#define newilb(x) fprintf(codefile,"%s:\n",x)
-#define newdlb(x) fprintf(codefile,"%s:\n",x)
-#define dlbdlb(s1,s2) fprintf(codefile,"%s = %s\n",s1,s2)
-#define newlbss(x,f) fprintf(codefile,"%s:.space\t%ld\n",x,f)
-
-#define cst_fmt "$%ld"
-#define off_fmt "%ld"
-#define ilb_fmt "I%03x%04x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "%ld+hol%d"
-
-#define con_cst(w) fprintf(codefile,".long\t%ld\n",w)
-#define con_ilb(x) fprintf(codefile,".long\t%s\n",x)
-#define con_dlb(x) fprintf(codefile,".long\t%s\n",x)
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-"$Header$"
-#define SL 8
-#define SSL "8"
-#define DL 0
-#define SDL ""
-
-#define LOCLABS /* define if target assembler recognizes local labels */
-#define REGVARS /* define for register variables */
-
-/*#define DORCK /* define if you want RCK */
-/*#define FLOAT4 /* define if you want better 4-byte FP arithmetic */
-
-EM_PSIZE = 4
-EM_WSIZE = 4
-#ifndef REGVARS
-EM_BSIZE = SL
-#endif REGVARS
-
-#define NC nocoercions :
-
-/****************************************************************
- * VAX 11 Back end table. *
- * Author : Ceriel J.H. Jacobs, Duk Bekema *
- * *
- * Wordsize = 4 bytes *
- * Pointersize = 4 bytes *
- * *
- * There is hardly any instruction timing information available *
- * for the DEC-VAX machines. Timing of addressing modes was done*
- * by counting the memory references and multiplying them by *
- * 3. 300 nanosec seems to be a typical memory reference time.*
- * However, the VAX can be much faster, if the "cache hit rate" *
- * is high. *
- * Assumed hardware : VAX-11/7?0 with Floating Point Acc. *
- ****************************************************************/
-
-REGISTERS:
-LB = ("fp",4),LocaLBase.
-R0 = ("r0",4),REG,RRET.
-R1 = ("r1",4),REG.
-R2 = ("r2",4),REG.
-R3 = ("r3",4),REG.
-#ifdef REGVARS
-R4 = ("r4",4) regvar,RREG.
-R5 = ("r5",4) regvar,RREG.
-R6 = ("r6",4) regvar,RREG.
-R7 = ("r7",4) regvar,RREG.
-R8 = ("r8",4) regvar,RREG.
-R9 = ("r9",4) regvar,RREG.
-RA = ("r10",4) regvar,RREG.
-RB = ("r11",4) regvar,RREG.
-#else REGVARS
-R4 = ("r4",4),REG.
-R5 = ("r5",4),REG.
-R6 = ("r6",4),REG.
-R7 = ("r7",4),REG.
-R8 = ("r8",4),REG.
-R9 = ("r9",4),REG.
-RA = ("r10",4),REG.
-RB = ("r11",4),REG.
-#endif REGVARS
-QR0 = ("r0",8,R0,R1),QREG,QRET.
-QR2 = ("r2",8,R2,R3),QREG.
-QR4 = ("r4",8,R4,R5),QREG.
-QR6 = ("r6",8,R6,R7),QREG.
-QR8 = ("r8",8,R8,R9),QREG.
-QRA = ("r10",8,RA,RB),QREG.
-QR1 = ("r1",8,R1,R2),QREG.
-QR3 = ("r3",8,R3,R4),QREG.
-QR5 = ("r5",8,R5,R6),QREG.
-QR7 = ("r7",8,R7,R8),QREG.
-QR9 = ("r9",8,R9,RA),QREG.
-
-TOKENS:
-
-/* First some EM machine tokens */
-CONST1 = {INT num;} 4 cost=(4,3) "$%[num]"
-CONST2 = {INT num;} 4 cost=(4,3) "$%[num]"
-CONST4 = {INT num;} 4 cost=(4,3) "$%[num]"
-CONST8 = {STRING ind;} 8 cost=(8,6) "$%[ind]"
-FCONST8 = {INT num;} 8 cost=(8,6) "$0f%[num].0"
-LOCAL1 = {INT num,size;} 4 cost=(2,6) "%[num](fp)"
-LOCAL2 = {INT num,size;} 4 cost=(2,6) "%[num](fp)"
-LOCAL4 = {INT num,size;} 4 cost=(2,6) "%[num](fp)"
-LOCAL8 = {INT num,size;} 8 cost=(2,6) "%[num](fp)"
-ADDR_LOCAL = {INT num;} 4 cost=(2,6) "%[num](fp)"
-ADDR_EXTERNAL = {STRING ind;} 4 cost=(4,6) "%[ind]"
-EXTERNAL1 = {STRING ind;} 4 cost=(4,6) "%[ind]"
-EXTERNAL2 = {STRING ind;} 4 cost=(4,6) "%[ind]"
-EXTERNAL4 = {STRING ind;} 4 cost=(4,6) "%[ind]"
-EXTERNAL8 = {STRING ind;} 8 cost=(4,9) "%[ind]"
-DOUBLE = {STRING ind;} 4 cost=(4,6) "$%[ind]"
-/* Now tokens for the target machine */
-regdef1 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])"
-regdef2 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])"
-regdef4 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])"
-regdef8 = {REGISTER reg;} 8 cost=(0,6) "(%[reg])"
-#ifdef REGVARS
-reginc1 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])+"
-reginc2 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])+"
-reginc4 = {REGISTER reg;} 4 cost=(0,3) "(%[reg])+"
-reginc8 = {REGISTER reg;} 8 cost=(0,6) "(%[reg])+"
-regdec1 = {REGISTER reg;} 4 cost=(0,3) "-(%[reg])"
-regdec2 = {REGISTER reg;} 4 cost=(0,3) "-(%[reg])"
-regdec4 = {REGISTER reg;} 4 cost=(0,3) "-(%[reg])"
-regdec8 = {REGISTER reg;} 8 cost=(0,6) "-(%[reg])"
-#endif REGVARS
-displ1 = {REGISTER reg; STRING ind;} 4 cost=(2,6) "%[ind](%[reg])"
-displ2 = {REGISTER reg; STRING ind;} 4 cost=(2,6) "%[ind](%[reg])"
-displ4 = {REGISTER reg; STRING ind;} 4 cost=(2,6) "%[ind](%[reg])"
-displ8 = {REGISTER reg; STRING ind;} 8 cost=(2,9) "%[ind](%[reg])"
-displdef1 = {REGISTER reg; STRING ind;} 4 cost=(2,9) "*%[ind](%[reg])"
-displdef2 = {REGISTER reg; STRING ind;} 4 cost=(2,9) "*%[ind](%[reg])"
-displdef4 = {REGISTER reg; STRING ind;} 4 cost=(2,9) "*%[ind](%[reg])"
-displdef8 = {REGISTER reg; STRING ind;} 8 cost=(2,12) "*%[ind](%[reg])"
-reldef1 = {STRING ind;} 4 cost=(4,9) "*%[ind]"
-reldef2 = {STRING ind;} 4 cost=(4,9) "*%[ind]"
-reldef4 = {STRING ind;} 4 cost=(4,9) "*%[ind]"
-reldef8 = {STRING ind;} 8 cost=(4,12) "*%[ind]"
-extind2 = {REGISTER ireg; STRING ind; } 4 cost=(5,10) "%[ind] [%[ireg]]"
-extind4 = {REGISTER ireg; STRING ind; } 4 cost=(5,10) "%[ind] [%[ireg]]"
-extind8 = {REGISTER ireg; STRING ind; } 8 cost=(5,13) "%[ind] [%[ireg]]"
-displind1 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-displind2 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-displind4 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-displind8 = {REGISTER ireg,reg; STRING ind;} 8 cost=(3,13)
- "%[ind](%[reg]) [%[ireg]]"
-extdefind1 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-extdefind2 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-extdefind4 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-extdefind8 = {REGISTER ireg; STRING ind; } 8 cost=(5,16) "*%[ind] [%[ireg]]"
-displdefind1 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-displdefind2 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-displdefind4 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-displdefind8 = {REGISTER ireg,reg; STRING ind;} 8 cost=(3,16)
- "*%[ind](%[reg]) [%[ireg]]"
-
-/* Not really addressable modes */
-adispl = {REGISTER reg; STRING ind; } 4 cost=(4,6) "%[ind](%[reg])"
-aextind2 = {REGISTER ireg; STRING ind; } 4 cost=(5,10) "%[ind] [%[ireg]]"
-aextind4 = {REGISTER ireg; STRING ind; } 4 cost=(5,10) "%[ind] [%[ireg]]"
-aextind8 = {REGISTER ireg; STRING ind; } 4 cost=(5,10) "%[ind] [%[ireg]]"
-adisplind1 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-adisplind2 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-adisplind4 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-adisplind8 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,10)
- "%[ind](%[reg]) [%[ireg]]"
-aextdefind1 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-aextdefind2 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-aextdefind4 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-aextdefind8 = {REGISTER ireg; STRING ind; } 4 cost=(5,13) "*%[ind] [%[ireg]]"
-adispldefind1 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-adispldefind2 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-adispldefind4 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-adispldefind8 = {REGISTER ireg,reg; STRING ind;} 4 cost=(3,13)
- "*%[ind](%[reg]) [%[ireg]]"
-
-
-TOKENEXPRESSIONS:
-CONST = CONST1 + CONST2 + CONST4
-source1 = regdef1 + displ1 + displdef1 +
- EXTERNAL1 + reldef1 + CONST1 + LOCAL1
- + displind1 + extdefind1 + displdefind1
-#ifdef REGVARS
- + reginc1 + regdec1
-#endif REGVARS
-source2 = regdef2 + displ2 + displdef2 +
- EXTERNAL2 + reldef2 + CONST2 + LOCAL2
- + extind2 + displind2 + extdefind2 + displdefind2
-#ifdef REGVARS
- + reginc2 + regdec2
-#endif REGVARS
-source4 = REG + regdef4 + displ4 + displdef4 + LocaLBase +
- EXTERNAL4 + reldef4 + CONST + DOUBLE + LOCAL4
- + extind4 + displind4 + extdefind4 + displdefind4
-#ifdef REGVARS
- + RREG + reginc4 + regdec4
-#endif REGVARS
-noaddr4 = source4 - REG - displ4 - EXTERNAL4
-source8 = QREG + regdef8 + displ8 + displdef8 +
- EXTERNAL8 + reldef8 + CONST8 + LOCAL8
- + extind8 + displind8 + extdefind8 + displdefind8
-#ifdef REGVARS
- + reginc8 + regdec8
-#endif REGVARS
-source1or2 = source1 + source2
-source1or2or4 = source1or2 + source4
-source2or4 = source2 + source4
-registers = QREG + REG
-nonexist1 = adispl + ADDR_EXTERNAL + ADDR_LOCAL
-aextind = aextind2 + aextind4 + aextind8
-adisplind = adisplind1 + adisplind2 + adisplind4 + adisplind8
-aextdefind = aextdefind1 + aextdefind2 + aextdefind4 + aextdefind8
-adispldefind = adispldefind1 + adispldefind2 + adispldefind4 + adispldefind8
-ind2 = extind2 + displind2 + extdefind2 + displdefind2
-ind4 = extind4 + displind4 + extdefind4 + displdefind4
-aind1 = adisplind1 + aextdefind1 + adispldefind1
-aind2 = aextind2 + adisplind2 + aextdefind2 + adispldefind2
-aind4 = aextind4 + adisplind4 + aextdefind4 + adispldefind4
-aind8 = aextind8 + adisplind8 + aextdefind8 + adispldefind8
-aind = aind1 + aind2 + aind4 + aind8
-nonexist = nonexist1 + aind
-#ifdef REGVARS
-regch4 = reginc1 + regdec1 + reginc2 + regdec2 + reginc4 + regdec4
-regch8 = reginc8 + regdec8
-regch = regch4 + regch8
-#endif REGVARS
-displs = displ1 + displ2 + displ4 + displ8
- + regdef1 + regdef2 + regdef4 + regdef8
-#ifdef REGVARS
- + regch
-#endif REGVARS
-displdefs = displdef1 + displdef2 + displdef4 + displdef8
-EXTERNALS = EXTERNAL1 + EXTERNAL2 + EXTERNAL4 + EXTERNAL8
-LOCALS = LOCAL1 + LOCAL2 + LOCAL4 + LOCAL8
-reldefs = reldef1 + reldef2 + reldef4 + reldef8
-displinds = displind1 + displind2 + displind4 + displind8
-extinds = extind2 + extind4 + extind8
-displdefinds = displdefind1 + displdefind2 + displdefind4 + displdefind8
-extdefinds = extdefind1 + extdefind2 + extdefind4 + extdefind8
-displaced = displs + displdefs + reldefs
- + displinds + displdefinds + extdefinds
-externals = EXTERNALS + displaced + extinds
-extandloc = externals + LOCALS
-#ifdef REGVARS
-reg4 = REG + RREG
-reg8 = QREG
-#else REGVARS
-reg4 = REG
-reg8 = QREG
-#endif REGVARS
-sreg4 = REG * SCRATCH
-nosreg4 = source4 - sreg4
-sreg8 = QREG * SCRATCH
-nosreg8 = source8 - sreg8
-bigsource4 = source1or2or4 + nonexist
-bigsource8 = source8 + FCONST8
-all = bigsource4 + bigsource8
-#ifdef REGVARS
-#define REMEXTANDLOC remove(externals) remove(LOCALS,inreg(%[num])==0)
-#define REMREG(x) remove(regch,%[reg]==regvar(x))
-#else REGVARS
-#define REMEXTANDLOC remove(extandloc)
-#endif REGVARS
-
-CODE:
-
-/********************************
- * Group 1 : Load instructions *
- ********************************/
-
-loc $1>=0 && $1<256 | | | {CONST1, $1} | |
-loc $1>=256 && $1<65536 | | | {CONST2, $1} | |
-loc | | | {CONST4, $1} | |
-loc loc $1==0 && $2==0 | | | {FCONST8, 0} | |
-ldc | | | {CONST8,$1} | |
-#ifdef REGVARS
-lol inreg($1)==2 | | | regvar($1) | |
-#endif REGVARS
-lol | | | {LOCAL4, $1, 4} | |
-loe | | | {EXTERNAL4, $1} | |
-#ifdef REGVARS
-lil inreg($1)==2 | | REMREG($1) | {regdef4,regvar($1)} | |
-#endif REGVARS
-lil | | | {displdef4,LB, tostring($1)} | |
-lof | | | | adp $1 loi 4 |
-lal | | | {ADDR_LOCAL, $1} | |
-lae | | | {ADDR_EXTERNAL, $1} | |
-lxl $1==0 | | | LB | |
-lxl $1>0 | | remove(ALL)
- move({CONST4,$1},R0)
- "jsb\t.lxl"
- erase(R0) | R0 | |
-lxa | | remove(ALL)
- move({CONST4,$1},R0)
- "jsb\t.lxa"
- erase(R0) | R0 | |
-loi $1==1 | NC adispl |
- | {displ1,%[1.reg],%[1.ind]} | |
-... | reg4 | | {regdef1,%[1]} | |
-... | NC ADDR_LOCAL | | {LOCAL1, %[1.num],1} | |
-... | displ4 |
- | {displdef1,%[1.reg],%[1.ind]} | |
-... | NC LOCAL4 |
- | {displdef1, LB, tostring(%[1.num])} | |
-... | NC ADDR_EXTERNAL |
- | {EXTERNAL1,%[1.ind]} | |
-... | NC EXTERNAL4 |
- | {reldef1,%[1.ind]} | |
-... | NC adisplind1 |
- | {displind1,%[1.ireg],%[1.reg],%[1.ind]} | |
-... | NC aextdefind1 |
- | {extdefind1,%[1.ireg],%[1.ind]} | |
-... | NC adispldefind1 |
- | {displdefind1,%[1.ireg],%[1.reg],%[1.ind]} | |
-loi $1==2 | NC adispl |
- | {displ2,%[1.reg],%[1.ind]} | |
-... | reg4 | | {regdef2,%[1]} | |
-... | NC ADDR_LOCAL | | {LOCAL2, %[1.num],2} | |
-... | displ4 |
- | {displdef2,%[1.reg],%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {EXTERNAL2,%[1.ind]} | |
-... | NC EXTERNAL4 |
- | {reldef2,%[1.ind]} | |
-... | NC aextind2 |
- | {extind2,%[1.ireg],%[1.ind]} | |
-... | NC adisplind2 |
- | {displind2,%[1.ireg],%[1.reg],%[1.ind]} | |
-... | NC aextdefind2 |
- | {extdefind2,%[1.ireg],%[1.ind]} | |
-... | NC adispldefind2 |
- | {displdefind2,%[1.ireg],%[1.reg],%[1.ind]} | |
-loi $1==4 | NC adispl |
- | {displ4,%[1.reg],%[1.ind]} | |
-... | reg4 | | {regdef4,%[1]} | |
-... | NC ADDR_LOCAL | | {LOCAL4, %[1.num],4} | |
-... | displ4 |
- | {displdef4,%[1.reg],%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {EXTERNAL4,%[1.ind]} | |
-... | NC EXTERNAL4 |
- | {reldef4,%[1.ind]} | |
-... | NC aextind4 |
- | {extind4,%[1.ireg],%[1.ind]} | |
-... | NC adisplind4 |
- | {displind4,%[1.ireg],%[1.reg],%[1.ind]} | |
-... | NC aextdefind4 |
- | {extdefind4,%[1.ireg],%[1.ind]} | |
-... | NC adispldefind4 |
- | {displdefind4,%[1.ireg],%[1.reg],%[1.ind]} | |
-loi $1==8 | NC adispl |
- | {displ8,%[1.reg],%[1.ind]} | |
-... | reg4 | | {regdef8,%[1]} | |
-... | NC ADDR_LOCAL | | {LOCAL8, %[1.num],8} | |
-... | displ4 |
- | {displdef8,%[1.reg],%[1.ind]} | |
-... | NC ADDR_EXTERNAL |
- | {EXTERNAL8,%[1.ind]} | |
-... | NC EXTERNAL4 |
- | {reldef8,%[1.ind]} | |
-... | NC aextind8 |
- | {extind8,%[1.ireg],%[1.ind]} | |
-... | NC adisplind8 |
- | {displind8,%[1.ireg],%[1.reg],%[1.ind]} | |
-... | NC aextdefind8 |
- | {extdefind8,%[1.ireg],%[1.ind]} | |
-... | NC adispldefind8 |
- | {displdefind8,%[1.ireg],%[1.reg],%[1.ind]} | |
-loi $1>8 && $1<=16
- | reg4 | | {displ8,%[1],tostring($1-8)} %[1] | loi $1-8 |
-... | NC ADDR_EXTERNAL |
- | {EXTERNAL8,%[1.ind]+"+"+tostring($1-8)}
- %[1] | loi $1-8 |
-... | NC ADDR_LOCAL |
- | {LOCAL8,%[1.num]+$1-8,8} %[1] | loi $1-8 |
-loi | sreg4 |
- remove(ALL)
- allocate(REG={CONST4,$1/4})
- "addl2\t$$$1,%[1]"
-#ifdef LOCLABS
- "1:\nmovl\t-(%[1]),-(sp)"
- "sobgtr\t%[a],1b"
-#else
- "movl\t-(%[1]),-(sp)"
- "sobgtr\t%[a],.-3"
-#endif
- erase(%[a]) | | |
-los $1==4 | | remove(ALL)
- move({CONST1,4},R0)
- "jsb\t.los"
- erase(R0) | | |
-los !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.los"
- erase(R0) | | |
-ldl | | | {LOCAL8, $1, 8} | |
-lde | | | {EXTERNAL8, $1} | |
-ldf | | | | adp $1 loi 8 |
-lpi | | | {ADDR_EXTERNAL, $1} | |
-
-/********************************
- * Group 2 : Store instructions *
- ********************************/
-
-#ifdef REGVARS
-stl inreg($1)==2 | NC bigsource4 |
- remove(regvar($1))
- move(%[1],regvar($1)) | | |
-... | | remove(ALL)
- "movl\t(sp)+,%(regvar($1)%)" | | | (3,7)
-#endif REGVARS
-stl | NC bigsource4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $1+3 && %[num]+%[size] > $1)
- move(%[1], {LOCAL4,$1, 4}) | | |
-... | | remove(ALL)
- "movl\t(sp)+,$1(fp)" | | | (5,14)
-ste | NC bigsource4 |
- remove(externals)
- move(%[1],{EXTERNAL4, $1}) | | |
-... | | remove(ALL)
- "movl\t(sp)+,$1" | | | (7,14)
-#ifdef REGVARS
-sil inreg($1)==2 | NC bigsource4 |
- REMEXTANDLOC
- move(%[1],{regdef4,regvar($1)}) | | |
-... | | remove(ALL)
- "movl\t(sp)+,(%(regvar($1)%))" | | | (3,10)
-#endif REGVARS
-sil | NC bigsource4 |
- REMEXTANDLOC
- move(%[1],{displdef4,LB, tostring($1)}) | | |
-... | | remove(ALL)
- "movl\t(sp)+,*$1(fp)" | | | (5,17)
-stf | | | | adp $1 sti 4 |
-/*** C-problem: f(c) char c; {
- write(1, &c, 1);
- }
- You don't know where the character is put in the word,
- so the CEM-compiler generates: (shorts analogously)
-***/
-lol lal sti $1==$2 && $3<4 | | | | |
-/************************************************/
-sti $1==1 | NC adispl source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displ1,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_LOCAL source1or2or4 |
- remove(displaced)
- remove(LOCALS,
- %[num]<=%[1.num] && %[num]+%[size]>%[1.num])
- move(%[2],{LOCAL1,%[1.num],1}) | | |
-... | NC ADDR_LOCAL STACK |
- "cvtlb\t(sp)+,%[1]" | | | (3,7)+%[1]
-... | reg4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{regdef1,%[1]}) | | |
-... | displ4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displdef1,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_EXTERNAL source1or2or4 |
- remove(externals)
- move(%[2],{EXTERNAL1,%[1.ind]}) | | |
-... | NC EXTERNAL4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{reldef1,%[1.ind]}) | | |
-... | NC adisplind1 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displind1,%[1.ireg],%[1.reg],%[1.ind]})
- | | |
-... | NC aextdefind1 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{extdefind1,%[1.ireg],%[1.ind]}) | | |
-... | NC adispldefind1 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displdefind1,%[1.ireg],%[1.reg],%[1.ind]})
- | | |
-sti $1==2 | NC adispl source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displ2,%[1.reg],%[1.ind]}) | | |
-... | reg4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{regdef2,%[1]}) | | |
-... | NC ADDR_LOCAL source1or2or4 |
- remove(displaced)
- remove(LOCALS,
- %[num]<=%[1.num] && %[num]+%[size]>%[1.num])
- move(%[2],{LOCAL2,%[1.num],2}) | | |
-... | displ4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displdef2,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_EXTERNAL source1or2or4 |
- remove(externals)
- move(%[2],{EXTERNAL2,%[1.ind]}) | | |
-... | NC EXTERNAL4 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{reldef2,%[1.ind]}) | | |
-... | NC aextind2 source1or2or4 |
- remove(externals)
- move(%[2],{extind2,%[1.ireg],%[1.ind]}) | | |
-... | NC adisplind2 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displind2,%[1.ireg],%[1.reg],%[1.ind]}) | | |
-... | NC aextdefind2 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{extdefind2,%[1.ireg],%[1.ind]}) | | |
-... | NC adispldefind2 source1or2or4 |
- REMEXTANDLOC
- move(%[2],{displdefind2,%[1.ireg],%[1.reg],%[1.ind]})
- | | |
-sti $1==4 | NC adispl bigsource4 |
- REMEXTANDLOC
- move(%[2],{displ4,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_LOCAL | | | stl %[1.num] |
-... | NC ADDR_EXTERNAL | | | ste %[1.ind] |
-... | adispl |
- remove(ALL)
- "movl\t(sp)+,%[1]" | | | (3,7)+%[1]
-... | reg4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{regdef4,%[1]}) | | |
-... | displ4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{displdef4,%[1.reg],%[1.ind]}) | | |
-... | NC EXTERNAL4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{reldef4,%[1.ind]}) | | |
-... | NC aextind4 bigsource4 |
- remove(externals)
- move(%[2],{extind4,%[1.ireg],%[1.ind]}) | | |
-... | NC adisplind4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{displind4,%[1.ireg],%[1.reg],%[1.ind]}) | | |
-... | NC aextdefind4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{extdefind4,%[1.ireg],%[1.ind]}) | | |
-... | NC adispldefind4 bigsource4 |
- REMEXTANDLOC
- move(%[2],{displdefind4,%[1.ireg],%[1.reg],%[1.ind]})
- | | |
-sti $1==8 | NC adispl bigsource8 |
- REMEXTANDLOC
- move(%[2],{displ8,%[1.reg],%[1.ind]}) | | |
-... | NC ADDR_LOCAL | | | sdl %[1.num] |
-... | NC ADDR_EXTERNAL | | | sde %[1.ind] |
-... | reg4 bigsource8 |
- REMEXTANDLOC
- move(%[2],{regdef8,%[1]}) | | |
-... | displ4 bigsource8 |
- REMEXTANDLOC
- move(%[2],{displdef8,%[1.reg],%[1.ind]}) | | |
-... | NC EXTERNAL4 bigsource8 |
- REMEXTANDLOC
- move(%[2],{reldef8,%[1.ind]}) | | |
-... | NC aextind8 bigsource8 |
- remove(externals)
- move(%[2],{extind8,%[1.ireg],%[1.ind]}) | | |
-... | NC adisplind8 bigsource8 |
- REMEXTANDLOC
- move(%[2],{displind8,%[1.ireg],%[1.reg],%[1.ind]}) | | |
-... | NC aextdefind8 bigsource8 |
- REMEXTANDLOC
- move(%[2],{extdefind8,%[1.ireg],%[1.ind]}) | | |
-... | NC adispldefind8 bigsource8 |
- REMEXTANDLOC
- move(%[2],{displdefind8,%[1.ireg],%[1.reg],%[1.ind]})
- | | |
-sti | sreg4 |
- remove(ALL)
- allocate(REG={CONST4, $1/4})
-#ifdef LOCLABS
- "1:\nmovl\t(sp)+,(%[1])+"
- "sobgtr\t%[a],1b"
-#else
- "movl\t(sp)+,(%[1])+"
- "sobgtr\t%[a],.-3"
-#endif
- erase(%[a]) | | |
-sts $1==4 | STACK |
- move({CONST1,4},R0)
- "jsb\t.sts"
- erase(R0) | | |
-sts !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sts"
- erase(R0) | | |
-sdl | NC bigsource8 |
- remove(displaced)
- remove(LOCALS, %[num]<=$1+7 && %[num]+%[size]>$1)
- move(%[1],{LOCAL8,$1, 8}) | | |
-... | NC bigsource4 bigsource4 |
- remove(displaced)
- remove(LOCALS, %[num]<=$1+7 && %[num]+%[size]>$1)
- move(%[1], {LOCAL4,$1,4})
- move(%[2], {LOCAL4,$1+4,4}) | | |
-... | | remove(ALL)
- "movq\t(sp)+,$1(fp)" | | | (5,14)
-sde | NC bigsource8 |
- remove(externals)
- move(%[1], {EXTERNAL8, $1}) | | |
-... | bigsource4 bigsource4 |
- remove(externals)
- move(%[1], {EXTERNAL4, $1})
- move(%[2], {EXTERNAL4, $1+"+4"}) | | |
-... | | remove(ALL)
- "movq\t(sp)+,$1" | | | (7,14)
-sdf | | | | adp $1 sti 8 |
-
-/********************************
- * Group 3 : Integer Arithmetic *
- ********************************/
-
-adi $1==4 | source4 sreg4 |
- "addl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,4) + %[1]
-... | sreg4 source4 |
- "addl2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,4) + %[2]
-... | NC nosreg4 nosreg4 |
- allocate(%[1],%[2],REG)
- "addl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-#ifdef REGVARS
-adi stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "addl3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-adi stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, %[num]<=$2+3 && %[num]+%[size]>$2)
- "addl3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-adi sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "addl3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-adi sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "addl3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-adi ste $1==4 | source4 source4 |
- remove(externals)
- "addl3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-adi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.adi" | | |
-sbi $1==4 | source4 sreg4 |
- "subl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,4) + %[1]
-... | NC source4 nosreg4 |
- allocate(%[1],%[2],REG)
- "subl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-#ifdef REGVARS
-sbi stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "subl3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-sbi stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "subl3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-sbi sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "subl3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-sbi sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "subl3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-sbi ste $1==4 | source4 source4 |
- remove(externals)
- "subl3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-sbi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sbi" | | |
-mli $1==4 | source4 sreg4 |
- "mull2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,16) + %[1]
-... | sreg4 source4 |
- "mull2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,16) + %[2]
-... | NC nosreg4 nosreg4 |
- allocate(%[1],%[2],REG)
- "mull3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,16)+%[1]+%[2]
-#ifdef REGVARS
-mli stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "mull3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-mli stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "mull3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-mli sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "mull3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-mli sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "mull3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-mli ste $1==4 | source4 source4 |
- remove(externals)
- "mull3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-mli !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.mli" | | |
-dvi $1==4 | source4 sreg4 |
- "divl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,98) + %[1]
-... | NC source4 nosreg4 |
- allocate(%[1],%[2],REG)
- "divl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,98)+%[1]+%[2]
-#ifdef REGVARS
-dvi stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "divl3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-dvi stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "divl3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-dvi sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "divl3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-dvi sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "divl3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-dvi ste $1==4 | source4 source4 |
- remove(externals)
- "divl3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-dvi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.dvi" | | |
-rmi $1==4 | source4 source4 |
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-rmi stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-rmi stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num]<=$2+3 && %[num]+%[size]>$2))
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],$2(fp)"
- setcc({LOCAL4, $2, 4}) | | |
-#ifdef REGVARS
-rmi sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-rmi sil $1==4 | source4 source4 |
- REMEXTANDLOC
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],*$2(fp)"
- setcc({displdef4, LB, tostring($2)}) | | |
-rmi ste $1==4 | source4 source4 |
- remove(externals)
- allocate(REG)
- "divl3\t%[1],%[2],%[a]"
- "mull2\t%[1],%[a]"
- "subl3\t%[a],%[2],$2"
- setcc({EXTERNAL4, $2}) | | |
-rmi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.rmi"
- erase(R0) | | |
-ngi $1==4 | source4 |
- allocate(%[1],REG)
- "mnegl\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-ngi stl $1==4 && inreg($2)==2
- | source4 |
- remove(regvar($2))
- "mnegl\t%[1],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-ngi stl $1==4 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "mnegl\t%[1],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-ngi sil $1==4 && inreg($2)==2
- | source4 |
- REMEXTANDLOC
- "mnegl\t%[1],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-ngi sil $1==4 | source4 |
- REMEXTANDLOC
- "mnegl\t%[1],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-ngi ste $1==4 | source4 |
- remove(externals)
- "mnegl\t%[1],$2"
- setcc({EXTERNAL4,$2}) | | |
-ngi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.ngi" | | |
-sli $1==4 | source1or2or4 source1or2or4 |
- allocate(%[1],%[2],REG)
- "ashl\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-#ifdef REGVARS
-sli stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "ashl\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-sli stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "ashl\t%[1],%[2],$2(fp)"
- setcc({LOCAL4, $2, 4}) | | |
-#ifdef REGVARS
-sli sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "ashl\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-sli sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "ashl\t%[1],%[2],*$2(fp)"
- setcc({displdef4, LB, tostring($2)}) | | |
-sli ste $1==4 | source4 source4 |
- remove(externals)
- "ashl\t%[1],%[2],$2"
- setcc({EXTERNAL4, $2}) | | | (8,10)+%[1]+%[2]
-sli !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sli"
- erase(R0) | | |
-sri $1==4 | source4-CONST source4 |
- allocate(%[1],REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],%[a]"
- setcc(%[a]) | %[a] | | (7,8)+%[1]+%[2]
-... | NC CONST source4 |
- allocate(%[2],REG)
- "ashl\t$$%(0-%[1.num]%),%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-#ifdef REGVARS
-sri stl $1==4 && inreg($2)==2
- | source4-CONST source4 |
- remove(regvar($2))
- allocate(%[1], REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | | (9,14)+%[1]+%[2]
-... | CONST source4 |
- remove(regvar($2))
- "ashl\t$$%(0-%[1.num]%),%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | | (6,10)+%[1]+%[2]
-#endif REGVARS
-sri stl $1==4 | source4-CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- allocate(%[1], REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],$2(fp)"
- setcc({LOCAL4, $2, 4}) | | | (9,11)+%[1]+%[2]
-... | CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "ashl\t$$%(0-%[1.num]%),%[2],$2(fp)"
- setcc({LOCAL4, $2, 4}) | | | (6,7)+%[1]+%[2]
-#ifdef REGVARS
-sri sil $1==4 && inreg($2)==2
- | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1], REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | | (9,14)+%[1]+%[2]
-... | CONST source4 |
- REMEXTANDLOC
- "ashl\t$$%(0-%[1.num]%),%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | | (6,10)+%[1]+%[2]
-#endif REGVARS
-sri sil $1==4 | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1], REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],*$2(fp)"
- setcc({displdef4, LB, tostring($2)})
- | | | (9,17)+%[1]+%[2]
-... | CONST source4 |
- REMEXTANDLOC
- "ashl\t$$%(0-%[1.num]%),%[2],*$2(fp)"
- setcc({displdef4, LB, tostring($2)})
- | | | (6,13)+%[1]+%[2]
-sri ste $1==4 | source4-CONST source4 |
- remove(externals)
- allocate(%[1], REG)
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],$2"
- setcc({EXTERNAL4, $2}) | | | (11,14)+%[1]+%[2]
-... | CONST source4 |
- remove(externals)
- "ashl\t$$%(0-%[1.num]%),%[2],$2"
- setcc({EXTERNAL4, $2}) | | | (8,10)+%[1]+%[2]
-sri !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sri"
- erase(R0) | | |
-
-/************************************************
- * Group 4 : Unsigned arithmetic *
- ************************************************/
-
-adu | | | | adi $1 |
-sbu | | | | sbi $1 |
-mlu | | | | mli $1 |
-dvu $1==4 | | remove(ALL)
- "jsb\t.dvu4" | R0 | |
-dvu !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.dvu"
- erase(R0) | | |
-rmu $1==4 | | remove(ALL)
- "jsb\t.rmu4" | R0 | |
-rmu !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.rmu"
- erase(R0) | | |
-slu | | | | sli $1 |
-sru $1==4 | source4-CONST source4 |
- allocate(%[1],REG,QREG)
- "mnegl\t%[1],%[a]"
- move(%[2],%[b.1])
- move({CONST4,0},%[b.2])
- "ashq\t%[a],%[b],%[b]"
- erase(%[b]) | %[b.1] | | (10,12)+%[1]
-... | NC CONST source4 |
- allocate(%[2],QREG)
- move(%[2],%[a.1])
- move({CONST4,0},%[a.2])
- "ashq\t$$%(0-%[1.num]%),%[a],%[a]"
- erase(%[a]) | %[a.1] | | (4,4)+%[1]
-sru !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sru"
- erase(R0) | | |
-
-/****************************************
- * Group 5 : Floating point arithmetic *
- ****************************************/
-
-adf $1==4 | source4 sreg4 |
- "addf2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,8) + %[1]
-... | sreg4 source4 |
- "addf2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,8) + %[2]
-... | NC nosreg4 nosreg4 |
- allocate(%[1],%[2],REG)
- "addf3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,8)+%[1]+%[2]
-#ifdef FLOAT4
-adf stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+3 && %[num]+%[size] > $2)
- "addf3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-adf sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "addf3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-adf ste $1==4 | source4 source4 |
- remove(externals)
- "addf3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-#endif
-adf $1==8 | source8 sreg8 |
- "addd2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,14) + %[1]
-... | sreg8 source8 |
- "addd2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,14) + %[2]
-... | NC nosreg8 source8-sreg8 |
- allocate(%[1],%[2],QREG)
- "addd3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,14)+%[1]+%[2]
-adf sdl $1==8 | source8 source8 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "addd3\t%[1],%[2],$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-adf sde $1==8 | source8 source8 |
- remove(externals)
- "addd3\t%[1],%[2],$2"
- setcc({EXTERNAL8,$2}) | | |
-adf !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.adf" | | |
-sbf $1==4 | source4 sreg4 |
- "subf2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,8) + %[1]
-... | NC source4 nosreg4 |
- allocate(%[1],%[2],REG)
- "subf3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,8)+%[1]+%[2]
-#ifdef FLOAT4
-sbf stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+3 && %[num]+%[size] > $2)
- "subf3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-sbf sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "subf3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-sbf ste $1==4 | source4 source4 |
- remove(externals)
- "subf3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-#endif
-sbf $1==8 | source8 sreg8 |
- "subd2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,14) + %[1]
-... | NC source8 nosreg8 |
- allocate(%[1],%[2],QREG)
- "subd3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,14)+%[1]+%[2]
-sbf sdl $1==8 | source8 source8 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "subd3\t%[1],%[2],$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-sbf sde $1==8 | source8 source8 |
- remove(externals)
- "subd3\t%[1],%[2],$2"
- setcc({EXTERNAL8,$2}) | | |
-sbf !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sbf" | | |
-mlf $1==4 | source4 sreg4 |
- "mulf2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,12) + %[1]
-... | sreg4 source4 |
- "mulf2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,12) + %[2]
-... | NC nosreg4 nosreg4 |
- allocate(%[1],%[2],REG)
- "mulf3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,12)+%[1]+%[2]
-#ifdef FLOAT4
-mlf stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+3 && %[num]+%[size] > $2)
- "mulf3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-mlf sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "mulf3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-mlf ste $1==4 | source4 source4 |
- remove(externals)
- "mulf3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-#endif
-mlf $1==8 | source8 sreg8 |
- "muld2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,20) + %[1]
-... | sreg8 source8 |
- "muld2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,20) + %[2]
-... | NC nosreg8 source8-sreg8 |
- allocate(%[1],%[2],QREG)
- "muld3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,20)+%[1]+%[2]
-mlf sdl $1==8 | source8 source8 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "muld3\t%[1],%[2],$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-mlf sde $1==8 | source8 source8 |
- remove(externals)
- "muld3\t%[1],%[2],$2"
- setcc({EXTERNAL8,$2}) | | |
-mlf !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.mlf" | | |
-dvf $1==4 | source4 sreg4 |
- "divf2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,46) + %[1]
-... | NC source4 nosreg4 |
- allocate(%[1],%[2],REG)
- "divf3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,46)+%[1]+%[2]
-#ifdef FLOAT4
-dvf stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+3 && %[num]+%[size] > $2)
- "divf3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-dvf sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "divf3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-dvf ste $1==4 | source4 source4 |
- remove(externals)
- "divf3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-#endif
-dvf $1==8 | source8 sreg8 |
- "divd2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,80) + %[1]
-... | NC source8 nosreg8 |
- allocate(%[1],%[2],QREG)
- "divd3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,80)+%[1]+%[2]
-dvf sdl $1==8 | source8 source8 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "divd3\t%[1],%[2],$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-dvf sde $1==8 | source8 source8 |
- remove(externals)
- "divd3\t%[1],%[2],$2"
- setcc({EXTERNAL8,$2}) | | |
-dvf !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.dvf" | | |
-ngf $1==4 | source4 |
- allocate(%[1],REG)
- "mnegf\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef FLOAT4
-ngf stl $1==4 | source4 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+3 && %[num]+%[size] > $2)
- "mnegf\t%[1],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-ngf sil $1==4 | source4 |
- REMEXTANDLOC
- "mnegf\t%[1],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-ngf ste $1==4 | source4 |
- remove(externals)
- "mnegf\t%[1],$2"
- setcc({EXTERNAL4,$2}) | | |
-#endif
-ngf $1==8 | source8 |
- allocate(%[1],QREG)
- "mnegd\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-ngf sdl $1==8 | source8 |
- remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "mnegd\t%[1],$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-ngf sde $1==8 | source8 |
- remove(externals)
- "mnegd\t%[1],$2"
- setcc({EXTERNAL8,$2}) | | |
-ngf !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.ngf" | | |
-loc loc loc cif fif $1==1 && $2==4 && $3==4 && $5==4
- | source4 |
- allocate(%[1],REG,REG)
- "emodf\t%[1],$$0,$$0f1.0,%[b],%[a]"
- /* Don't trust the integer part in %[b], *
- * integer overflow might occur. */
- "subf3\t%[a],%[1],%[b]" | %[a] %[b] | |
-loc loc loc cif fif $1==1 && $2==4 && $3==8 && $5==8
- | source8 |
- allocate(%[1],QREG,QREG)
- "emodd\t%[1],$$0,$$0f1.0,%[b],%[a]"
- "subd3\t%[a],%[1],%[b]" | %[a] %[b] | |
-fif $1==4 | source4 source4 |
- allocate(%[1],%[2],REG,REG,REG)
- "mulf3\t%[1],%[2],%[a]"
- "emodf\t%[a],$$0,$$0f1.0,%[b],%[c]"
- "subf2\t%[c],%[a]" | %[c] %[a] | |
-fif $1==8 | source8 source8 |
- allocate(%[1],%[2],QREG,QREG)
- "muld3\t%[1],%[2],%[a]"
- "emodd\t%[a],$$0,$$0f1.0,-(sp),%[b]"
- "tstl\t(sp)+"
- "subd2\t%[b],%[a]" | %[b] %[a] | |
-fif !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.fif"
- erase(R0) | | |
-fef $1==4 | sreg4 |
- allocate(REG)
- "extzv\t$$7,$$8,%[1],%[a]"
- "subl2\t$$128,%[a]"
- "insv\t$$128,$$7,$$8,%[1]"
- erase(%[1]) | %[1] %[a] | |
-fef $1==8 | sreg8 |
- allocate(REG)
- "extzv\t$$7,$$8,%[1],%[a]"
- "subl2\t$$128,%[a]"
- "insv\t$$128,$$7,$$8,%[1]"
- erase(%[1]) | %[1] %[a] | |
-fef !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.fef"
- erase(R0) | | |
-
-/********************************
- * Group 6 : pointer arithmetic *
- ********************************/
-
-adp $1==0 | | | | |
-adp | NC adispl |
- | {adispl,%[1.reg],%[1.ind]+"+"+tostring($1)} | |
-... | NC ADDR_EXTERNAL |
- | {ADDR_EXTERNAL,%[1.ind]+"+"+tostring($1)} | |
-... | NC ADDR_LOCAL | | {ADDR_LOCAL,%[1.num]+$1} | |
-... | reg4 | | {adispl,%[1],tostring($1)} | |
-... | NC adisplind1 |
- | {adisplind1,%[1.ireg],%[1.reg],
- %[1.ind]+"+"+tostring($1)} | |
-... | NC adisplind2 |
- | {adisplind2,%[1.ireg],%[1.reg],
- %[1.ind]+"+"+tostring($1)} | |
-... | NC adisplind4 |
- | {adisplind4,%[1.ireg],%[1.reg],
- %[1.ind]+"+"+tostring($1)} | |
-... | NC adisplind8 |
- | {adisplind8,%[1.ireg],%[1.reg],
- %[1.ind]+"+"+tostring($1)} | |
-... | NC aextind2 |
- | {aextind2,%[1.ireg],%[1.ind]+"+"+tostring($1)} | |
-... | NC aextind4 |
- | {aextind4,%[1.ireg],%[1.ind]+"+"+tostring($1)} | |
-... | NC aextind8 |
- | {aextind8,%[1.ireg],%[1.ind]+"+"+tostring($1)} | |
-ads $1==4 | NC reg4 adispl |
- | {adisplind1,%[1],%[2.reg],%[2.ind]} | |
-... | NC reg4 ADDR_LOCAL |
- | {adisplind1,%[1],LB,tostring(%[2.num])} | |
-... | NC reg4 ADDR_EXTERNAL |
- | {adispl,%[1],%[2.ind]} | |
-... | NC reg4 displ4 |
- | {adispldefind1,%[1],%[2.reg],%[2.ind]} | |
-... | NC reg4 LOCAL4 |
- | {adispldefind1,%[1],LB,tostring(%[2.num])} | |
-... | NC reg4 EXTERNAL4 |
- | {aextdefind1,%[1],%[2.ind]} | |
-... | source4 source4 |
- allocate(%[1],%[2],REG)
- "addl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-ads | | | | loc $1 loc 4 cii ads 4 |
-ads !defined($1) | | | | loc 4 cii ads 4 |
-sbs $1==4 | | | | sbu $1 |
-sbs $1!=4 | | | | sbu 4 loc 4 loc $1 cii |
-sbs !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sbs"
- erase(R0) | | |
-adp dup sil adp $1==(0-$4) && $2==4
- | reg4 | | %[1] %[1] | adp $1 sil $3 |
-adp dup loe sti adp $1==(0-$5) && $2==4 && $4==4
- | reg4 | | %[1] %[1] | adp $1 loe $3 sti 4 |
-#ifdef REGVARS
-lol lol adp stl loi $1==$4 && $2==$1 && inreg($1)==2 && $3==1 && $5==1
- | | remove(regvar($1))
- | {reginc1,regvar($1)} | |
-lol lol adp stl loi $1==$4 && $2==$1 && inreg($1)==2 && $3==2 && $5==2
- | | remove(regvar($1))
- | {reginc2,regvar($1)} | |
-lol lol adp stl loi $1==$4 && $2==$1 && inreg($1)==2 && $3==4 && $5==4
- | | remove(regvar($1))
- | {reginc4,regvar($1)} | |
-lol lol adp stl loi $1==$4 && $2==$1 && inreg($1)==2 && $3==8 && $5==8
- | | remove(regvar($1))
- | {reginc8,regvar($1)} | |
-lol adp dup stl loi $1==$4 && $2==(0-1) && inreg($1)==2 && $3==4 && $5==1
- | | remove(regvar($1))
- | {regdec1,regvar($1)} | |
-lol adp dup stl loi $1==$4 && $2==(0-2) && inreg($1)==2 && $3==4 && $5==2
- | | remove(regvar($1))
- | {regdec2,regvar($1)} | |
-lol adp stl lil $1==$4 && $2==(0-4) && inreg($1)==2 && $3==$1
- | | remove(regvar($1))
- | {regdec4,regvar($1)} | |
-lol adp dup stl loi $1==$4 && $2==(0-8) && inreg($1)==2 && $3==4 && $5==8
- | | remove(regvar($1))
- | {regdec8,regvar($1)} | |
-lol lol adp stl sti $1==$4 && $2==$1 && inreg($1)==2 && $3==1 && $5==1
- | NC source1 |
- REMEXTANDLOC
- remove(regvar($1))
- "movb\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | NC source2 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtwb\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtlb\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | | (3,7)+%[1]
-lol lol adp stl sti $1==$4 && $2==$1 && inreg($1)==2 && $3==2 && $5==2
- | NC source2 |
- REMEXTANDLOC
- remove(regvar($1))
- "movw\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtlw\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | | (3,7)+%[1]
-lol lol adp stl sti $1==$4 && $2==$1 && inreg($1)==2 && $3==4 && $5==4
- | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "movl\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | |
-lol lol adp stl sti $1==$4 && $2==$1 && inreg($1)==2 && $3==8 && $5==8
- | source8 |
- REMEXTANDLOC
- remove(regvar($1))
- "movq\t%[1],(%(regvar($1)%))+"
- erase(regvar($1)) | | |
-lol adp dup stl sti $1==$4 && inreg($1)==2 && $2==(0-1) && $3==4 && $5==1
- | NC source1 |
- REMEXTANDLOC
- remove(regvar($1))
- "movb\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | NC source2 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtwb\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtlb\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | | (3,7)+%[1]
-lol adp dup stl sti $1==$4 && inreg($1)==2 && $2==(0-2) && $3==4 && $5==2
- | NC source2 |
- REMEXTANDLOC
- remove(regvar($1))
- "movw\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | | (3,7)+%[1]
-... | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "cvtlw\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | | (3,7)+%[1]
-lol adp stl sil $1==$4 && inreg($1)==2 && $2==(0-4) && $3==$4
- | source4 |
- REMEXTANDLOC
- remove(regvar($1))
- "movl\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | |
-lol adp dup stl sti $1==$4 && inreg($1)==2 && $2==(0-8) && $3==4 && $5==8
- | source8 |
- REMEXTANDLOC
- remove(regvar($1))
- "movq\t%[1],-(%(regvar($1)%))"
- erase(regvar($1)) | | |
-lol lol adp stl $1==$4 && $2==$4 && inreg($1)==2
- | | remove(regvar($1))
- allocate(REG=regvar($1))
- "addl2\t$$$3,%(regvar($1)%)"
- erase(regvar($1)) | %[a] | |
-lol adp stl $1==$3 && inreg($1)==2
- | | remove(regvar($1))
- "addl2\t$$$2,%(regvar($1)%)"
- erase(regvar($1)) | | |
-#endif REGVARS
-lol adp stl $1==$3
- | | remove(displaced)
- remove(LOCALS, %[num] <= $1+3 && %[num]+%[size] > $1)
- "addl2\t$$$2,$1(fp)"
- setcc({LOCAL4,$1,4}) | | |
-lol lol adp stl $1==$4 && $2==$4
- | | remove(displaced)
- remove(LOCALS, %[num] <= $1+3 && %[num]+%[size] > $1)
- allocate(REG={LOCAL4,$1,4})
- "addl2\t$$$3,$1(fp)"
- setcc({LOCAL4,$1,4}) | %[a] | |
-#ifdef REGVARS
-lil lil adp sil $1==$2 && $1==$4 && inreg($1)==2
- | | REMEXTANDLOC
- allocate(REG={regdef4, regvar($1)})
- "addl2\t$$$3,(%(regvar($1)%))" | %[a] | |
-#endif
-loe adp ste $1==$3
- | | remove(externals)
- "addl2\t$$$2,$1" | | |
-loe loe adp ste $1==$4 && $2==$1
- | | remove(externals)
- allocate(REG={EXTERNAL4,$1})
- "addl2\t$$$3,$1" | %[a] | |
-
-/****************************************
- * Group 7 : Increment/decrement/zero *
- ****************************************/
-
-lil inc dup sil $3==4 && $1==$4 | | | | lil $1 loc 1 adi 4 sil $1 lil $1 |
-lil dec dup sil $3==4 && $1==$4 | | | | lil $1 loc 1 sbi 4 sil $1 lil $1 |
-inc | | | {CONST1,1} | adi 4 |
-dec | | | {CONST1,1} | sbi 4 |
-#ifdef REGVARS
-inl inreg($1)==2 | | remove(regvar($1))
- "incl\t%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-#endif REGVARS
-inl | | remove(displaced)
- remove(LOCALS, %[num] <= $1+3 && %[num]+%[size] > $1)
- "incl\t$1(fp)"
- setcc({LOCAL4,$1, 4}) | | |
-#ifdef REGVARS
-lol inl $1==$2 && inreg($1)==2
- | | remove(regvar($1))
- allocate(REG=regvar($1))
- "incl\t%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | %[a] | |
-#endif REGVARS
-ine | | remove(externals)
- "incl\t$1"
- setcc({EXTERNAL4, $1}) | | |
-#ifdef REGVARS
-del inreg($1)==2 | | remove(regvar($1))
- "decl\t%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-#endif REGVARS
-del | | remove(displaced)
- remove(LOCALS, %[num] <= $1+3 && %[num]+%[size] > $1)
- "decl\t$1(fp)"
- setcc({LOCAL4,$1, 4}) | | |
-#ifdef REGVARS
-lol del $1==$2 && inreg($1)==2
- | | remove(regvar($1))
- allocate(REG=regvar($1))
- "decl\t%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | %[a] | |
-#endif REGVARS
-dee | | remove(externals)
- "decl\t$1"
- setcc({EXTERNAL4, $1}) | | |
-#ifdef REGVARS
-zrl inreg($1)==2 | | remove(regvar($1))
- "clrl\t%(regvar($1)%)"
- erase(regvar($1))
- setcc(regvar($1)) | | |
-#endif REGVARS
-zrl | | remove(displaced)
- remove(LOCALS,%[num] <= $1+3 && %[num]+%[size] > $1)
- "clrl\t$1(fp)"
- setcc({LOCAL4,$1, 4}) | | |
-zrl zrl $1==$2+4
-#ifdef REGVARS
- && inreg($1)<2 && inreg($2)<2
-#endif REGVARS
- | | remove(displaced)
- remove(LOCALS, %[num] <= $2+7 && %[num]+%[size] > $2)
- "clrq\t$2(fp)"
- setcc({LOCAL8,$2, 8}) | | |
-zrl zrl $1==$2-4 | | | | zrl $2 zrl $1 |
-zre | | remove(externals)
- "clrl\t$1"
- setcc({EXTERNAL4, $1}) | | |
-zrf $1==4 | | | {CONST4,0} | |
-zrf $1==8 | | | {FCONST8,0} | |
-zer $1==4 | | | {CONST4,0} | |
-zer $1==8 | | allocate(QREG)
- "clrq\t%[a]" | %[a] | |
-zer $1<=32 | | remove(ALL)
- "clrq\t-(sp)" | | zer $1-8 |
-zer defined($1) | | remove(ALL)
- move({CONST4,$1/4}, R0)
-#ifdef LOCLABS
- "1:\tclrl\t-(sp)"
- "sobgtr\tr0,1b"
-#else LOCLABS
- "clrl\t-(sp)"
- "sobgtr\tr0,.-2"
-#endif LOCLABS
- erase(R0) | | |
-zer !defined($1) | source1or2or4 |
- remove(ALL)
- move(%[1],R0)
-#ifdef LOCLABS
- "1:\tclrl\t-(sp)"
- "sobgtr\tr0,1b"
-#else LOCLABS
- "clrl\t-(sp)"
- "sobgtr\tr0,.-2"
-#endif LOCLABS
- erase(R0) | | |
-
-/********************************
- * Group 8 : Convertions *
- ********************************/
-
-cii | | remove(ALL)
- "jsb\t.cii" | | |
-cfi | | remove(ALL)
- "jsb\t.cfi" | | |
-cfu | | remove(ALL)
- "jsb\t.cfu" | | |
-cuf | | remove(ALL)
- "jsb\t.cuf" | | |
-cif | | remove(ALL)
- "jsb\t.cif" | | |
-cff | | remove(ALL)
- "jsb\t.cff" | | |
-cuu | | remove(ALL)
- "jsb\t.cuu" | | |
-ciu | | | | cuu |
-cui | | remove(ALL)
- "jsb\t.cui" | | |
-loc loc cii $1==1 && $2==2 | source1or2or4 |
- allocate(%[1],REG)
- "cvtbw\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-loc loc cii stl $1==1 && $2==4 && inreg($4)==2
- | source1or2or4 |
- remove(regvar($4))
- "cvtbl\t%[1],%(regvar($4)%)"
- erase(regvar($1))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cii stl $1==1 && $2==4 | source1or2or4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtbl\t%[1],$4(fp)"
- setcc({LOCAL4,$4, 4}) | | |
-loc loc cii ste $1==1 && $2==4 | source1or2or4 |
- remove(externals)
- "cvtbl\t%[1],$4"
- setcc({EXTERNAL4, $4}) | | |
-loc loc cii $1==1 && $2==4 | source1or2or4 |
- allocate(%[1],REG)
- "cvtbl\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-loc loc cii stl $1==2 && $2==4 && inreg($4)==2
- | source2or4 |
- remove(regvar($4))
- "cvtwl\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cii stl $1==2 && $2==4 | source2or4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtwl\t%[1],$4(fp)"
- setcc({LOCAL4,$4, 4}) | | |
-loc loc cii ste $1==2 && $2==4 | source2or4 |
- remove(externals)
- "cvtwl\t%[1],$4"
- setcc({EXTERNAL4, $4}) | | |
-loc loc cii $1==2 && $2==4 | source2or4 |
- allocate(%[1],REG)
- "cvtwl\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-loc loc cii $1==2 && $2==1 | | | | |
-loc loc cii $1==4 && $2==1 | | | | |
-loc loc cii $1==4 && $2==2 | | | | |
-loc loc cui $1==$2 | | | | |
-loc loc ciu | | | | loc $1 loc $2 cuu |
-#ifdef REGVARS
-loc loc cfi stl $1==4 && $2==4 && inreg($4)==2
- | source4 |
- remove(regvar($4))
- "cvtfl\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cfi stl $1==4 && $2==4 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtfl\t%[1],$4(fp)"
- setcc({LOCAL4,$4, 4}) | | |
-loc loc cfi ste $1==4 && $2==4 | source4 |
- remove(externals)
- "cvtfl\t%[1],$4"
- setcc({EXTERNAL4, $4}) | | |
-loc loc cfi $1==4 && $2==4 | source4 |
- allocate(%[1],REG)
- "cvtfl\t%[1],%[a]"
- setcc(%[a]) | %[a] | | (3,4) + %[1]
-#ifdef REGVARS
-loc loc cfi stl $1==8 && $2==4 && inreg($4)==2
- | source8 |
- remove(regvar($4))
- "cvtdl\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cfi stl $1==8 && $2==4 | source8 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtdl\t%[1],$4(fp)"
- setcc({LOCAL4,$4, 4}) | | |
-loc loc cfi ste $1==8 && $2==4 | source8 |
- remove(externals)
- "cvtdl\t%[1],$4"
- setcc({EXTERNAL4, $4}) | | |
-loc loc cfi $1==8 && $2==4 | source8 |
- allocate(%[1],REG)
- "cvtdl\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-loc loc cif stl $1==4 && $2==4 && inreg($4)==2
- | source4 |
- remove(regvar($4))
- "cvtlf\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cif stl $1==4 && $2==4 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtlf\t%[1],$4(fp)" | | |
-loc loc cif ste $1==4 && $2==4 | source4 |
- remove(externals)
- "cvtlf\t%[1],$4" | | |
-loc loc cif $1==4 && $2==4 | source4 |
- allocate(%[1],REG)
- "cvtlf\t%[1],%[a]" | %[a] | |
-/* No double registervariables yet...
-#ifdef REGVARS
-loc loc cif sdl $1==4 && $2==8 && inreg($4)==2
- | source4 |
- remove(regvar($4))
- "cvtld\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-*/
-loc loc cif sdl $1==4 && $2==8 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtld\t%[1],$4(fp)" | | |
-loc loc cif sde $1==4 && $2==8 | source4 |
- remove(externals)
- "cvtld\t%[1],$4" | | |
-loc loc loc cif $1!=0 && $2==4 && $3==8 | | | {FCONST8,$1} | |
-/* $1!=0: kludge to avoid known bug in Vax assembler, that
- * doesn't handle 0f0.0 (and other numbers that have the 0x4000 bit off
- * in the exponent) right.
- */
-loc loc cif $1==4 && $2==8 | source4 |
- allocate(%[1],QREG)
- "cvtld\t%[1],%[a]" | %[a] | |
-loc loc cfu $1==4 | source4 |
- allocate(%[1],REG=%[1])
- "bicl2\t$$32768,%[a]" | %[a] | loc $1 loc $2 cfi |
-loc loc cfu $1==8 | source8 |
- allocate(%[1],QREG=%[1])
- "bicl2\t$$32768,%[a]" | %[a] | loc $1 loc $2 cfi |
-#ifdef REGVARS
-loc loc cff sdl $1==4 && $2==8 && inreg($4)==2
- | source4 |
- remove(regvar($4))
- "cvtfd\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cff sdl $1==4 && $2==8 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+7 && %[num]+%[size] > $4))
- "cvtfd\t%[1],$4(fp)" | | |
-loc loc cff sde $1==4 && $2==8 | source4 |
- remove(externals)
- "cvtfd\t%[1],$4" | | |
-loc loc cff $1==4 && $2==8 | source4 |
- allocate(%[1],QREG)
- "cvtfd\t%[1],%[a]" | %[a] | |
-#ifdef REGVARS
-loc loc cff stl $1==8 && $2==4 && inreg($4)==2
- | source8 |
- remove(regvar($4))
- "cvtdf\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cff stl $1==8 && $2==4 | source8 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "cvtdf\t%[1],$4(fp)" | | |
-loc loc cff ste $1==8 && $2==4 | source8 |
- remove(externals)
- "cvtdf\t%[1],$4" | | |
-loc loc cff $1==8 && $2==4 | source8 |
- allocate(%[1],REG)
- "cvtdf\t%[1],%[a]" | %[a] | |
-#ifdef REGVARS
-loc loc cuu stl $1==2 && $2==4 && inreg($4)==2
- | source2or4 |
- remove(regvar($4))
- "movzwl\t%[1],%(regvar($4)%)"
- erase(regvar($4))
- setcc(regvar($4)) | | |
-#endif REGVARS
-loc loc cuu stl $1==2 && $2==4 | source2or4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $4+3 && %[num]+%[size] > $4))
- "movzwl\t%[1],$4(fp)"
- setcc({LOCAL4,$4, 4}) | | |
-loc loc cuu ste $1==2 && $2==4 | source2or4 |
- remove(externals)
- "movzwl\t%[1],$4"
- setcc({EXTERNAL4, $4}) | | |
-loc loc cuu $1==2 && $2==4 | source2or4 |
- allocate(%[1],REG)
- "movzwl\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-
-/****************************************
- * Group 9 : Logical instructions *
- ****************************************/
-
-and $1==4 | source4 source4 |
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],%[a]"
- setcc(%[a]) | %[a] | | (7,6)+%[1]+%[2]
-... | CONST source4 |
- allocate(%[2],REG)
- "bicl3\t$$~%[1.num],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,3)+%[1]+%[2]
-... | source4 CONST |
- allocate(%[1],REG)
- "bicl3\t$$~%[2.num],%[1],%[a]"
- setcc(%[a]) | %[a] | | (4,3)+%[1]+%[2]
-and zeq $1==4 | source1 source1 |
- remove(ALL)
- "bitb\t%[1],%[2]"
- "jeql\t$2" | | |
-... | source2 source2 |
- remove(ALL)
- "bitw\t%[1],%[2]"
- "jeql\t$2" | | |
-... | source4 source4 |
- remove(ALL)
- "bitl\t%[1],%[2]"
- "jeql\t$2" | | |
-and zne $1==4 | source1 source1 |
- remove(ALL)
- "bitb\t%[1],%[2]"
- "jneq\t$2" | | |
-... | source2 source2 |
- remove(ALL)
- "bitw\t%[1],%[2]"
- "jneq\t$2" | | |
-... | source4 source4 |
- remove(ALL)
- "bitl\t%[1],%[2]"
- "jneq\t$2" | | |
-and tne $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "bitl\t%[1],%[2]"
-#ifdef LOCLABS
- "jeql\t1f"
- "incl\t%[a]\n1:"
-#else
- "jeql\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a]) | %[a] | |
-#ifdef REGVARS
-and stl $1==4 && inreg($2)==2
- | source4-CONST source4 |
- remove(regvar($2))
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | | (8,8)+%[1]+%[2]
-... | CONST source4 |
- remove(regvar($2))
- "bicl3\t$$~%[1.num],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | | (4,4)+%[1]+%[2]
-... | source4 CONST |
- remove(regvar($2))
- "bicl3\t$$~%[2.num],%[1],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | | (4,4)+%[1]+%[2]
-#endif REGVARS
-and stl $1==4 | source4-CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | | (9,12)+%[1]+%[2]
-... | NC CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "bicl3\t$$~%[1.num],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | | (6,9)+%[1]+%[2]
-... | NC source4 CONST |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "bicl3\t$$~%[2.num],%[1],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | | (6,9)+%[1]+%[2]
-#ifdef REGVARS
-and sil $1==4 && inreg($2)==2
- | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)})
- | | | (9,15)+%[1]+%[2]
-... | CONST source4 |
- REMEXTANDLOC
- "bicl3\t$$~%[1.num],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)})
- | | | (6,12)+%[1]+%[2]
-... | source4 CONST |
- REMEXTANDLOC
- "bicl3\t$$~%[2.num],%[1],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)})
- | | | (6,12)+%[1]+%[2]
-#endif REGVARS
-and sil $1==4 | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)})
- | | | (9,15)+%[1]+%[2]
-... | CONST source4 |
- REMEXTANDLOC
- "bicl3\t$$~%[1.num],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)})
- | | | (6,12)+%[1]+%[2]
-... | source4 CONST |
- REMEXTANDLOC
- "bicl3\t$$~%[2.num],%[1],*$2(fp)"
- setcc({displdef4,LB,tostring($2)})
- | | | (6,12)+%[1]+%[2]
-and ste $1==4 | source4-CONST source4 |
- remove(externals)
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- "bicl3\t%[a],%[2],$2"
- setcc({EXTERNAL4,$2}) | | | (11,12)+%[1]+%[2]
-... | CONST source4 |
- remove(externals)
- "bicl3\t$$~%[1.num],%[2],$2"
- setcc({EXTERNAL4,$2}) | | | (8,9)+%[1]+%[2]
-... | source4 CONST |
- remove(externals)
- "bicl3\t$$~%[2.num],%[1],$2"
- setcc({EXTERNAL4,$2}) | | | (8,9)+%[1]+%[2]
-and defined($1) | | remove(ALL)
- move({CONST4,$1},R0)
- "jsb\t.and"
- erase(R0) | | |
-and !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.and"
- erase(R0) | | |
-ior $1==4 | NC source4 source4 |
- allocate(%[1],%[2],REG)
- "bisl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-... | sreg4 source4 |
- "bisl2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,4) + %[2]
-... | source4 sreg4 |
- "bisl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,4) + %[1]
-#ifdef REGVARS
-ior stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "bisl3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-ior stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "bisl3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-ior sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "bisl3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-ior sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "bisl3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-ior ste $1==4 | source4 source4 |
- remove(externals)
- "bisl3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-ior defined($1) | | remove(ALL)
- move({CONST4, $1},R0)
- "jsb\t.ior"
- erase(R0) | | |
-ior !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.ior"
- erase(R0) | | |
-xor $1==4 | source4 source4 |
- allocate(%[1],%[2],REG)
- "xorl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-... | NC sreg4 source4 |
- "xorl2\t%[2],%[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (3,4) + %[2]
-... | NC source4 sreg4 |
- "xorl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,4) + %[1]
-#ifdef REGVARS
-xor stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "xorl3\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-xor stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "xorl3\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-xor sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "xorl3\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-xor sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "xorl3\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-xor ste $1==4 | source4 source4 |
- remove(externals)
- "xorl3\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-xor defined($1) | | remove(ALL)
- move({CONST4, $1},R0)
- "jsb\t.xor"
- erase(R0) | | |
-xor !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.xor"
- erase(R0) | | |
-com $1==4 | source4 |
- allocate(%[1],REG)
- "mcoml\t%[1],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-com stl $1==4 && inreg($2)==2
- | source4 |
- remove(regvar($2))
- "mcoml\t%[1],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-com stl $1==4 | source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "mcoml\t%[1],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-com sil $1==4 && inreg($2)==2
- | source4 |
- REMEXTANDLOC
- "mcoml\t%[1],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-com sil $1==4 | source4 |
- REMEXTANDLOC
- "mcoml\t%[1],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-com ste $1==4 | source4 |
- remove(externals)
- "mcoml\t%[1],$2"
- setcc({EXTERNAL4,$2}) | | |
-com defined($1) | | remove(ALL)
- move({CONST4,$1},R0)
- "jsb\t.com"
- erase(R0) | | |
-com !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.com"
- erase(R0) | | |
-rol $1==4 | source4 source4 |
- allocate(%[1],REG=%[1])
- "rotl\t%[a],%[2],%[a]"
- erase(%[a])
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-rol stl $1==4 && inreg($2)==2
- | source4 source4 |
- remove(regvar($2))
- "rotl\t%[1],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-rol stl $1==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "rotl\t%[1],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-rol sil $1==4 && inreg($2)==2
- | source4 source4 |
- REMEXTANDLOC
- "rotl\t%[1],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-rol sil $1==4 | source4 source4 |
- REMEXTANDLOC
- "rotl\t%[1],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-rol ste $1==4 | source4 source4 |
- remove(externals)
- "rotl\t%[1],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-rol !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.rol"
- erase(R0) | | |
-ror $1==4 | source4-CONST source4 |
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],%[a]"
- setcc(%[a]) | %[a] | |
-... | CONST source4 |
- allocate(%[2],REG)
- "rotl\t$$%(32-%[1.num]%),%[2],%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef REGVARS
-ror stl $1==4 && inreg($2)==2
- | source4-CONST source4 |
- remove(regvar($2))
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-... | CONST source4 |
- remove(regvar($2))
- "rotl\t$$%(32-%[1.num]%),%[2],%(regvar($2)%)"
- erase(regvar($2))
- setcc(regvar($2)) | | |
-#endif REGVARS
-ror stl $1==4 | source4-CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-... | CONST source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $2+3 && %[num]+%[size] > $2))
- "rotl\t$$%(32-%[1.num]%),%[2],$2(fp)"
- setcc({LOCAL4,$2, 4}) | | |
-#ifdef REGVARS
-ror sil $1==4 && inreg($2)==2
- | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-... | CONST source4 |
- REMEXTANDLOC
- "rotl\t$$%(32-%[1.num]%),%[2],(%(regvar($2)%))"
- setcc({regdef4,regvar($2)}) | | |
-#endif REGVARS
-ror sil $1==4 | source4-CONST source4 |
- REMEXTANDLOC
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-... | CONST source4 |
- REMEXTANDLOC
- "rotl\t$$%(32-%[1.num]%),%[2],*$2(fp)"
- setcc({displdef4,LB,tostring($2)}) | | |
-ror ste $1==4 | source4-CONST source4 |
- remove(externals)
- allocate(%[1],REG)
- "subl3\t%[1],$$32,%[a]"
- "rotl\t%[a],%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-... | CONST source4 |
- remove(externals)
- "rotl\t$$%(32-%[1.num]%),%[2],$2"
- setcc({EXTERNAL4,$2}) | | |
-ror !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.ror"
- erase(R0) | | |
-com and $1==4 && $2==4 | source4 source4 |
- allocate(%[1],%[2],REG)
- "bicl3\t%[1],%[2],%[a]"
- setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2]
-... | NC source4 sreg4 |
- "bicl2\t%[1],%[2]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (3,4) + %[1]
-... | source4 source4 |
- remove(ALL)
- "bicl3\t%[1],%[2],(sp)+" | | | (4,7)+%[1]+%[2]
-#ifdef REGVARS
-com and stl $1==4 && $2==4 && inreg($3)==2
- | source4 source4 |
- remove(regvar($3))
- "bicl3\t%[1],%[2],%(regvar($3)%)"
- erase(regvar($3))
- setcc(regvar($3)) | | |
-#endif REGVARS
-com and stl $1==4 && $2==4 | source4 source4 |
- remove(displaced)
- remove(LOCALS, (%[num] <= $3+3 && %[num]+%[size] > $3))
- "bicl3\t%[1],%[2],$3(fp)"
- setcc({LOCAL4,$3, 4}) | | |
-#ifdef REGVARS
-com and sil $1==4 && $2==4 && inreg($3)==2
- | source4 source4 |
- REMEXTANDLOC
- "bicl3\t%[1],%[2],(%(regvar($3)%))"
- setcc({regdef4,regvar($3)}) | | |
-#endif REGVARS
-com and sil $1==4 && $2==4 | source4 source4 |
- REMEXTANDLOC
- "bicl3\t%[1],%[2],*$3(fp)"
- setcc({displdef4,LB,tostring($3)}) | | |
-com and ste $1==4 &&$2==4 | source4 source4 |
- remove(externals)
- "bicl3\t%[1],%[2],$3"
- setcc({EXTERNAL4,$3}) | | |
-com and $1==$2 | | remove(ALL)
- move({CONST4, $1}, R0)
- "jsb\t.cmand"
- erase(R0) | | |
-
-/********************************
- * Group 10: Set instructions *
- ********************************/
-
-loc inn $1==0 && $2==4 | source4 |
- allocate(%[1], REG)
- "bicl3\t$$~1,%[1],%[a]"
- setcc(%[a]) | %[a] | |
-loc inn $2==4 | source4 |
- allocate(%[1], REG)
- "ashl\t$$%(0-$1%),%[1],%[a]"
- "bicl2\t$$~1,%[a]"
- setcc(%[a]) | %[a] | |
-#ifdef LOCLABS
-inn $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],$$31"
- "bgtru\t1f"
- "mnegl\t%[1],%[a]"
- "ashl\t%[a],%[2],%[a]"
- "bicl2\t$$~1,%[a]\n1:"
- setcc(%[a])
- erase(%[a]) | %[a] | |
-#endif
-loc inn zeq $2==4 | source4 |
- remove(ALL)
- "bitl\t%[1],$$%(1<<$1%)"
- "jeql\t$3" | | |
-loc inn zne $2==4 | source4 |
- remove(ALL)
- "bitl\t%[1],$$%(1<<$1%)"
- "jneq\t$3" | | |
-inn zeq $1==4 | source4 source4 |
- remove(ALL)
- allocate(REG)
- "cmpl\t%[1],$$31"
- "jgtru\t$2"
- "ashl\t%[1],$$1,%[a]"
- "bitl\t%[2],%[a]"
- "jeql\t$2" | | |
-#ifdef LOCLABS
-inn zne $1==4 | source4 source4 |
- remove(ALL)
- allocate(REG)
- "cmpl\t%[1],$$31"
- "bgtru\t1f"
- "ashl\t%[1],$$1,%[a]"
- "bitl\t%[2],%[a]"
- "jneq\t$2\n1:" | | |
-#endif
-loc inn zeq $2==8 && $1<32 /* First half of set. */
- | REG REG |
- remove(ALL)
- "bitl\t%[1],$$%(1<<$1%)"
- "jeql\t$3" | | |
-loc inn zeq $2==8 && $1>=32 /* Second half. */
- | REG REG |
- remove(ALL)
- "bitl\t%[2],$$%(1<<($1-32)%)"
- "jeql\t$3" | | |
-loc inn zne $2==8 && $1<32 /* First half of set. */
- | REG REG |
- remove(ALL)
- "bitl\t%[1],$$%(1<<$1%)"
- "jneq\t$3" | | |
-loc inn zne $2==8 && $1>=32 /* Second half. */
- | REG REG |
- remove(ALL)
- "bitl\t%[2],$$%(1<<($1-32)%)"
- "jneq\t$3" | | |
-inn defined($1) | | remove(ALL)
- move({CONST4, $1},R0)
- "jsb\t.inn"
- erase(R0) | R1 | |
-inn !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.inn"
- erase(R0) | R1 | |
-set $1==4 | source4 | | {CONST4,1} %[1] | sli 4 |
-set defined($1) | | remove(ALL)
- move({CONST4, $1},R0)
- "jsb\t.setx"
- erase(R0) | | |
-set !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.setx"
- erase(R0) | | |
-
-/****************************************
- * Group 11 : Array instructions *
- ****************************************/
-
-lae aar $2==4 && rom(1,3)==1 | | | | ads 4 adp 0-rom(1,1) |
-lae aar $2==4 && rom(1,3)==2 | | | | loc 1 sli 4 ads 4 adp 0-2*rom(1,1) |
-lae aar $2==4 && rom(1,3)==4 | | | | loc 2 sli 4 ads 4 adp 0-4*rom(1,1) |
-lae aar $2==4 && rom(1,3)==8 | | | | loc 3 sli 4 ads 4 adp 0-8*rom(1,1) |
-lae aar $2==4 && defined(rom(1,3)) && rom(1,1)==0
- | source4 source4 |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- "addl2\t%[2],%[a]"
- setcc(%[a]) | %[a] | | (10,20)+%[1]+%[2]
-... | NC source4 adispl |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- "addl2\t%[2.reg],%[a]"
- setcc(%[a])
- | {adispl,%[a],%[2.ind]} | | (10,20)+%[1]
-... | NC source4 ADDR_LOCAL |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- "addl2\tfp,%[a]"
- setcc(%[a])
- | {adispl,%[a],tostring(%[2.num])} | | (10,20)+%[1]
-... | NC source4 ADDR_EXTERNAL |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- setcc(%[a])
- | {adispl,%[a],%[2.ind]} | | (7,16)+%[1]
-lae aar $2==4 && defined(rom(1,3))
- | source4 adispl |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- "addl2\t%[2.reg],%[a]"
- setcc(%[a])
- | {adispl,%[a],
- %[2.ind]+"+"+tostring(0-rom(1,1)*rom(1,3))}
- | | (10,20)+%[1]
-... | NC source4 source4 |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- "addl2\t%[2],%[a]"
- setcc(%[a])
- | {adispl,%[a],tostring(0-rom(1,1)*rom(1,3))}
- | | (10,20)+%[1]+%[2]
-... | NC source4 ADDR_EXTERNAL |
- allocate(%[1],REG)
- "mull3\t$$%(rom(1,3)%),%[1],%[a]"
- setcc(%[a])
- | {adispl,%[a],
- %[2.ind]+"+"+tostring(0-rom(1,1)*rom(1,3))}
- | | (7,16)+%[1]
-/* Sequence used by the CEM-compiler and the codegenerator. */
-loc sli ads $1==2 && $2==4 && $3==4
- | reg4 ADDR_EXTERNAL |
- | {aextind4,%[1],%[2.ind]} | |
-... | reg4 adispl |
- | {adisplind4,%[1],%[2.reg],%[2.ind]} | |
-... | reg4 displ4 |
- | {adispldefind4,%[1],%[2.reg],%[2.ind]} | |
-... | reg4 EXTERNAL4 |
- | {aextdefind4,%[1],%[2.ind]} | |
-loc sli ads $1==3 && $2==4 && $3==4
- | reg4 ADDR_EXTERNAL |
- | {aextind8,%[1],%[2.ind]} | |
-... | reg4 adispl |
- | {adisplind8,%[1],%[2.reg],%[2.ind]} | |
-... | reg4 displ4 |
- | {adispldefind8,%[1],%[2.reg],%[2.ind]} | |
-... | reg4 EXTERNAL4 |
- | {aextdefind8,%[1],%[2.ind]} | |
-aar $1==4 | | remove(ALL)
- "jsb\t.aar4" | R0 | |
-aar !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.aar"
- erase(R0) | R0 | |
-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==4 | | remove(ALL)
- "jsb\t.sar4" | | |
-sar !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.sar"
- erase(R0) | | |
-lar $1==4 | | remove(ALL)
- "jsb\t.lar4" | | |
-lar !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.lar"
- erase(R0) | | |
-
-/****************************************
- * Group 12 : Compare instructions *
- ****************************************/
-
-cmi $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "beql\t2f"
- "bgtr\t1f"
-#else
- "beql\t.+10"
- "bgtr\t.+6"
-#endif
- "incl\t%[a]"
-#ifdef LOCLABS
- "brb\t2f\n1:"
- "decl\t%[a]\n2:"
-#else
- "brb\t.+4"
- "decl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmi !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.cmi"
- setcc(R0)
- erase(R0) | R0 | |
-cmf $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "beql\t2f"
- "bgtr\t1f"
-#else
- "beql\t.+10"
- "bgtr\t.+6"
-#endif
- "incl\t%[a]"
-#ifdef LOCLABS
- "brb\t2f\n1:"
- "decl\t%[a]\n2:"
-#else
- "brb\t.+4"
- "decl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf $1==8 | source8 source8 |
-/* trouble, possible lack of scratch registers */
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "blss\t2f"
- "bgtr\t1f"
-#else
- "blss\t.+8"
- "bgtr\t.+11"
-#endif
- "clrl\t%[a]"
-#ifdef LOCLABS
- "brb\t3f\n2:"
-#else
- "brb\t.+10"
-#endif
- "movl\t$$1,%[a]"
-#ifdef LOCLABS
- "brb\t3f\n1:"
- "mnegl\t$$1,%[a]\n3:"
-#else
- "brb\t.+5"
- "mnegl\t$$1,%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.cmf"
- setcc(R0)
- erase(R0) | R0 | |
-cmu $1==4 | | | | cmp |
-cmu !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.cmu"
- setcc(R0)
- erase(R0) | R0 | |
-cmp | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "beqlu\t2f"
- "bgtru\t1f"
-#else
- "beqlu\t.+10"
- "bgtru\t.+6"
-#endif
- "incl\t%[a]"
-#ifdef LOCLABS
- "brb\t2f\n1:"
- "decl\t%[a]\n2:"
-#else
- "brb\t.+4"
- "decl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cms $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bneq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bneq\t.+4"
- "incl\t%[a]"
-#endif
- setcc(%[a])
- erase(%[a]) | %[a] | |
-cms defined($1) | | remove(ALL)
- move({CONST1,$1},R0)
- "jsb\t.cms"
- setcc(R0)
- erase(R0) | R0 | |
-cms !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.cms"
- setcc(R0)
- erase(R0) | R0 | |
-tlt | source4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "bgeq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgeq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 | | {CONST1,0} | |
-tlt and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "blss\t1f"
- "clrl\t%[2]\n1:"
-#else
- "blss\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tlt ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bgeq\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "bgeq\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tle | source4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "bgtr\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtr\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 | | %[1] | teq |
-tle and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bleq\t1f"
- "clrl\t%[2]\n1:"
-#else
- "bleq\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tle ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bgtr\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "bgtr\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tge | source4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "blss\t1f"
- "incl\t%[a]\n1:"
-#else
- "blss\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 | | {CONST1,1} | |
-tge and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bgeq\t1f"
- "clrl\t%[2]\n1:"
-#else
- "bgeq\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tge ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "blss\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "blss\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tgt | source4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "bleq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bleq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 | | %[1] | tne |
-tgt and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bgtr\t1f"
- "clrl\t%[2]\n1:"
-#else
- "bgtr\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tgt ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bleq\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "bleq\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-teq | source1or2or4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "bneq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bneq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-teq and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "beql\t1f"
- "clrl\t%[2]\n1:"
-#else
- "beql\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-teq ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bneq\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "bneq\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tne | source1or2or4 |
- allocate(REG={CONST1,0})
- test(%[1])
-#ifdef LOCLABS
- "beql\t1f"
- "incl\t%[a]\n1:"
-#else
- "beql\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-tne and $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "bneq\t1f"
- "clrl\t%[2]\n1:"
-#else
- "bneq\t.+4"
- "clrl\t%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-tne ior $2==4 | source4 sreg4 |
- test(%[1])
-#ifdef LOCLABS
- "beql\t1f"
- "bisl2\t$$1,%[2]\n1:"
-#else
- "beql\t.+4"
- "bisl2\t$$1,%[2]"
-#endif
- setcc(%[2])
- erase(%[2]) | %[2] | |
-cmi tlt $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bleq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bleq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 tlt |
-cmi tle $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "blss\t1f"
- "incl\t%[a]\n1:"
-#else
- "blss\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 tle |
-cmi teq $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bneq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bneq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 teq |
-cmi tne $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "beql\t1f"
- "incl\t%[a]\n1:"
-#else
- "beql\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 tne |
-cmi tge $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtr\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtr\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 tge |
-cmi tgt $1==4 | source4 source4 |
- allocate(REG={CONST4,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bgeq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgeq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1or2 source1or2 |
- | %[2] %[1] | cmu 4 tgt |
-cmi tlt and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "blss\t1f"
- "clrl\t%[3]\n1:"
-#else
- "blss\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tle and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bleq\t1f"
- "clrl\t%[3]\n1:"
-#else
- "bleq\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi teq and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "beql\t1f"
- "clrl\t%[3]\n1:"
-#else
- "beql\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tne and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bneq\t1f"
- "clrl\t%[3]\n1:"
-#else
- "bneq\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tge and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bgeq\t1f"
- "clrl\t%[3]\n1:"
-#else
- "bgeq\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tgt and $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bgtr\t1f"
- "clrl\t%[3]\n1:"
-#else
- "bgtr\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bgeq\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "bgeq\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tle ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bgtr\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "bgtr\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi teq ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bneq\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "bneq\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tne ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "beql\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "beql\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tge ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "blss\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "blss\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==4 && $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bleq\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "bleq\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmf tlt $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "bleq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bleq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tle $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "blss\t1f"
- "incl\t%[a]\n1:"
-#else
- "blss\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf teq $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "bneq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bneq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tne $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "beql\t1f"
- "incl\t%[a]\n1:"
-#else
- "beql\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tge $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtr\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtr\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tgt $1==4 | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpf\t%[1],%[2]"
-#ifdef LOCLABS
- "bgeq\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgeq\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tlt $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "bleq\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "bleq\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
-
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tle $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "blss\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "blss\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf teq $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "bneq\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "bneq\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tne $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "beql\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "beql\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tge $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtr\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "bgtr\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmf tgt $1==8 | source8 source8 |
- allocate(%[1],%[2],REG)
- "cmpd\t%[1],%[2]"
-#ifdef LOCLABS
- "bgeq\t1f"
- "movl\t$$1,%[a]"
- "brb\t2f\n1:"
- "clrl\t%[a]\n2:"
-#else
- "bgeq\t.+9"
- "movl\t$$1,%[a]"
- "brb\t.+4"
- "clrl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-/* Remember that cmu was replaced by cmp. */
-cmp tlt | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "blequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "blequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "blequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "blequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "blequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "blequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp tle | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "blssu\t1f"
- "incl\t%[a]\n1:"
-#else
- "blssu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "blssu\t1f"
- "incl\t%[a]\n1:"
-#else
- "blssu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "blssu\t1f"
- "incl\t%[a]\n1:"
-#else
- "blssu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp teq | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bnequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bnequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "bnequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bnequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "bnequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bnequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp tne | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "beqlu\t1f"
- "incl\t%[a]\n1:"
-#else
- "beqlu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "beqlu\t1f"
- "incl\t%[a]\n1:"
-#else
- "beqlu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "beqlu\t1f"
- "incl\t%[a]\n1:"
-#else
- "beqlu\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp tge | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtru\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtru\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtru\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtru\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "bgtru\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgtru\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp tgt | source4 source4 |
- allocate(REG={CONST1,0})
- "cmpl\t%[1],%[2]"
-#ifdef LOCLABS
- "bgequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source1 source1 |
- allocate(REG={CONST1,0})
- "cmpb\t%[1],%[2]"
-#ifdef LOCLABS
- "bgequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-... | NC source2 source2 |
- allocate(REG={CONST1,0})
- "cmpw\t%[1],%[2]"
-#ifdef LOCLABS
- "bgequ\t1f"
- "incl\t%[a]\n1:"
-#else
- "bgequ\t.+4"
- "incl\t%[a]"
-#endif
- erase(%[a])
- setcc(%[a]) | %[a] | |
-cmp teq and $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "beql\t1f"
- "clrl\t%[3]\n1:"
-#else
- "beql\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmp tne and $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bneq\t1f"
- "clrl\t%[3]\n1:"
-#else
- "bneq\t.+4"
- "clrl\t%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmp teq ior $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "bneq\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "bneq\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cmp tne ior $3==4
- | source4 source4 sreg4 |
- "cmpl\t%[2],%[1]"
-#ifdef LOCLABS
- "beql\t1f"
- "bisl2\t$$1,%[3]\n1:"
-#else
- "beql\t.+7"
- "bisl2\t$$1,%[3]"
-#endif
- setcc(%[3])
- erase(%[3]) | %[3] | |
-cms teq $1==4 | | | | cmp teq |
-cms tne $1==4 | | | | cmp tne |
-
-/****************************************
- * Group 13 : Branch instructions *
- ****************************************/
-
-bra | STACK |
- "jbr\t$1" | | |
-blt | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jgtr\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jgtru\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jgtru\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jgtr\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jgtr\t$1" | | |
-ble | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jgeq\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jgequ\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jgequ\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jgeq\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jgeq\t$1" | | |
-beq | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jeql\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jeqlu\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jeqlu\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jeql\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jeql\t$1" | | |
-bne | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jneq\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jnequ\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jnequ\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jneq\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jneq\t$1" | | |
-bge | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jleq\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jlequ\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jlequ\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jleq\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jleq\t$1" | | |
-bgt | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jlss\t$1" | | |
-... | NC source2 source2 STACK |
- "cmpw\t%[1],%[2]"
- "jlssu\t$1" | | |
-... | NC source1 source1 STACK |
- "cmpb\t%[1],%[2]"
- "jlssu\t$1" | | |
-... | NC source4 STACK |
- "cmpl\t%[1],(sp)+"
- "jlss\t$1" | | |
-... | STACK |
- "cmpl\t(sp)+,(sp)+"
- "jlss\t$1" | | |
-zlt | source4 STACK |
- test(%[1])
- "jlss\t$1"
- samecc | | |
-... | NC source1or2 | | | |
-zle | source4 STACK |
- test(%[1])
- "jleq\t$1"
- samecc | | |
-... | NC source1or2 | | %[1] | zeq $1 |
-zeq | source1or2or4 STACK |
- test(%[1])
- "jeql\t$1"
- samecc | | |
-zne | source1or2or4 STACK |
- test(%[1])
- "jneq\t$1"
- samecc | | |
-zge | source4 STACK |
- test(%[1])
- "jgeq\t$1"
- samecc | | |
-... | NC source1or2 | | | bra $1 |
-zgt | source4 STACK |
- test(%[1])
- "jgtr\t$1"
- samecc | | |
-... | NC source1or2 | | %[1] | zne $1 |
-cmf zlt $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jgtr\t$2" | | |
-cmf zle $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jgeq\t$2" | | |
-cmf zne $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jneq\t$2" | | |
-cmf zeq $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jeql\t$2" | | |
-cmf zge $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jleq\t$2" | | |
-cmf zgt $1==4 | source4 source4 STACK |
- "cmpf\t%[1],%[2]"
- "jlss\t$2" | | |
-cmf zlt $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jgtr\t$2" | | |
-cmf zle $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jgeq\t$2" | | |
-cmf zne $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jneq\t$2" | | |
-cmf zeq $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jeql\t$2" | | |
-cmf zge $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jleq\t$2" | | |
-cmf zgt $1==8 | source8 source8 |
- remove(ALL)
- "cmpd\t%[1],%[2]"
- "jlss\t$2" | | |
-cmp zlt | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jgtru\t$2" | | |
-... | NC source1or2 source1or2 | | %[2] %[1] | blt $2 |
-cmp zle | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jgequ\t$2" | | |
-... | NC source1or2 source1or2 | | %[2] %[1] | ble $2 |
-cmp zne | | | | bne $2 |
-cmp zeq | | | | beq $2 |
-cmp zge | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jlequ\t$2" | | |
-... | NC source1or2 source1or2 | | %[2] %[1] | bge $2 |
-cmp zgt | source4 source4 STACK |
- "cmpl\t%[1],%[2]"
- "jlssu\t$2" | | |
-... | NC source1or2 source1or2 | | %[2] %[1] | bgt $2 |
-cms zeq $1==4 | | | | cmp zeq $2 |
-cms zne $1==4 | | | | cmp zne $2 |
-
-/************************************************
- * Group 14 : Procedure call instructions *
- ************************************************/
-
-cai | | remove(ALL)
- "jsb\t*(sp)+" | | | (2,10)
-... | reg4 |
- remove(ALL)
- "jsb\t(%[1])" | | | (2,7)
-cal | | remove(ALL)
- "jsb\t$1" | | |
-lfr $1==4 | | | R0 | |
-lfr $1==8 | | | QR0 | |
-asp ret $2==0 | | | | ret 0 |
-ass ret $2==0 | | | | ret 0 |
-asp lfr ret $2==$3 | | | | ret 0 |
-ass lfr ret $2==$3 | | | | ret 0 |
-lfr ret $1==$2 | | | | ret 0 |
-#ifdef REGVARS
-ret $1==0 | | remove(ALL)
- return | | |
-#else REGVARS
-ret $1==0 | | remove(ALL)
- "movl\tfp,sp"
- "movl\t(sp)+,fp"
- "rsb" | | |
-#endif REGVARS
-ret $1==4 | bigsource4 |
- move(%[1],R0) | | ret 0 |
-ret $1==8 | bigsource8 |
- move(%[1],QR0) | | ret 0 |
-... | bigsource4 bigsource4 |
- move(%[1],R0)
- move(%[2],R1) | | ret 0 |
-
-/********************************
- * Group 15 : Miscellaneous *
- ********************************/
-
-#ifdef REGVARS
-asp $1==4 | bigsource4 - regch4 | | | |
-#else REGVARS
-asp $1==4 | NC bigsource4 | | | |
-#endif REGVARS
-... | | remove(ALL)
- "tstl\t(sp)+" | | | (2,7)
-asp $1>0 | | remove(ALL)
- "addl2\t$$$1,sp" | | |
-asp $1==(0-4) | | | {CONST4,0} | |
-asp $1==(0-8) | | | {CONST8,"0"} | |
-asp | | remove(ALL)
- "subl2\t$$%(0-$1%),sp" | | |
-ass $1==4 | source4 |
- remove(ALL)
- "addl2\t%[1],sp" | | |
-ass !defined($1) | source4 |
- remove(ALL)
- move(%[1],R2)
- "jsb\t.ass"
- erase(R2) | | |
-blm $1==4 | nonexist1 nonexist1 |
- remove(ALL)
- "movl\t%[2],%[1]" | | |
-blm $1==8 | nonexist1 nonexist1 |
- remove(ALL)
- "movq\t%[2],%[1]" | | |
-blm $1==12 | sreg4 sreg4 |
- remove(ALL)
- "movl\t(%[2])+,(%[1])+"
- "movq\t(%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm $1==16 | sreg4 sreg4 |
- remove(ALL)
- "movq\t(%[2])+,(%[1])+"
- "movq\t(%[2]),(%[1])"
- erase(%[1]) erase(%[2]) | | |
-blm | sreg4 sreg4 |
- remove(ALL)
- allocate(REG={CONST1, $1/4})
-#ifdef LOCLABS
- "1:\nmovl\t(%[2])+,(%[1])+"
- "sobgtr\t%[a],1b"
-#else
- "\nmovl\t(%[2])+,(%[1])+"
- "sobgtr\t%[a],.-3"
-#endif
- erase(%[1]) erase(%[2]) erase(%[a])
- | | |
-bls $1==4 | |
- remove(ALL)
- move({CONST1,4},R0)
- "jsb\t.bls"
- erase(R0) | | |
-bls !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.bls"
- erase(R0) | | |
-csa $1==4 | | remove(ALL)
- "jmp\t.csa4" | | |
-csa !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jmp\t.csa"
- erase(R0) | | |
-csb $1==4 | | remove(ALL)
- "jmp\t.csb4" | | |
-csb !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jmp\t.csb"
- erase(R0) | | |
-dch | | | | loi 4 |
-dup stl $1==4 | | | | stl $2 lol $2 |
-#ifdef REGVARS
-dup sil $1==4 && inreg($2)==2
- | bigsource4 |
- REMEXTANDLOC
- move(%[1],{regdef4,regvar($2)})
- | {regdef4,regvar($2)} | |
-#endif REGVARS
-dup $1==4 | reg4+regdef4 | | %[1] %[1] | |
-#ifdef REGVARS
-dup $1==8 | bigsource8-regch8 | | %[1] %[1] | |
-#else REGVARS
-dup $1==8 | bigsource8 | | %[1] %[1] | |
-#endif REGVARS
-dup | | remove(ALL)
- allocate(REG,REG={CONST1,$1/4})
- "addl3\tsp,$$$1,%[a]"
-#ifdef LOCLABS
- "1:\nmovl\t-(%[a]),-(sp)"
- "sobgtr\t%[b],1b"
-#else
- "movl\t-(%[a]),-(sp)"
- "sobgtr\t%[b],.-3"
-#endif
- erase(%[b]) | | |
-dus $1==4 | source4 |
- remove(ALL)
- allocate(REG,REG)
- "ashl\t$$-2,%[1],%[b]"
- "addl3\tsp,%[1],%[a]"
-#ifdef LOCLABS
- "1:\nmovl\t-(%[a]),-(sp)"
- "sobgtr\t%[b],1b"
-#else
- "movl\t-(%[a]),-(sp)"
- "sobgtr\t%[b],.-3"
-#endif
- | | |
-dus !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.dus"
- erase(R0) | | |
-exg $1==4 | bigsource4 bigsource4 | | %[1] %[2] | |
-exg $1==8 | bigsource8 bigsource8 | | %[1] %[2] | |
-exg defined($1) | | remove(ALL)
- move({CONST4,$1},R0)
- "jsb\t.exg"
- erase(R0) | | |
-exg !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.exg"
- erase(R0) | | |
-fil | | "movl\t$$$1,hol0+4" | | |
-lim | | allocate(REG)
- "movl\t.trpim,%[a]" | %[a] | |
-lin | | "movl\t$$$1,hol0" | | |
-lni | | "incl\thol0" | | |
-gto | | remove(ALL)
- "pushl\t$$$1"
- "jmp\t.gto" | | |
-lor $1==0 | | | LB | |
-lor $1==1 | | remove(ALL)
- allocate(REG)
- "movl\tsp,%[a]" | %[a] | |
-lor $1==2 | | allocate(REG)
- "movl\t.reghp,%[a]" | %[a] | |
-lpb | bigsource4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.lpb"
- erase(R0) | R0 | |
-mon | | remove(ALL)
- "jsb\t.mon" | | |
-nop | | remove(ALL)
- "jsb\t.nop" | | |
-#ifdef DORCK
-rck $1==4 | | remove(ALL)
- "jsb\t.rck4" | | |
-rck !defined($1) | source4 |
- remove(ALL)
- move(%[1],R0)
- "jsb\t.rck"
- erase(R0) | | |
-#else DORCK
-#ifdef REGVARS
-rck defined($1) | bigsource4-regch4 | | | |
-rck !defined($1) | bigsource4-regch4 bigsource4-regch4 | | | |
-#else REGVARS
-rck defined($1) | bigsource4 | | | |
-rck !defined($1) | bigsource4 bigsource4 | | | |
-#endif REGVARS
-#endif DORCK
-rtt | | | | ret 0 |
-sig | | remove(ALL)
- "jsb\t.sig" | | |
-sim | | remove(ALL)
- "jsb\t.sim" | | |
-str $1==0 | source4 |
- remove(ALL)
- "movl\t%[1],fp" | | |
-str $1==1 | source4 |
- remove(ALL)
- "movl\t%[1],sp" | | |
-str $1==2 | | remove(ALL)
- "jsb\t.strhp" | | |
-trp | | remove(ALL)
- "jsb\t.trp" | | |
-
-/********************************
- * Coercions: *
- * *
- * A: From source to register, *
- * from nonexist to source. *
- ********************************/
-
-| ADDR_EXTERNAL | | {DOUBLE,%[1.ind]} | |
-| source1 | allocate(%[1],REG=%[1]) | %[a] | |
-| source2 | allocate(%[1],REG=%[1]) | %[a] | |
-| bigsource4 | allocate(%[1],REG=%[1]) | %[a] | |
-| bigsource8 | allocate(%[1],QREG=%[1]) | %[a] | |
-
-/********************************
- * B: From STACK to register *
- ********************************/
-
-| STACK | allocate(REG)
- "movl\t(sp)+,%[a]"
- setcc(%[a]) | %[a] | | (3,7)
-| STACK | allocate(QREG)
- "movq\t(sp)+,%[a]"
- setcc(%[a]) | %[a] | | (3,10)
-| STACK | allocate(REG)
- "movl\t(sp)+,%[a]"
- setcc(%[a]) | {adispl,%[a],"0"} | | (3,7)
-
-/****************
- * C: General *
- ****************/
-
-| regdef8 | | {displ4,%[1.reg],"4"} {regdef4,%[1.reg]} | |
-| displ8 | | {displ4,%[1.reg],%[1.ind]+"+4"}
- {displ4,%[1.reg],%[1.ind]} | |
-| LOCAL8 | | {LOCAL4,%[1.num]+4,4} {LOCAL4,%[1.num],4} | |
-| EXTERNAL8 | | {EXTERNAL4,%[1.ind]+"+4"} {EXTERNAL4,%[1.ind]} | |
-| QREG | | %[1.2] %[1.1] | |
-| regdef4 | | {displ4,%[1.reg],"0"} | |
-| ADDR_LOCAL | | {adispl,LB,tostring(%[1.num])} | |
-| reg4 | | {adispl,%[1],"0"} | |
-| LOCAL4 | | {displ4,LB,tostring(%[1.num])} | |
-| nonexist+source4-reg4-adispl-ADDR_LOCAL |
- allocate(%[1],REG=%[1]) | {adispl,%[a],"0"} | |
-
-MOVES:
-(CONST %[num]==0, source1, "clrb\t%[2]", (2,4)+%[2])
-(CONST %[num]==0, source2, "clrw\t%[2]", (2,4)+%[2])
-(CONST %[num]==0, source4, "clrl\t%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST %[num]<0 && ufit(0-%[num],6), source2,
- "mnegw\t$$%(0-%[1.num]%),%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST ufit(%[num],8) && !ufit(%[num],6), source2,
- "movzbw\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST sfit(%[num],8) && !ufit(%[num],6), source2,
- "cvtbw\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST %[num]<0 && ufit(0-%[num],6), source4,
- "mnegl\t$$%(0-%[1.num]%),%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST ufit(%[num],8) && !ufit(%[num],6), source4,
- "movzbl\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST sfit(%[num],8) && !ufit(%[num],6), source4,
- "cvtbl\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST ufit(%[num],16) && !ufit(%[num],6), source4,
- "movzwl\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST sfit(%[num],16) && !ufit(%[num],6), source4,
- "cvtwl\t%[1],%[2]"
- setcc(%[2]), (2,4)+%[2])
-(CONST8 %[ind]=="0", source8, "clrq\t%[2]"
- setcc(%[2]), (2,4)+%[2])
-(FCONST8 %[num]==0, source8, "clrq\t%[2]"
- setcc(%[2]), (2,4)+%[2])
-(FCONST8, source8, "movd\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-#ifdef REGVARS
-/* Tokens with side effects should not be remembered. */
-(reginc1+regdec1,reg4, "movzbl\t%[1],%[2]"
- setcc(%[2]) erase(%[2]),(3,4)+%[1])
-(reginc2+regdec2,reg4, "movzwl\t%[1],%[2]"
- setcc(%[2]) erase(%[2]),(3,4)+%[1])
-(reginc4+regdec4,reg4, "movl\t%[1],%[2]"
- setcc(%[2]) erase(%[2]),(3,4)+%[1])
-(reginc8+regdec8,reg8, "movq\t%[1],%[2]"
- setcc(%[2]) erase(%[2]),(3,7)+%[1])
-#endif REGVARS
-(source8, source8, "movq\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source4, source4, "movl\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source2, source2, "movw\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source1, source1, "movb\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source1, source2, "movzbw\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source1, source4, "movzbl\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source2, source4, "movzwl\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source2, source1, "cvtwb\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source4, source1, "cvtlb\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(source4, source2, "cvtlw\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(aind1, source4, "movab\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(aind2, source4, "movaw\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(aind4, source4, "moval\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(aind8, source4, "movaq\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-(nonexist1, source4, "movab\t%[1],%[2]"
- setcc(%[2]), (3,4)+%[1]+%[2])
-TESTS:
-(source1, "tstb\t%[1]" ,(2,4) + %[1])
-(source2, "tstw\t%[1]" ,(2,4) + %[1])
-(source4, "tstl\t%[1]" ,(2,4) + %[1])
-
-STACKS:
-
-(CONST %[num]==0, ,
- "clrl\t-(sp)", (2,7))
-(CONST %[num]<0 && ufit(0-%[num],6), ,
- "mnegl\t$$%(0-%[1.num]%),-(sp)",
- (2,7) + %[1])
-(CONST ufit(%[num],6), ,
- "pushl\t%[1]", (2,7) + %[1])
-(CONST8 %[ind]=="0", ,
- "clrq\t-(sp)", (2,10))
-(CONST sfit(%[num],8), ,
- "cvtbl\t%[1],-(sp)", (3,7) + %[1])
-(source1, , "movzbl\t%[1],-(sp)", (3,7) + %[1])
-(CONST sfit(%[num],16), ,
- "cvtwl\t%[1],-(sp)", (3,7) + %[1])
-(source2, , "movzwl\t%[1],-(sp)", (3,7) + %[1])
-(source4, , "pushl\t%[1]"
- setcc(%[1]), (2,7) + %[1])
-(source8, , "movq\t%[1],-(sp)"
- setcc(%[1]), (3,10)+ %[1])
-(nonexist1, , "pushal\t%[1]", (2,7) + %[1])
-(FCONST8 %[num]==0, ,
- "clrq\t-(sp)", (2,10))
-(FCONST8, , "movd\t%[1],-(sp)", (3,10) + %[1])
-(aind1, , "pushab\t%[1]", (2,7) + %[1])
-(aind2, , "pushaw\t%[1]", (2,7) + %[1])
-(aind4, , "pushal\t%[1]", (2,7) + %[1])
-(aind8, , "pushaq\t%[1]", (2,7) + %[1])
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=vax4" "SUF=o" "ASAR=ar"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.o
+++ /dev/null
-TAILSRC=tail_em.a
-
-install: head_em tail_em
- ../../install head_em
- ../../install tail_em
- -rm -f head_em tail_em
-
-cmp: head_em tail_em
- -../../compare head_em
- -../../compare tail_em
-
-head_em: head_em.s system.h
- vax4 -c -I../../../h head_em.s
- mv head_em.o head_em
-
-tail_em: $(TAILSRC) system.h
- arch x $(TAILSRC) ;\
- ALL= ; \
- for i in `arch t $(TAILSRC)` ; do \
- BN=`basename $$i .s`.o ; \
- vax4 -I../../../h -c $$i ; \
- RM="$$RM $$i" ; \
- ALL="$$ALL $$BN" ; \
- done ; \
- ar r tail_em $$ALL ; rm -f $$RM $$ALL
-
-clean:
- -rm -f `arch t $(TAILSRC)` *.old *.o
-
-opr:
- make pr | opr
-
-pr:
- @(pr head_em.s ; arch pv $(TAILSRC) | pr -h "vax4/libem" )
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=vax4" "SUF=o" "ASAR=ar"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.o
+++ /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
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=z80" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-MAKEFILE=../../proto/libg/Makefile
-MACHDEF="MACH=z80" "SUF=s"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /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
-/*
- * (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
- *
- */
-
-/*
- * machine dependent back end routines for the z8000
- */
-
-con_part(sz,w) register sz; word w; {
-
- while (part_size % sz)
- part_size++;
- if (part_size == TEM_WSIZE)
- part_flush();
- if (sz == 1) {
- w &= 0xFF;
- if (part_size == 0)
- w <<= 8;
- part_word |= w;
- } else {
- assert(sz == 2);
- part_word = w;
- }
- part_size += sz;
-}
-
-con_mult(sz) word sz; {
-
- if (sz != 4)
- fatal("bad icon/ucon size");
- fprintf(codefile,"\t.long %s\n", str);
-}
-
-con_float() {
-
-static int been_here;
- if (argval != 4 && argval != 8)
- fatal("bad fcon size");
- fprintf(codefile,"\t.long ");
- if (argval == 8)
- fprintf(codefile,"F_DUM, ");
- fprintf(codefile,"F_DUM\n");
- if ( !been_here++)
- {
- fprintf(stderr,"Warning : dummy float-constant(s)\n");
- }
-}
-
-/*
-
-string holstr(n) word n; {
-
- sprintf(str,hol_off,n,holno);
- return(mystrcpy(str));
-}
-*/
-
-prolog(nlocals) full nlocals; {
-
- fprintf(codefile,"\tpush\t*RR14, R13\n\tld\tR13, R15\n");
- if (nlocals == 0)
- return;
- else
- fprintf(codefile,"\tsub\tR15, $%d\n",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) ;
- printf(".define %s\n",argstr) ;
- break ;
- }
- }
- default :
- while ( getarg(any_ptyp) != sp_cend ) ;
- break ;
- }
-}
-
-char *segname[] = {
- ".text", /* SEGTXT */
- ".data", /* SEGCON */
- ".data", /* SEGROM */
- ".bss" /* SEGBSS */
-};
+++ /dev/null
-#define ex_ap(y) fprintf(codefile,".extern %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 dlbdlb(x,y) fprintf(codefile,"%s = %s\n",x,y)
-#define newlbss(l,x) fprintf(codefile,"%s:\t.space %d\n",l,x);
-
-#define cst_fmt "%d"
-#define off_fmt "%d"
-#define ilb_fmt "I%03x%x"
-#define dlb_fmt "_%d"
-#define hol_fmt "hol%d"
-
-#define hol_off "%d+hol%d"
-
-#define con_cst(x) fprintf(codefile,"\t.word %d\n",x)
-#define con_ilb(x) fprintf(codefile,"\t.word %s\n",x)
-#define con_dlb(x) fprintf(codefile,"\t.word %s\n",x)
-
-#define modhead ""
-
-#define id_first '_'
-#define BSS_INIT 0
+++ /dev/null
-"$Header$"
-#define SL 6
-#define SSL "6"
- /* savsize is 6 because size of LB is 2 and size of z8000-PC is 4 */
-#define NC nocoercions:
-
-/*********************************************************
-** Back end tables for z8000 **
-** Author: Jan Voors **
-** **
-** wordsize = 2 bytes, pointersize = 2 bytes. **
-** **
-** Register R13 is used as LB, RR14 is the normal **
-** z8000-stackpointer. Some global variables are used: **
-** - reghp : the heap pointer **
-** - trpim : trap ignore mask **
-** - trppc : address of user defined trap handler **
-** **
-** Floating point arithmetic and constants are not **
-** implemented. **
-** **
-*********************************************************/
-
-/*
- * (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
- *
- */
-
-EM_WSIZE = 2
-EM_PSIZE = 2
-EM_BSIZE = SL
-
-TIMEFACTOR = 3/4
-
-REGISTERS:
-R0 = ("R0", 2), REG, B2REG.
-R1 = ("R1", 2), REG, B2REG, XREG.
-R2 = ("R2", 2), REG, B2REG, XREG.
-R3 = ("R3", 2), REG, B2REG, XREG.
-R4 = ("R4", 2), REG, B2REG, XREG.
-R5 = ("R5", 2), REG, B2REG, XREG.
-R6 = ("R6", 2), REG, B2REG, XREG.
-R7 = ("R7", 2), REG, B2REG, XREG.
-R8 = ("R8", 2), REG, XREG.
-R9 = ("R9", 2), REG, XREG.
-R10 = ("R10", 2), REG, XREG.
-R11 = ("R11", 2), REG, XREG.
-R12 = ("R12", 2), REG, XREG.
-LB = ("R13", 2), localbase.
-
-RR0 = ("RR0", 4, R0, R1), LWREG, LWB2REG.
-RR2 = ("RR2", 4, R2, R3), LWREG, LWB2REG, LWXREG.
-RR4 = ("RR4", 4, R4, R5), LWREG, LWB2REG, LWXREG.
-RR6 = ("RR6", 4, R6, R7), LWREG, LWB2REG, LWXREG.
-RR8 = ("RR8", 4, R8, R9), LWREG, LWXREG.
-RR10 = ("RR10", 4, R10, R11), LWREG, LWXREG.
-
-RQ0 = ("RQ0", 8, RR0, RR2), DLWREG.
-RQ4 = ("RQ4", 8, RR4, RR6), DLWREG.
-RQ8 = ("RQ8", 8, RR8, RR10), DLWREG.
-
-/*\f*/
-TOKENS:
-/* z8000-addressing-modes 'ra', 'ba' and 'bx' never used so far,
-** so there are no tokens for them (yet).
-*/
-ir1 = { REGISTER lwxreg; } 2 cost=(0,2) "*%[lwxreg]"
-ir2 = { REGISTER lwxreg; } 2 cost=(0,2) "*%[lwxreg]"
-ir4 = { REGISTER lwxreg; } 4 cost=(0,5) "*%[lwxreg]"
-ir4_hi = { REGISTER lwreg; } 2
-
-da1 = { STRING ind; } 2 cost=(4,4) "%[ind]"
-da2 = { STRING ind; } 2 cost=(4,4) "%[ind]"
-da4 = { STRING ind; } 4 cost=(4,7) "%[ind]"
-
-im2 = { INT num; } 2 cost=(2,2) "$%[num]"
-im4 = { INT num; } 4 cost=(4,5) "$%[num]"
-double = { STRING ind; } 4 cost=(4,5) "$%[ind]"
-
-x1 = { REGISTER xreg; INT ind; } 2 cost=(4,5) "%[ind](%[xreg])"
-x2 = { REGISTER xreg; INT ind; } 2 cost=(4,5) "%[ind](%[xreg])"
-x4 = { REGISTER xreg; INT ind; } 4 cost=(4,8) "%[ind](%[xreg])"
-
-ADDR_LOCAL = { INT ind; } 2
-ADDR_EXTERNAL = { STRING ind; } 2 cost=(2,3) "$%[ind]"
-regconst2 = { REGISTER xreg; INT ind; } 2
-
-TOKENEXPRESSIONS:
-REGS = REG + LWREG + DLWREG
-SCR_REG = REG * SCRATCH
-SCR_XREG = XREG * SCRATCH
-SCR_LWREG = LWREG * SCRATCH
-SCR_DLWREG = DLWREG * SCRATCH
-src1 = ir1 + da1 + x1
-src2 = REG + ir2 + im2 + da2 + x2 + localbase + ADDR_EXTERNAL
-src4 = LWREG + ir4 + im4 + da4 + x4 + double
-indexed = x1 + x2 + x4
-ind_access = ir1 + ir2 + ir4
-da = da1 + da2 + da4
-const2 = im2 + ADDR_EXTERNAL
-const4 = im4 + double
-allexceptcon = ALL - REGS - im2 - im4 - double - ADDR_LOCAL
- - ADDR_EXTERNAL
-
-src2a = ir2 + da2 + x2
-src4a = ir4 + da4 + x4
-src2b = REG + im2 + localbase + ADDR_EXTERNAL
-src4b = LWREG
-src2c = REG + ir2 + da2 + x2
-
-CODE:
-/*\f*/
-/***************************************
-******** GROUP 1 ********
-***************************************/
-
-loc | | | {im2, $1} | |
-ldc | | allocate( LWREG )
- move( {im2, highw(1)}, %[a.1] )
- move( {im2, loww(1)}, %[a.2] ) | %[a] | |
-lol | | | {x2, LB, $1} | |
-ldl | | | {x4, LB, $1} | |
-loe | | | {da2, $1} | |
-lde | | | {da4, $1} | |
-lil | | allocate( LWXREG )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] ) | {ir2,%[a]} | |
-lof | XREG | | {x2, %[1], $1} | |
-... | NC regconst2 | | {x2, %[1.xreg], $1+%[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {da2, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {x2, LB, %[1.ind]+$1} | |
-ldf | XREG | | {x4, %[1], $1} | |
-... | NC regconst2 | | {x4, %[1.xreg], $1+%[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {da4, tostring($1)+"+"+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {x4, LB, %[1.ind]+$1} | |
-lal | | | { ADDR_LOCAL, $1 } | |
-lae | | | { ADDR_EXTERNAL, $1 } | |
-lxl $1==0 | | | LB | |
-lxl $1==1 | | | {x2, LB, SL} | |
-lxl $1==2 | | allocate( XREG = {x2, LB, SL} ) | {x2, %[a], SL}| |
-lxl $1>2 | | allocate( XREG = {x2, LB, SL}, REG = {im2, $1-1} )
- "1:\tld %[a], 6(%[a])"
- "djnz %[b], 1b"
- erase(%[a]) erase(%[b]) samecc | %[a] | |
-lxa $1==0 | | | {ADDR_LOCAL, SL} | |
-lxa $1==1 | | allocate( XREG = {x2, LB, SL} ) |
- {regconst2, %[a], SL} | |
-lxa $1==2 | | allocate( XREG = {x2, LB, SL} )
- move( {x2, %[a], SL }, %[a] ) |
- {regconst2, %[a], SL} | |
-lxa $1>2 | | allocate( XREG = {x2, LB, SL}, REG = {im2, $1-1} )
- "1:\tld %[a], 6(%[a])"
- "djnz %[b], 1b"
- erase(%[a]) erase(%[b]) samecc |
- {regconst2, %[a], SL} | |
-loi $1==1 | NC regconst2 | | {x1, %[1.xreg], %[1.ind]} | |
-... | NC ADDR_LOCAL| | {x1, LB, %[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {da1, %[1.ind]} | |
-... | src2 | allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- | {ir1, %[a]} | |
-loi $1==2 | NC regconst2 | | {x2, %[1.xreg], %[1.ind]} | |
-... | NC ADDR_LOCAL| | {x2, LB, %[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {da2, %[1.ind]} | |
-... | src2 | allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- | {ir2, %[a]} | |
-loi $1==4 | NC regconst2 | | {x4, %[1.xreg], %[1.ind]} | |
-... | NC ADDR_LOCAL| | {x4, LB, %[1.ind]} | |
-... | NC ADDR_EXTERNAL | | {da4, %[1.ind]} | |
-... | src2 | allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- | {ir4, %[a]} | |
-loi $1>4 | src2 STACK | allocate( REG = {im2, $1/2} )
- allocate( %[1], LWXREG )
- move( %[1], %[b.2] )
- move( {im2, 0}, %[b.1] )
- "add %[b.2], $$$1-2"
- "dec R15, $$2"
- "lddr *RR14, *%[b], %[a]"
- "inc R15, $$2"
- erase(%[a]) erase(%[b]) nocc | | |
-lal loi $2==6 | STACK | "push *RR14, $1+4(R13)"
- "pushl *RR14, $1(R13)" | | |
-lal loi $2==8 | STACK | "pushl *RR14, $1+4(R13)"
- "pushl *RR14, $1(R13)" | | |
-lae loi $2==6 | STACK | "push *RR14, $1+4"
- "pushl *RR14, $1" | | |
-lae loi $2==8 | STACK | "pushl *RR14, $1+4"
- "pushl *RR14, $1" | | |
-los $1==2 | STACK | "calr los2" | | |
-los !defined($1)| src2c STACK | "cp %[1], $$2"
- "jr NE, unknown"
- "calr los2" | | |
-lpi | | | {ADDR_EXTERNAL, $1} | |
-/*\f*/
-/***************************************
-******** GROUP 2 ********
-***************************************/
-
-stl | src2b | remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- move( %[1], {x2, LB, $1} ) | | |
-ste | src2b | remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- move( %[1], {da2, $1} ) | | |
-sil | src2b | remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- move( %[1], {ir2, %[a]} ) | | |
-stf | regconst2 src2b |
- remove( allexceptcon )
- move( %[2], {x2, %[1.xreg], $1+%[1.ind]} ) | | |
-... | ADDR_EXTERNAL src2b |
- remove( allexceptcon )
- move( %[2], {da2, tostring($1)+"+"+%[1.ind]} ) | | |
-sti $1==1 | regconst2 const2 | remove( allexceptcon )
- move( %[2], {x1, %[1.xreg], %[1.ind]} ) | | |
-... | regconst2 B2REG | remove( allexceptcon )
- move( %[2], {x1, %[1.xreg], %[1.ind]} ) | | |
-... | NC ADDR_LOCAL const2 | remove( allexceptcon )
- move( %[2], {x1, LB, %[1.ind]} ) | | |
-... | ADDR_LOCAL B2REG | remove( allexceptcon )
- move( %[2], {x1, LB, %[1.ind]} ) | | |
-... | NC ADDR_EXTERNAL const2 | remove( allexceptcon )
- move( %[2], {da1, %[1.ind]} ) | | |
-... | ADDR_EXTERNAL B2REG | remove( allexceptcon )
- move( %[2], {da1, %[1.ind]} ) | | |
-... | src2 const2 | remove( allexceptcon )
- allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- move( %[2], {ir1, %[a]} ) | | |
-... | src2 B2REG | remove( allexceptcon )
- allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- move( %[2], {ir1, %[a]} ) | | |
-sti $1==2 | regconst2 src2b | remove( allexceptcon )
- move( %[2], {x2, %[1.xreg], %[1.ind]} ) | | |
-... | ADDR_LOCAL src2b | remove( allexceptcon )
- move( %[2], {x2, LB, %[1.ind]} ) | | |
-... | ADDR_EXTERNAL src2b | remove( allexceptcon )
- move( %[2], {da2, %[1.ind]} ) | | |
-... | src2 src2b | remove( allexceptcon )
- allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- move( %[2], {ir2, %[a]} ) | | |
-sti $1==4 | regconst2 src4b | remove( allexceptcon )
- move( %[2], {x4, %[1.xreg], %[1.ind]} ) | | |
-... | ADDR_LOCAL src4b | remove( allexceptcon )
- move( %[2], {x4, LB, %[1.ind]} ) | | |
-... | ADDR_EXTERNAL src4b | remove( allexceptcon )
- move( %[2], {da4, %[1.ind]} ) | | |
-... | src2 src4b | remove( allexceptcon )
- allocate( %[1], LWXREG )
- move( %[1], %[a.2] )
- move( {im2, 0}, %[a.1] )
- move( %[2], {ir4, %[a]} ) | | |
-sti $1>4 | src2 STACK |
- allocate( REG = {im2, $1/2} )
- allocate( %[1], LWXREG )
- move( %[1], %[b.2] )
- move( {im2, 0}, %[b.1] )
- "ldir *%[b], *RR14, %[a]"
- erase(%[a]) erase(%[b]) nocc | | |
-lal sti $2>4 && $2<=8 | NC src2b | | %[1] |
- stl $1 lal $1+2 sti $2-2 |
-... | | | {ADDR_LOCAL, $1} | sti $2 |
-sts $1==2 | STACK | "calr sts2" | | |
-sts !defined($1)| src2c STACK | "cp %[1], $$2"
- "jr NE, unknown"
- "calr sts2" | | |
-sdl | src4b | remove( x2, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+2 ))
- remove( x4, %[xreg]==LB &&
- ( %[ind]>=$1-2 && %[ind]<=$1+2 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]>=$1 && %[ind]<=$1+3 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- move( %[1], {x4, LB, $1} ) | | |
-sde | src4b | remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- move( %[1], {da4, $1} ) | | |
-sdf | regconst2 src4b |
- remove( allexceptcon )
- move( %[2], {x4, %[1.xreg], $1+%[1.ind]} ) | | |
-... | ADDR_EXTERNAL src4b |
- remove( allexceptcon )
- move( %[2], {da4, tostring($1)+"+"+%[1.ind]} ) | | |
-/*\f*/
-/***************************************
-******** GROUP 3 ********
-***************************************/
-
-adi $1==2 | NC SCR_XREG im2 | |
- {regconst2, %[1], %[2.num]} | |
-... | NC SCR_XREG ADDR_LOCAL |
- "add %[1], R13"
- erase(%[1]) |
- {regconst2, %[1], %[2.ind]} | |
-... | NC REG ADDR_LOCAL |
- allocate( XREG )
- "ld %[a], R13"
- "add %[a], %[1]"
- erase(%[a]) |
- {regconst2, %[a], %[2.ind]} | |
-... | NC SCR_XREG regconst2 |
- "add %[1], %[2.xreg]"
- erase(%[1]) |
- {regconst2, %[1], %[2.ind]} | |
-... | NC im2 ADDR_LOCAL | |
- {ADDR_LOCAL, %[1.num]+%[2.ind]} | |
-... | NC src2 im2+ADDR_LOCAL |
- allocate( %[1], XREG = %[1] ) |
- %[2] %[a] | adi 2 |
-... | NC src2 regconst2 |
- "add %[2.xreg], %[1]"
- erase(%[2.xreg]) | %[2] | |
-... | NC regconst2 im2 | |
- {regconst2, %[1.xreg], %[2.num]+%[1.ind]} | |
-... | NC regconst2 ADDR_LOCAL |
- "add %[1.xreg], R13"
- erase(%[1.xreg]) |
- {regconst2, %[1.xreg],
- %[2.ind]+%[1.ind]} | |
-... | NC regconst2 regconst2 |
- "add %[1.xreg],%[2.xreg]"
- erase(%[1.xreg]) |
- {regconst2, %[1.xreg],
- %[2.ind]+%[1.ind]} | |
-... | NC regconst2 src2-im2 |
- "add %[1.xreg], %[2]"
- erase(%[1.xreg]) | %[1] | |
-... | NC ADDR_LOCAL regconst2 |
- "add %[2.xreg], R13"
- erase(%[2.xreg]) |
- {regconst2, %[2.xreg],
- %[1.ind]+%[2.ind]} | |
-... | NC ADDR_LOCAL src2 | | %[1] %[2] | adi 2 |
-... | NC SCR_REG src2-im2 | "add %[1], %[2]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-... | src2 SCR_REG | "add %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-adi $1==4 | src4 SCR_LWREG |
- "addl %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,8)+%[1]
-... | SCR_LWREG src4 |
- "addl %[1], %[2]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,8)+%[2]
-sbi $1==2 | src2 SCR_REG | "sub %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,4)+%[1]
-... | SCR_REG src2 | "sub %[1], %[2]"
- erase(%[1])
- | %[1] | ngi 2 | (2,4)+%[2]
-sbi $1==4 | src4 SCR_LWREG |
- "subl %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,8)+%[1]
-... | SCR_LWREG src4 |
- "subl %[1], %[2]"
- erase(%[1])
- | %[1] | ngi 4 | (2,8)+%[2]
-mli $1==2 | src2 src2 | allocate( %[2], LWREG )
- move( %[2], %[a.2] )
- "mult %[a], %[1]"
- erase(%[a])
- setcc(%[a.2]) | %[a.2] | |
-mli $1==4 | src4 src4 | allocate( %[2], DLWREG )
- move( %[2], %[a.2] )
- "multl %[a], %[1]"
- erase(%[a])
- setcc(%[a.2]) | %[a.2] | |
-dvi $1==2 | src2 src2 | allocate( %[2], LWREG )
- move( %[2], %[a.2] )
- "exts %[a]"
- "div %[a], %[1]"
- erase(%[a])
- nocc | %[a.2] | |
-dvi $1==4 | src4 src4 | allocate( %[2], DLWREG )
- move( %[2], %[a.2] )
- "extsl %[a]"
- "divl %[a], %[1]"
- erase(%[a])
- nocc | %[a.2] | |
-rmi $1==2 | src2 src2 | allocate( %[2], LWREG )
- move( %[2], %[a.2] )
- "exts %[a]"
- "div %[a], %[1]"
- erase(%[a])
- nocc | %[a.1] | |
-rmi $1==4 | src4 src4 | allocate( %[2], DLWREG )
- move( %[2], %[a.2] )
- "extsl %[a]"
- "divl %[a], %[1]"
- erase(%[a])
- nocc | %[a.1] | |
-ngi $1==2 | SCR_REG | "neg %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,7)
-ngi $1==4 | src4 | allocate( LWREG = {im4, 0} )
- "subl %[a], %[1]"
- erase(%[a])
- setcc(%[a]) | %[a] | | (2,8)+%[1]
-sli $1==2 | im2 SCR_REG | "sla %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,0)
-... | REG SCR_REG | "sda %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-sli $1==4 | im2 SCR_LWREG | "slal %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,0)
-... | REG SCR_LWREG | "sdal %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-sri $1==2 | im2 SCR_REG | allocate( REG = {im2, 0-%[1.num]} )
- "sda %[2], %[a]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-... | REG SCR_REG | "neg %[1]"
- "sda %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (6,9)
-sri $1==4 | im2 SCR_LWREG | allocate( REG = {im2, 0-%[1.num]} )
- "sdal %[2], %[a]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-... | REG SCR_LWREG | "neg %[1]"
- "sdal %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (6,9)
-lol loc adi stl $1==$4 && $3==2 && $2>=0-16 && $2<=16 | | | |
- loc $2 lol $1 adi $3 stl $4 |
-loc lol adi stl $2==$4 && $3==2 && $1>0 && $1<=16 | |
- remove( x2, %[xreg]==LB && %[ind]==$2 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$2-2 || %[ind]==$2 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$2 || %[ind]==$2+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $2(R13), $$$1"
- setcc({x2, LB, $2}) | | |
-loc lol adi stl $2==$4 && $3==2 && $1<0 && $1>=0-16 | |
- remove( x2, %[xreg]==LB && %[ind]==$2 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$2-2 || %[ind]==$2 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$2 || %[ind]==$2+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $2(R13), $$0-$1"
- setcc({x2, LB, $2}) | | |
-loe loc adi ste $1==$4 && $3==2 && $2>=0-16 && $2<=16 | | | |
- loc $2 loe $1 adi $3 ste $4 |
-loc loe adi ste $2==$4 && $3==2 && $1>0 && $1<=16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $2, $$$1"
- setcc({da2, $2}) | | |
-loc loe adi ste $2==$4 && $3==2 && $1<0 && $1>=0-16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $2, $$0-$1"
- setcc({da2, $2}) | | |
-lil loc adi sil $1==$4 && $3==2 && $2>=0-16 && $2<=16 | | | |
- loc $2 lil $1 adi $3 sil $4 |
-loc lil adi sil $2==$4 && $3==2 && $1>0 && $1<=16 | |
- remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $2}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "inc *%[a], $$$1"
- setcc({ir2, %[a]}) | | |
-loc lil adi sil $2==$4 && $3==2 && $1<0 && $1>=0-16 | |
- remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $2}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "dec *%[a], $$0-$1"
- setcc({ir2, %[a]}) | | |
-lol loc sbi stl $1==$4 && $3==2 && $2>0 && $2<=16 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1(R13), $$$2"
- setcc({x2, LB, $1}) | | |
-lol loc sbi stl $1==$4 && $3==2 && $2<0 && $2>=0-16 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1(R13), $$0-$2"
- setcc({x2, LB, $1}) | | |
-loe loc sbi ste $1==$4 && $3==2 && $2>0 && $2<=16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1, $$$2"
- setcc({da2, $1}) | | |
-loe loc sbi ste $1==$4 && $3==2 && $2<0 && $2>=0-16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1, $$0-$2"
- setcc({da2, $1}) | | |
-lil loc sbi sil $1==$4 && $3==2 && $2>0 && $2<=16 | |
- remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "dec *%[a], $$$2"
- setcc({ir2, %[a]}) | | |
-lil loc sbi sil $1==$4 && $3==2 && $2<0 && $2>=0-16 | |
- remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "inc *%[a], $$0-$2"
- setcc({ir2, %[a]}) | | |
-lol ngi stl $1==$3 && $2==2 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- remove( allexceptcon )
- "neg $1(R13)"
- setcc({x2, LB, $1}) | | |
-loe ngi ste $1==$3 && $2==2 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "neg $1"
- setcc({da2, $1}) | | |
-lil ngi sil $1==$3 && $2==2 | |
- remove( allexceptcon )
- allocate( LWXREG )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "neg *%[a]"
- setcc({ir2, %[a]}) | | |
-loc sli $1>=0 && $1<=16 && $2==2 | SCR_REG |
- "sla %[1], $$$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sli $1>=0 && $1<=32 && $2==4 | SCR_LWREG |
- "slal %[1], $$$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sri $1>=0 && $1<=16 && $2==2 | SCR_REG |
- "sra %[1], $$-$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sri $1>=0 && $1<=32 && $2==4 | SCR_LWREG |
- "sral %[1], $$-$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sru $1>=0 && $1<=16 && $2==2 | SCR_REG |
- "srl %[1], $$-$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-loc sru $1>=0 && $1<=32 && $2==4 | SCR_LWREG |
- "srll %[1], $$-$1"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-/*\f*/
-/***************************************
-******** GROUP 4 ********
-***************************************/
-/* adu = adi
-** sbu = sbi
-** mlu = mli
-** slu = sli
-*/
-
-adu | | | | adi $1 |
-sbu | | | | sbi $1 |
-mlu | | | | mli $1 |
-slu | | | | sli $1 |
-dvu $1==2 | STACK | "calr dvu2" | R1 | |
-dvu $1==4 | STACK | "calr dvu4" | R3 R2 | |
-rmu $1==2 | STACK | "calr rmu2" | R0 | |
-rmu $1==4 | STACK | "calr rmu4" | R1 R0 | |
-sru $1==2 | im2 SCR_REG | allocate( REG = {im2, 0-%[1.num]} )
- "sdl %[2], %[a]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-... | REG SCR_REG | "neg %[1]"
- "sdl %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (6,9)
-sru $1==4 | im2 SCR_LWREG | allocate( REG = {im2, 0-%[1.num]} )
- "sdll %[2], %[a]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (4,2)
-... | REG SCR_LWREG | "neg %[1]"
- "sdll %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (6,9)
-/*\f*/
-/***************************************
-******** GROUP 6 ********
-***************************************/
-
-adp | SCR_XREG | | {regconst2, %[1], $1} | |
-... | NC regconst2 | | {regconst2, %[1.xreg], $1+%[1.ind]} | |
-... | NC ADDR_LOCAL | | {ADDR_LOCAL, %[1.ind]+$1 } | |
-... | NC ADDR_EXTERNAL | | {ADDR_EXTERNAL,
- tostring($1)+"+"+%[1.ind]} | |
-lil adp sil $1==$3 && $2>0 && $2<=16 | | allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "inc *%[a], $$$2"
- setcc({ir2, %[a]}) | | |
-lil adp sil $1==$3 && $2<0 && $2>=0-16 | | allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "dec *%[a], $$0-$2"
- setcc({ir2, %[a]}) | | |
-lil adp dup sil adp $1==$4 && $3==2 && $2==1 && $5==0-1 | |
- allocate( LWXREG, XREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "ld %[b], *%[a]"
- "inc *%[a]" | {regconst2, %[b], 0} | |
- /* because the next EM-instruction
- ** will be `loi'.
- */
-lil adp dup sil $1==$4 && $3==2 && $2==1 | |
- allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "inc *%[a]"
- setcc({ir2, %[a]}) | {ir2,%[a]} | |
-lol lol adp stl $1==$2 && $2==$4 && $3>0 && $3<=16 | |
- allocate( REG = {x2, LB, $1} )
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1(R13), $$$3"
- setcc({x2, LB, $1}) | %[a] | |
-lol lol adp stl $1==$2 && $2==$4 && $3<0 && $3>=0-16 | |
- allocate( REG = {x2, LB, $1} )
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1(R13), $$0-$3"
- setcc({x2, LB, $1}) | %[a] | |
-loe loe adp ste $1==$2 && $2==$4 && $3>0 && $3<=16 | |
- allocate( REG = {da2, $1} )
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1, $$$3"
- setcc({da2, $1}) | %[a] | |
-loe loe adp ste $1==$2 && $2==$4 && $3<0 && $3>=0-16 | |
- allocate( REG = {da2, $1} )
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1, $$0-$3"
- setcc({da2, $1}) | %[a] | |
-lol adp stl $1==$3 && $2>0 && $2<=16 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1(R13), $$$2"
- setcc({x2, LB, $1}) | | |
-lol adp stl $1==$3 && $2<0 && $2>=0-16 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1(R13), $$0-$2"
- setcc({x2, LB, $1}) | | |
-loe adp ste $1==$3 && $2>0 && $2<=16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1, $$$2"
- setcc({da2, $1}) | | |
-loe adp ste $1==$3 && $2<0 && $2>=0-16 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1, $$0-$2"
- setcc({da2, $1}) | | |
-ads $1==2 | | | | adi $1 |
-ads $1==4 | | | | adi $1 |
-sbs $1==2 | | | | sbi $1 |
-sbs $1==4 | | | | sbi $1 |
-/*\f*/
-/***************************************
-******** GROUP 7 ********
-***************************************/
-
-inc | SCR_REG | "inc %[1]"
- erase(%[1]) setcc(%[1]) | %[1] | |
-lil inc sil $1==$3 | | allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "inc *%[a]"
- setcc({ir2, %[a]}) | | |
-dec | SCR_REG | "dec %[1]"
- erase(%[1]) setcc(%[1]) | %[1] | |
-lil dec sil $1==$3 | | allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "dec *%[a]"
- setcc({ir2, %[a]}) | | |
-lil dec dup sil $1==$4 && $3==2 | | allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "dec *%[a]"
- setcc({ir2, %[a]}) | {ir2,%[a]} | |
-inl | | remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB && ( %[ind]==$1-2 || %[ind]==$1 ) )
- remove( x1, %[xreg]==LB && ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1(R13)"
- setcc({x2, LB, $1}) | | |
-del | | remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB && ( %[ind]==$1-2 || %[ind]==$1 ) )
- remove( x1, %[xreg]==LB && ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1(R13)"
- setcc({x2, LB, $1}) | | |
-zrl | | remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB && ( %[ind]==$1-2 || %[ind]==$1 ) )
- remove( x1, %[xreg]==LB && ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "clr $1(R13)"
- samecc | | |
-ine | | remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "inc $1"
- setcc({da2, $1}) | | |
-dee | | remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "dec $1"
- setcc({da2, $1}) | | |
-zre | | remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "clr $1"
- samecc | | |
-zer $1==2 | | | {im2, 0} | |
-zer $1==4 | | | {im4, 0} | |
-zer $1==6 | | | {im4, 0} {im2, 0} | |
-zer $1==8 | | | {im4, 0} {im4, 0} | |
-zer $1>8 | | remove( ALL )
- allocate( REG = {im2, $1/2} ) /*nr of words*/
- "1:\tpush *RR14, $$0"
- "djnz %[a], 1b"
- erase(%[a]) samecc | | |
-zer !defined($1)| SCR_REG | remove( ALL )
- "sra %[1]"
- "1:\tpush *RR14, $$0"
- "djnz %[1], 1b"
- erase(%[1]) nocc | | |
-/*\f*/
-/***************************************
-******** GROUP 8 ********
-***************************************/
-
-cii | STACK | "calr cii" | | |
-loc loc cii $1==1 && $2==2 | NC src1 |
- allocate( %[1], B2REG = %[1] ) | %[a] | |
-... | src2 | allocate( %[1], REG = %[1] )
- "extsb %[a]"
- erase(%[a]) samecc | %[a] | |
-loc loc cii $1==1 && $2==4 | NC src1 |
- allocate( %[1], LWB2REG )
- move( %[1], %[a.2] )
- "exts %[a]"
- samecc | %[a] | |
-... | src2 | allocate( %[1], LWREG )
- move( %[1], %[a.2] )
- "exts %[a]"
- samecc | %[a] | |
-loc loc cii $1==2 && $2==4 | src2 | allocate( %[1], LWREG )
- move( %[1], %[a.2] )
- "exts %[a]"
- samecc | %[a] | |
-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 | src2 src2 | | %[2] | |
-loc loc cuu $1==2 && $2==4 | | | {im2, 0} | |
-loc loc cuu $1==4 && $2==2 | src2 | | | |
-cuu | STACK | "calr cuu" | | |
-ciu | | | | cuu |
-cui | | | | cuu |
-/*\f*/
-/***************************************
-******** GROUP 9 ********
-***************************************/
-
-and $1==2 | SCR_REG src2 | "and %[1], %[2]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,4)+%[2]
-... | src2 SCR_REG | "and %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,4)+%[1]
-and $1>2 | | remove( ALL )
- allocate( LWXREG, REG, REG = {im2, $1/2} )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "1:\tpop %[b], *RR14"
- "and %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[c], 1b"
- erase(%[c]) nocc | | |
-and !defined($1)| SCR_REG | remove( ALL )
- allocate( LWXREG, REG )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "sra %[1]"
- "1:\tpop %[b], *RR14"
- "and %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[1], 1b"
- erase(%[1]) nocc | | |
-ior $1==2 | SCR_REG src2 | "or %[1], %[2]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,4)+%[2]
-... | src2 SCR_REG | "or %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,4)+%[1]
-ior $1>2 | | remove( ALL )
- allocate( LWXREG, REG, REG = {im2, $1/2} )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "1:\tpop %[b], *RR14"
- "or %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[c], 1b"
- erase(%[c]) nocc | | |
-ior !defined($1)| SCR_REG | remove( ALL )
- allocate( LWXREG, REG )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "sra %[1]"
- "1:\tpop %[b], *RR14"
- "or %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[1], 1b"
- erase(%[1]) nocc | | |
-xor $1==2 | SCR_REG src2 | "xor %[1], %[2]"
- erase(%[1])
- setcc(%[1]) | %[1] | | (2,4)+%[2]
-... | src2 SCR_REG | "xor %[2], %[1]"
- erase(%[2])
- setcc(%[2]) | %[2] | | (2,4)+%[1]
-xor $1>2 | | remove( ALL )
- allocate( LWXREG, REG, REG = {im2, $1/2} )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "1:\tpop %[b], *RR14"
- "xor %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[c], 1b"
- erase(%[c]) nocc | | |
-xor !defined($1)| SCR_REG | remove( ALL )
- allocate( LWXREG, REG )
- "ldl %[a], RR14"
- "addl %[a], $$$1"
- "sra %[1]"
- "1:\tpop %[b], *RR14"
- "xor %[b], *%[a]"
- "ld *%[a], %[b]"
- "inc %[a.2], $$2"
- "djnz %[1], 1b"
- erase(%[1]) nocc | | |
-com $1==2 | SCR_REG | "com %[1]"
- erase(%[1])
- setcc(%[1]) | %[1] | |
-com defined($1) | STACK | allocate( LWXREG, REG = {im2, $1/2} )
- "ldl %[a], RR14"
- "1:\tcom *%[a]"
- "inc %[a.2], $$2"
- "djnz %[b], 1b"
- erase(%[b]) nocc | | |
-com !defined($1)| SCR_REG STACK | allocate( LWXREG )
- "ldl %[a], RR14"
- "1:\tcom *%[a]"
- "inc %[a.2], $$2"
- "djnz %[1], 1b"
- erase(%[1]) nocc | | |
-lil and sil $1==$3 && $2==2 | SCR_REG |
- allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "and %[1], *%[a]"
- "ld *%[a], %[1]" | | |
-lil ior sil $1==$3 && $2==2 | SCR_REG |
- allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "or %[1], *%[a]"
- "ld *%[a], %[1]" | | |
-lil xor sil $1==$3 && $2==2 | SCR_REG |
- allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "xor %[1], *%[a]"
- "ld *%[a], %[1]" | | |
-lol com stl $1==$3 && $2==2 | |
- remove( x2, %[xreg]==LB && %[ind]==$1 )
- remove( x4, %[xreg]==LB &&
- ( %[ind]==$1-2 || %[ind]==$1 ))
- remove( x1, %[xreg]==LB &&
- ( %[ind]==$1 || %[ind]==$1+1 ))
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- remove( allexceptcon )
- "com $1(R13)"
- setcc({x2, LB, $1}) | | |
-loe com ste $1==$3 && $2==2 | |
- remove( da )
- remove( indexed, %[xreg]!=LB )
- remove( ind_access )
- "com $1"
- setcc({da2, $1}) | | |
-lil com sil $1==$3 && $2==2 | |
- allocate( LWXREG )
- remove( allexceptcon )
- move( {x2, LB, $1}, %[a.2] )
- move( {im2, 0}, %[a.1] )
- "com *%[a]"
- setcc({ir2, %[a]}) | | |
-rol $1==2 | SCR_REG SCR_REG | "1:\trl %[2]"
- "djnz %[1], 1b"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-ror $1==2 | SCR_REG SCR_REG | "1:\trr %[2]"
- "djnz %[1], 1b"
- erase(%[2])
- setcc(%[2]) | %[2] | |
-/*\f*/
-/***************************************
-******** GROUP 10 ********
-***************************************/
-
-inn $1==2 | REG SCR_REG | allocate( REG = {im2, 0} )
- "cp %[1], $$15"
- "jr UGT, 1f"
- "bit %[2], %[1]"
- "tcc NE, %[a]\n1:"
- erase(%[a]) nocc | %[a] | |
-inn defined($1) | src2 STACK | move( %[1], R1 )
- move( {im2, $1}, R2 )
- "calr inn"
- erase(R1)
- erase(R2) | R0 | |
-inn !defined($1)| src2 src2 STACK | move( %[1], R2 )
- move( %[2], R1 )
- "calr inn"
- erase(R1)
- erase(R2) | R0 | |
-loc inn $2==2 && $1==0 | SCR_REG |
- "and %[1], $$1"
- erase(%[1]) setcc(%[1]) | %[1] | |
-loc inn $2==2 && $1==1 | SCR_REG |
- "srl %[1]"
- "and %[1], $$1"
- erase(%[1]) setcc(%[1]) | %[1] | |
-loc inn $2==2 && $1>1 && $1<=16 | SCR_REG |
- "srl %[1], $$%(0-$1%)"
- "and %[1], $$1"
- erase(%[1]) setcc(%[1]) | %[1] | |
-loc inn zeq $2==2 | | | {im2, 1<<$1} | and 2 zeq $3 |
-inn zeq $1==2 | REG | allocate( REG = {im2, 1} )
- "sdl %[a], %[1]"
- erase(%[a])
- setcc(%[a]) | %[a] | and 2 zeq $2 |
-loc inn zne $2==2 | | | {im2, 1<<$1} | and 2 zne $3 |
-inn zne $1==2 | REG | allocate( REG = {im2, 1} )
- "sdl %[a], %[1]"
- erase(%[a])
- setcc(%[a]) | %[a] | and 2 zne $2 |
-set $1==2 | REG | allocate( REG = {im2, 0} )
- "cp %[1], $$15"
- "jr ULE, 1f"
- "push *RR14, $$ESET"
- "calr trp"
- "jr 2f"
- "1:\tset %[a], %[1]\n2:"
- erase(%[a]) nocc | %[a] | |
-set defined($1) | src2 STACK | move( %[1], R1 )
- move( {im2, $1}, R0 )
- "calr xset"
- erase(R0)
- erase(R1) | | |
-set !defined($1)| src2 src2 STACK | move( %[1], R0 )
- move( %[2], R1 )
- "calr xset"
- erase(R0)
- erase(R1) | | |
-/*\f*/
-/***************************************
-******** GROUP 11 ********
-***************************************/
-
-aar $1==2 | src2 src2 STACK | move( %[1], R1 )
- move( %[2], R3 )
- "calr aar"
- erase(R1)
- erase(R3) | | |
-aar !defined($1)| src2c src2 src2 STACK | move( %[2], R1 )
- move( %[3], R3 )
- "cp %[1], $$2"
- "jr NE, unknown"
- "calr aar"
- erase(R1)
- erase(R3) | | |
-sar $1==2 | src2 src2 STACK | move( %[1], R1 )
- move( %[2], R3 )
- "calr sar"
- erase(R1)
- erase(R3) | | |
-sar !defined($1)| src2c src2 src2 STACK | move( %[2], R1 )
- move( %[3], R3 )
- "cp %[1], $$2"
- "jr NE, unknown"
- "calr sar"
- erase(R1)
- erase(R3) | | |
-lar $1==2 | src2 src2 STACK | move( %[1], R1 )
- move( %[2], R3 )
- "calr lar"
- erase(R1)
- erase(R3) | | |
-lar !defined($1)| src2c src2 src2 STACK | move( %[2], R1 )
- move( %[3], R3 )
- "cp %[1], $$2"
- "jr NE, unknown"
- "calr lar"
- erase(R1)
- erase(R3) | | |
-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 |
- "sla %[1]"
- erase(%[1]) | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | SCR_XREG |
- "sla %[1]"
- erase(%[1])
- | {regconst2, %[1], (0-2)*rom(1,1)} | adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)==0 | SCR_REG |
- "sla %[1], $$2"
- erase(%[1]) | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==4 && rom(1,1)!=0 | SCR_XREG |
- "sla %[1], $$2"
- erase(%[1])
- | {regconst2, %[1], (0-4)*rom(1,1)} | adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)==0 | SCR_REG |
- "sla %[1], $$3"
- erase(%[1]) | %[1] | adi 2 |
-lae aar $2==2 && rom(1,3)==8 && rom(1,1)!=0 | SCR_XREG |
- "sla %[1], $$3"
- erase(%[1])
- | {regconst2, %[1], (0-8)*rom(1,1)} | adi 2 |
-lae aar $2==2 && rom(1,1)==0 | src2 |
- allocate( %[1], LWREG )
- move( %[1], %[a.2] )
- "mult %[a], $$%(rom(1,3)%)"
- erase(%[a]) | %[a.2] | adi 2 |
-lae aar $2==2 && defined(rom(1,1)) | src2 |
- allocate( %[1], LWREG )
- move( %[1], %[a.2] )
- "mult %[a], $$%(rom(1,3)%)"
- erase(%[a])
- | {regconst2, %[a.2], (0-rom(1,3))*rom(1,1)} | adi 2 |
-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) |
-/*\f*/
-/***************************************
-******** GROUP 12 ********
-***************************************/
-
-cmi $1==2 | | | | sbi $1 |
-cmi $1==4 | STACK | "calr cmi4" | R0 | |
-cmi !defined($1)| src2 STACK | move( %[1], R0 )
- "calr cmi"
- erase(R0) | R0 | |
-cmu $1==2 | | | | cmp |
-cmu $1==4 | STACK | "calr cmu4" | R0 | |
-cmu !defined($1)| src2 STACK | move( %[1], R0 )
- "calr cmu"
- erase(R0) | R0 | |
-cms $1==2 | | | | sbi $1 |
-cms defined($1) | STACK | move( {im2, $1}, R0 )
- "calr cms"
- erase(R0) | R0 | |
-cms !defined($1)| src2 STACK | move( %[1], R0 )
- "calr cms"
- erase(R0) | R0 | |
-cmp | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "jr EQ, 2f"
- "jr ULT, 1f"
- "inc %[a]"
- "jr 2f"
- "1:\tdec %[a]\n2:"
- erase(%[a]) nocc | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "jr EQ, 2f"
- "jr ULT, 1f"
- "inc %[a]"
- "jr 2f"
- "1:\tdec %[a]\n2:"
- erase(%[a]) nocc | %[a] | |
-tlt | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc LT, %[a]"
- erase(%[a]) samecc | %[a] | |
-tle | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc LE, %[a]"
- erase(%[a]) samecc | %[a] | |
-teq | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc EQ, %[a]"
- erase(%[a]) samecc | %[a] | |
-tne | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc NE, %[a]"
- erase(%[a]) samecc | %[a] | |
-tge | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc GE, %[a]"
- erase(%[a]) samecc | %[a] | |
-tgt | src2c | allocate( REG = {im2, 0} )
- test(%[1])
- "tcc GT, %[a]"
- erase(%[a]) samecc | %[a] | |
-cmp tlt | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc ULT, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc ULT, %[a]"
- erase(%[a]) | %[a] | |
-cmp tle | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc ULE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc ULE, %[a]"
- erase(%[a]) | %[a] | |
-cmp teq | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc EQ, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc EQ, %[a]"
- erase(%[a]) | %[a] | |
-cmp tne | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc NE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc NE, %[a]"
- erase(%[a]) | %[a] | |
-cmp tge | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc UGE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc UGE, %[a]"
- erase(%[a]) | %[a] | |
-cmp tgt | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc UGT, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc UGT, %[a]"
- erase(%[a]) | %[a] | |
-tlt and $2==2 | src2c SCR_REG | test(%[1])
- "jr LT, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-tlt ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc LT, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-tle and $2==2 | src2c SCR_REG | test(%[1])
- "jr LE, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-tle ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc LE, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-teq and $2==2 | src2c SCR_REG | test(%[1])
- "jr EQ, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-teq ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc EQ, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-tne and $2==2 | src2c SCR_REG | test(%[1])
- "jr NE, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-tne ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc NE, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-tgt and $2==2 | src2c SCR_REG | test(%[1])
- "jr GT, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-tgt ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc GT, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-tge and $2==2 | src2c SCR_REG | test(%[1])
- "jr GE, 1f"
- "ldk %[2], $$0\n1:"
- erase(%[2]) | %[2] | |
-tge ior $2==2 | src2c SCR_REG | test(%[1])
- "tcc GE, %[2]"
- samecc
- erase(%[2]) | %[2] | |
-cmi tlt and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr LT, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr LT, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi tlt ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc LT, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc LT, %[3]"
- erase(%[3]) | %[3] | |
-cmi tlt $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc LT, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc LT, %[a]"
- erase(%[a]) | %[a] | |
-cmi tle and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr LE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr LE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi tle ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc LE, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc LE, %[3]"
- erase(%[3]) | %[3] | |
-cmi tle $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc LE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc LE, %[a]"
- erase(%[a]) | %[a] | |
-cmi teq and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr EQ, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr EQ, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi teq ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc EQ, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc EQ, %[3]"
- erase(%[3]) | %[3] | |
-cmi teq $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc EQ, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc EQ, %[a]"
- erase(%[a]) | %[a] | |
-cmi tne and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr NE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr NE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi tne ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc NE, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc NE, %[3]"
- erase(%[3]) | %[3] | |
-cmi tne $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc NE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc NE, %[a]"
- erase(%[a]) | %[a] | |
-cmi tge and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr GE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr GE, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi tge ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc GE, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc GE, %[3]"
- erase(%[3]) | %[3] | |
-cmi tge $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc GE, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc GE, %[a]"
- erase(%[a]) | %[a] | |
-cmi tgt and $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "jr GT, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "jr GT, 1f"
- "ldk %[3], $$0\n1:"
- erase(%[3]) | %[3] | |
-cmi tgt ior $1==2 && $3==2 | src2 REG SCR_REG |
- "cp %[2], %[1]"
- "tcc GT, %[3]"
- erase(%[3]) | %[3] | |
-... | NC im2 src2a SCR_REG | "cp %[2], %[1]"
- "tcc GT, %[3]"
- erase(%[3]) | %[3] | |
-cmi tgt $1==2 | src2 REG | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc GT, %[a]"
- erase(%[a]) | %[a] | |
-... | NC im2 src2a | allocate( REG = {im2, 0} )
- "cp %[2], %[1]"
- "tcc GT, %[a]"
- erase(%[a]) | %[a] | |
-/*\f*/
-/***************************************
-******** GROUP 13 ********
-***************************************/
-
-bra | STACK | "jr $1" samecc | | |
-blt | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr LT, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr LT, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr GT, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr GT, $1" | | |
-ble | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr LE, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr LE, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr GE, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr GE, $1" | | |
-beq | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr EQ, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr EQ, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr EQ, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr EQ, $1" | | |
-bne | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr NE, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr NE, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr NE, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr NE, $1" | | |
-bge | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr GE, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr GE, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr LE, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr LE, $1" | | |
-bgt | src2 REG | remove( ALL )
- "cp %[2], %[1]"
- "jr GT, $1" | | | (4,10)+%[1]
-... | NC im2 src2a | remove( ALL )
- "cp %[2], %[1]"
- "jr GT, $1" | | |
-... | REG src2 | remove( ALL )
- "cp %[1], %[2]"
- "jr LT, $1" | | | (4,10)+%[2]
-... | NC src2a im2 | remove( ALL )
- "cp %[1], %[2]"
- "jr LT, $1" | | |
-zlt | src2c | remove( ALL )
- test(%[1])
- "jr LT, $1"
- samecc | | |
-zle | src2c | remove( ALL )
- test(%[1])
- "jr LE, $1"
- samecc | | |
-zeq | src2c | remove( ALL )
- test(%[1])
- "jr EQ, $1"
- samecc | | |
-zne | src2c | remove( ALL )
- test(%[1])
- "jr NE, $1"
- samecc | | |
-zge | src2c | remove( ALL )
- test(%[1])
- "jr GE, $1"
- samecc | | |
-zgt | src2c | remove( ALL )
- test(%[1])
- "jr GT, $1"
- samecc | | |
-cmp zlt | src2 REG STACK | "cp %[2], %[1]"
- "jr ULT, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr ULT, $2" | | |
-cmp zle | src2 REG STACK | "cp %[2], %[1]"
- "jr ULE, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr ULE, $2" | | |
-cmp zeq | src2 REG STACK | "cp %[2], %[1]"
- "jr EQ, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr EQ, $2" | | |
-cmp zne | src2 REG STACK | "cp %[2], %[1]"
- "jr NE, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr NE, $2" | | |
-cmp zgt | src2 REG STACK | "cp %[2], %[1]"
- "jr UGT, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr UGT, $2" | | |
-cmp zge | src2 REG STACK | "cp %[2], %[1]"
- "jr UGE, $2" | | |
-... | NC im2 src2a STACK | "cp %[2], %[1]"
- "jr UGE, $2" | | |
-and zeq $1==2 | src2 SCR_REG STACK | "and %[2], %[1]"
- "jr EQ, $2"
- erase(%[2]) | | | (4,10)+%[1]
-... | SCR_REG src2 STACK | "and %[1], %[2]"
- "jr EQ, $2"
- erase(%[1]) | | | (4,10)+%[2]
-and zne $1==2 | src2 SCR_REG STACK | "and %[2], %[1]"
- "jr NE, $2"
- erase(%[2]) | | | (4,10)+%[1]
-... | SCR_REG src2 STACK | "and %[1], %[2]"
- "jr NE, $2"
- erase(%[1]) | | | (4,10)+%[2]
-/*\f*/
-/***************************************
-******** GROUP 14 ********
-***************************************/
-
-cal | STACK | "calr $1" | | |
-cai | NC src2a-x2 STACK | "call %[1]" | | |
-... | NC x2 STACK | allocate( %[1], XREG = %[1] )
- "call 0(%[a])" | | |
-... | XREG STACK | "call 0(%[1])" | | |
-lfr $1==0 | | | | |
-lfr $1==2 | | | R0 | |
-lfr $1==4 | | | RR0 | |
-lfr $1==6 | | | R2 R1 R0 | |
-lfr $1==8 | | | RR2 RR0 | |
-ret $1==0 | STACK | "ldk R14, $$0\nld R15, R13"
- "pop R13, *RR14"
- "ret" | | |
-ret $1==2 | src2 STACK | move( %[1], R0 )
- "ldk R14, $$0\nld R15, R13"
- "pop R13, *RR14"
- "ret" | | |
-ret $1==4 | src4 STACK | move( %[1], RR0 )
- "ldk R14, $$0\nld R15, R13"
- "pop R13, *RR14"
- "ret" | | |
-ret $1==6 | src2 src2 src2 STACK | move( %[1], R0 )
- move( %[2], R1 )
- move( %[3], R2 )
- "ldk R14, $$0\nld R15, R13"
- "pop R13, *RR14"
- "ret" | | |
-ret $1==8 | src4 src4 STACK | move( %[1], RR0 )
- move( %[2], RR2 )
- "ldk R14, $$0\nld R15, R13"
- "pop R13, *RR14"
- "ret" | | |
-lfr ret $1==$2 | | | | ret 0 |
-asp lfr ret $2==$3 | | | | ret 0 |
-asp ret $2==0 | | | | ret 0 |
-/*\f*/
-/***************************************
-******** GROUP 15 ********
-***************************************/
-
-asp | STACK | "add R15, $$$1" | | |
-ass $1==2 | src2 STACK | "add R15, %[1]" | | |
-blm | STACK | move( {im2, $1}, R0 )
- "calr blm"
- erase(R0) | | |
-bls $1==2 | src2 STACK | move( %[1], R0 )
- "calr blm"
- erase(R0) | | |
-csa $1==2 | STACK | "pop R1, *RR14"
- "pop R2, *RR14"
- "jr csa" | | |
-lae csa $2==2 | src2 STACK | move( %[1], R2 )
- move( {ADDR_EXTERNAL, $1}, R1 )
- "jr csa" | | |
-csb $1==2 | STACK | "pop R1, *RR14"
- "pop R2, *RR14"
- "jr csb" | | |
-lae csb $2==2 | src2 STACK | move( %[1], R2 )
- move( {ADDR_EXTERNAL, $1}, R1 )
- "jr csb" | | |
-dup $1==2 | src2 | | %[1] %[1] | |
-dup $1==4 | src2 src2 | | %[2] %[1] %[2] %[1] | |
-dup | STACK | move( {im2, $1}, R0 )
- "calr dup"
- erase(R0) | | |
-dus $1==2 | src2 STACK | move( %[1], R0 )
- "calr dup"
- erase(R0) | | |
-exg $1==2 | src2 src2 | | %[1] %[2] | |
-exg $1==2 | STACK | move( {im2, $1}, R0 )
- "calr exg"
- erase(R0) | | |
-lor $1==0 | | | LB | |
-lor $1==1 | STACK | allocate( REG )
- "ld %[a], R15"
- samecc | %[a] | |
-lor $1==2 | | | {da2, "reghp"} | |
-rck $1==2 | src2 STACK | move( %[1], R1 )
- "calr rck" | | |
-rck !defined($1)| src2 src2 STACK | "cp %[1], $$2"
- "jr NE, unknown"
- move( %[2], R1 )
- "calr rck" | | |
-str $1==0 | src2 | "ld R13, %[1]" samecc | | |
-str $1==1 | src2 STACK | "ldk R14, $$0\nld R15, %[1]"
- samecc | | |
-str $1==2 | STACK | "calr strhp" | | |
-dch | | | | loi 2 |
-fil | | "ld hol0+4, $$$1" samecc | | |
-gto | STACK | "push *RR14, $$$1"
- "jr gto" | | |
-lim | | | {da2, "trpim"} | |
-lin | | "ld hol0, $$$1" samecc | | |
-lni | | "inc hol0" | | |
-lpb | | | | adp SL |
-mon | STACK | "calr mon" | | |
-nop | STACK | "calr noop" | | |
-rtt | | | | ret 0 |
-sig | REG | allocate(REG)
- move( {da2, "trppc"}, %[a] )
- "ld trppc, %[1]"
- samecc | %[a] | |
-sim | STACK | "pop trpim, *RR14"
- samecc | | |
-trp | STACK | "calr trp" | | |
-
-/* For several floating point instructions we generate an illegal
-** instruction trap
-*/
-adf | | | | loc 18 trp |
-sbf | | | | loc 18 trp |
-mlf | | | | loc 18 trp |
-dvf | | | | loc 18 trp |
-ngf | | | | loc 18 trp |
-fef | | | | loc 18 trp |
-fif | | | | loc 18 trp |
-zrf | | | | loc 18 trp |
-cfi | | | | loc 18 trp |
-cif | | | | loc 18 trp |
-cfu | | | | loc 18 trp |
-cuf | | | | loc 18 trp |
-cff | | | | loc 18 trp |
-cmf | | | | loc 18 trp |
-/*\f*/
-/* COERCIONS */
-/*********************************
-** From source2 to register **
-*********************************/
-| regconst2 | allocate( %[1], XREG = %[1.xreg] )
- "add %[a], $$%[1.ind]"
- setcc(%[a]) | %[a] | | (4,7)
-| ADDR_LOCAL | allocate( REG )
- "ld %[a], R13"
- "add %[a], $$%[1.ind]"
- setcc(%[a]) | %[a] | | (6,10)
-| REG | allocate( %[1], XREG = %[1] ) | {regconst2, %[a], 0} | |
-| src2 | allocate( %[1], REG = %[1] ) | %[a] | |
-| src2 | allocate( %[1], XREG = %[1] ) | {regconst2, %[a], 0} | |
-
-
-/*********************************
-** From source2 to source2 **
-*********************************/
-| ADDR_EXTERNAL | | {da2, %[1.ind]} | |
-
-
-/*********************************
-** From source1 to source2 **
-*********************************/
-| src1 | allocate( %[1], B2REG = %[1] ) | %[a] | |
-
-
-/*********************************
-** From source4 to register **
-*********************************/
-| src4 | allocate( %[1], LWREG = %[1] ) | %[a] | |
-
-
-/*********************************
-** From source4 to source2 **
-*********************************/
-| LWREG | | %[1.2] %[1.1] | |
-| x4 | | {x2, %[1.xreg], 2+%[1.ind]} {x2, %[1.xreg], %[1.ind]} | |
-| da4 | | {da2, "2+"+%[1.ind]} {da2, %[1.ind]} | |
-| ir4 | | {ir4_hi, %[1.lwxreg]} {ir2, %[1.lwxreg]} | |
-| ir4_hi | allocate( LWREG = %[1.lwreg] ) | {x2, %[a.2], 2} | |
-
-
-/*********************************
-** From STACK **
-*********************************/
-| STACK | allocate( REG )
- "pop %[a], *RR14"
- samecc | %[a] | | (2,8)
-| STACK | allocate( XREG )
- "pop %[a], *RR14"
- samecc | {regconst2, %[a], 0} | | (2,8)
-| STACK | allocate( LWREG )
- "popl %[a], *RR14"
- samecc | %[a] | | (2,12)
-
-
-MOVES:
-/* move( src, dst ) --> ld dst, src */
-(im2 (%[num]>=0 && %[num]<=15), REG, "ldk %[2], %[1]" samecc, (2,5))
-(im2 %[num]==0, src2a, "clr %[2]" samecc, (2,7)+%[2])
-(im2 %[num]==0, src1, "clrb %[2]" samecc, (2,7)+%[2])
-(im2, src1, "ldb %[2], $$[%[1.num]-[%[1.num]&0xFFFFFF00]+128]%%256-128"
- samecc, (4,9)+%[2])
-(src1, B2REG, "ldk %[2], $$0\nldb L%[2], %[1]" samecc, (4,8)+%[1])
-(src2, REG, "ld %[2], %[1]" samecc, (2,3)+%[1])
-(src4, LWREG, "ldl %[2], %[1]" samecc, (2,5)+%[1])
-(const2, src1, "ldb %[2], %[1]" samecc, (4,9)+%[2])
-(B2REG, src1, "ldb %[2], L%[1]" samecc, (2,6)+%[2])
-(src2b, src2a, "ld %[2], %[1]" samecc, (2,6)+%[1]+%[2])
-(src4b, src4a, "ldl %[2], %[1]" samecc, (2,6)+%[2])
-
-
-TESTS:
-(src2c, "test %[1]", (2,7)+%[1])
-
-
-STACKS:
-(src1, B2REG, move( %[1], %[a] )
- "push *RR14, %[a]"
- "clrb *RR14"
- samecc, (4,17) )
-(src1,, ".data\n1:\t.word 0\n.text"
- "ld 1b, R0"
- "ldk R0, $$0"
- "ldb RL0, %[1]"
- "push *RR14, R0"
- "ld R0, 1b"
- samecc, (18,37)+%[1] )
-(src2,, "push *RR14, %[1]"
- samecc, (2,9)+%[1] )
-(const4, LWREG, move( %[1], %[a] )
- "pushl *RR14, %[a]"
- samecc, (2,12) )
-(im4,, "push *RR14, %[1]"
- "push *RR14, $$0"
- samecc, (8,24) ) /* there is no pushl ir,im */
-(double,, ".data\n1:\t.long %[1]\n.text"
- "pushl *RR14, 1b"
- samecc, (6,20) )
-(src4,, "pushl *RR14, %[1]"
- samecc, (2,12)+%[1] )
-(regconst2,, "add %[1.xreg], $$%[1.ind]"
- "push *RR14, %[1.xreg]"
- nocc, (6,16) )
-(ADDR_LOCAL, REG,
- move( LB, %[a] )
- "add %[a], $$%[1.ind]"
- "push *RR14, %[a]"
- setcc(%[a]), (6,16) )
-(ADDR_LOCAL,, "add R13, $$%[1.ind]"
- "push *RR14, R13"
- "sub R13, $$%[1.ind]"
- nocc, (10,23) )
+++ /dev/null
-MAKEFILE=Makef.pr.l
-MACHDEF="MACH=z8000" "SUF=s"
-STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
-GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
-MON="PREF=mon" "SRC=lang/cem/libcc/mon"
-
-install: cpstdio cpgen cpmon
-
-cpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
-cpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
-cpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
-
-cmp: cmpstdio cmpgen cmpmon
-
-cmpstdio:
- make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
- -../../compare tail_cc.1s
-cmpgen:
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
- -../../compare head_cc
- make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
- -../../compare tail_cc.2g
-cmpmon:
- make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
- -../../compare tail_mon
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-
-install: cp
-
-cp:
- ln tail_em.s.a head_em ; ../../install head_em ; rm head_em
- ln tail_em.s.a tail_em ; ../../install tail_em ; rm tail_em
-
-cmp:
- -ln tail_em.s.a head_em ; ../../compare head_em ; rm head_em
- -ln tail_em.s.a tail_em ; ../../compare tail_em ; rm tail_em
+++ /dev/null
-MAKEFILE=Makef.pr.l
-MACHDEF="MACH=z8000" "SUF=s"
-PCDEF="PREF=pc" "SUB=" "SRC=lang/pc/libpc"
-
-install:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) cp
-
-cmp:
- make -f $(MAKEFILE) $(PCDEF) $(MACHDEF) all
- -../../compare head_pc
- -../../compare tail_pc
-
-clean:
- -rm -f *.old *.[ce$(SUF)] tail* head*
-
-opr:
- make pr | opr
-
-pr:
- @pr Makefile
+++ /dev/null
-${MACH?} -I../../../h ${MACHFL?} $1 1>&2
-echo `basename $1 $2`.s
+++ /dev/null
-.\" $Header$
-.TH 6500_AS 1
-.ad
-.SH NAME
-6500_as \- assembler for Mostek 6500
-.SH SYNOPSIS
-/usr/em/lib/6500_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH "SEGMENTS and TYPES"
-An additional segment, the \fIzeropage\fP, can be started by the
-\&\fI.zero\fP pseudo-instruction.
-Some adressing-modes require an address between 0 and 255.
-Such an address must be defined with the means of the \fI.zero\fP
-pseudo-instruction.
-A plain number between 0 and 255 is not allowed.
-The assembler will complain that it must be a zero page expression.
-.IP example
-\&.zero
-.br
-answer: .space 1
-.br
-\&.text
-.br
-and (answer, x)
-.SH SYNTAX
-.IP expressions
-An two-byte expression followed by the pseudo-operator \fI.h\fP (\fI.l\fP)
-has the value of the higher (lower) byte of the expression.
-\&\fI.h\fP and \fI.l\fP bind stronger than all other operators.
-E.g. -1.h parses as -[1.h] which has value 0.
-You have to write [-1].h to get 0xFF.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name)
-
-#expr 8-bit value (immediate)
-
-expr address (direct)
-
-expr, x expr + contents of x
- or or
-expr, y expr + contents of y
- yields address (indexed)
-
-(expr) address of address (only with JMP) (indirect)
-
-In the next two addressing modes `expr' has to be
-a zeropage expression.
-
-(expr, x) expr + contents of x
- yields address (pre-indexed indirect)
-
-(expr), y contents of expr + contents of y
- yields address (post-indexed indirect)
-.fi
-.IP instructions
-There are two mnemonics that do not map onto one machine-instruction:
-`add' and `sub'. `Add mode' maps onto `clc; adc mode'.
-`Sub mode' maps onto `sec; sbc mode'.
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1)
+++ /dev/null
-.\" $Header$
-.TH 6800_AS 1
-.ad
-.SH NAME
-6800_as \- assembler for Motorola 6800
-.SH SYNOPSIS
-/usr/em/lib/6800_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The 6800 has two accumulator registers, A and B. An instruction that refers
-to accumulator A, has an "a" as last character. In the same way a "b" means
-that the instruction uses B as accumulator.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name)
-
-#expr with cpx, ldx, lds a 2-byte value,
- otherwise a 1-byte value (immediate)
-
-<expr 1-byte address. Not allowed with:
- asl, asr, clr, com, dec, inc, lsl, lsr,
- neg, rol, ror, tst (base page direct)
-
-expr 2-byte address (extended direct)
-
-expr, x 1-byte expr + contents of x
- yields address (indexed)
-.fi
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-A. Osborne, 6800 programming for logic design,
-Adam Osborne and Associates Inc., 1977
-.SH EXAMPLE
-An example of Motorola 6800 assembly code.
-.sp 2
-.nf
-.ta 8 16 32 40 48 56 64
- .data
- val: 0
- .text
- ldx <val
- com val, x
- bhs someplace ! branch on carry clear
- sta <val
- adda #18 ! add 18 to accumulator A
-.fi
-.SH BUGS
-You have to specify whether an address fits in one byte
-with the token `<'. It should be done automatically.
+++ /dev/null
-.\" $Header$
-.TH 6809_AS 1
-.ad
-.SH NAME
-6809_as \- assembler for 6809
-.SH SYNOPSIS
-/usr/em/lib/6809_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The 6809 contains four 8-bit registers registers:
-two accumulators (a and b),
-a direct page register (dp),
-and a condition code register (cc),
-and five 16-bit registers:
-two index registers (x and y),
-a user an a hardware stack pointer (u resp. s),
-and a program counter (pc).
-The index registers and the stack pointers are indexable.
-Accumulators a and b can be concatenated to form
-the double accumulator d,
-of which a is the high and b is the low byte.
-An instruction that refers to accumulator a
-has an "a" as last character.
-In the same way a "b" means that the instruction
-uses b as accumulator.
-.IP "pseudo instructions"
-The 6809 assembler recognizes one additional instruction
-that is not translated into a machine instruction: setdp.
-It expects an expression as argument.
-This is used for efficient address encoding of some addressing
-mode (see below).
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name)
-
-reg The operand of the instruction is in `reg'.
-
-reglist `reglist' is a either list of registers, seperated
- by ','s, or the word "all". It encodes in a register
- save mask, where "all" means all registers, that can
- be used by the push-pull instructions pshs, pshu,
- puls, and pulu.
-
-<expr The one-byte value of `expr' is an address within
- a 256-byte page. The particular page in use is
- indicated by the contents of dp, so `expr' is the
- low byte of the effective address of the operand,
- and dp the high byte. (direct)
-
->expr The two-byte value of `expr' is the exact memory
- address. Not that this mode always requires one
- byte more than "<expr". (extended)
-
-expr The value of `expr' is an address.
- Except for long branches, this value is examined
- first to see if a short encoding is possible.
- When the instruction is a short branch, the value
- is checked to see if the address is not too remote,
- because in that case this branch is automatically
- replaced by a long branch. When the instruction is
- not a branch, the high byte of the value is compared
- with the value of the argument of the last setdp
- pseudo. If they are equal, this mode is replaced by
- "<expr", else by ">expr".
- (relative for branch-instructions)
-
-#expr The value of `expr' is one- or two-byte immediate
- data. (immediate)
-
-(expr) The value of `expr' is a pointer to the address
- of the operand. (indirect)
-
-expr, reg The value of `expr' added to the contents of `reg'
- (which must be a 16-bit register) yields the
- effective address of the operand.
- (constant-offset indexed)
-
-, ireg The contents of `ireg' (which must be indexable)
- yields the effective address of the operand.
- (constant-offset indexed)
-
-(expr, reg) The value of `expr' added to the contents of `reg'
- (which must be a 16-bit register) yields a pointer
- to the effective address of the operand.
- (constant-offset indexed indirect)
-
-(, ireg) The contents of `ireg' (which must be indexable)
- yields a pointer to the effective address of the
- operand. (constant-offset indexed indirect)
-
-ac, ireg The contents of `ac' (which must be an accumulator)
- added to the contents of `ireg' (which must be
- indexable) yields the effective address of the
- operand. (accumulator indexed)
-
-(ac, ireg) The contents of `ac' (which must be an accumulator)
- added to the contents of `ireg' (which must be
- indexable) yields a pointer to the effective address
- of the operand. (accumulator indexed indirect)
-
-,ireg+
-,ireg++ The contents of `ireg' (which must be indexable) is
- used as effective address of the operand. After that
- it is incremented by 1 (+) or 2 (++).
- (auto-increment)
-
-(,ireg++) The contents of `ireg' (which must be indexable) is
- used as a pointer to the effective address of the
- operand. After that it is incremented by 2.
- (auto-increment indirect)
-
-,-ireg
-,--ireg `ireg' (which must be indexable) is decremented
- by 1 (-) or 2 (--). After that, its contents is used
- as effective address of the operand.
- (auto-decrement)
-
-(,--ireg) `ireg (which must be indexable) is decremented by 2.
- After that, its contents is used as a pointer to the
- effective address of the operand.
- (auto-decrement indirect)
-
-.fi
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-MC6809 preliminary programming manual, Motorola Inc., First Edition, 1979
-.SH EXAMPLE
-An example of 6809 assembly code.
-.nf
-.ta 8 16 24 32 40 48
- contby = 80
-
- compgo: lda #contby
- ldx #table - 2 !start of table
-
- clrb
- co1: addb #2
- lsra
- bcc co1
- jmp (b, x) !accumulator offset indirect
-.fi
+++ /dev/null
-.\" $Header$
-.TH 8080_AS 1
-.ad
-.SH NAME
-8080_as \- assembler for Intel 8080 and 8085
-.SH SYNOPSIS
-/usr/em/lib/8080_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The 8080 has seven one-byte registers: a, b, c, d, e, h, l;
-and two two-byte registers: sp and psw, respectively the stack pointer
-and the processor status word.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning
-
-expr one- or two-byte address or immediate
- data, depending on the instruction.
-
-a,b,c,d,e,h,l
-sp,psw (lower byte) of register
-
-b,d,h register-pair b-c, d-e, or h-l
-
-m register-pair h-l is address of
- (one or two byte) operand
-.fi
-.SH "SEE ALSO"
-uni_ass(1),
-ack(1),
-.br
-System 80/20-4 microcomputer hardware reference manual, 1978 Intel corporation
+++ /dev/null
-# $Header$
-
-all:
- -nroff macro.v7 6500_as.1 > 6500_as.opr
- -nroff macro.v7 6800_as.1 > 6800_as.opr
- -nroff macro.v7 6809_as.1 > 6809_as.opr
- -nroff macro.v7 8080_as.1 > 8080_as.opr
- -nroff macro.v7 i86_as.1 > i86_as.opr
- -nroff macro.v7 m68k2_as.1 > m68k2_as.opr
- -nroff macro.v7 pdp_as.1 > pdp_as.opr
- -nroff macro.v7 ns_as.1 > ns_as.opr
- -nroff macro.v7 z8000_as.1 > z8000_as.opr
- -nroff macro.v7 z80_as.1 > z80_as.opr
- -tbl macro.v7 ack.1 | nroff >ack.opr
- -nroff macro.v7 arch.1 >arch.1.opr
- -nroff macro.v7 LLgen.1 > LLgen.1.opr
- -nroff macro.v7 arch.5 >arch.5.opr
- -nroff macro.v7 libmon.7 > libmon.opr
- -nroff macro.v7 libpc.7 > libpc.opr
- -nroff macro.v7 cpp.6 > cpp.opr
- -nroff macro.v7 em_ass.6 > em_ass.opr
- -nroff macro.v7 em_decode.6 > em_decode.opr
- -nroff macro.v7 em_opt.6 > em_opt.opr
- -nroff macro.v7 em_pem.6 > em_pem.opr
- -nroff macro.v7 pc_prlib.7 > pc_prlib.opr
- -nroff macro.v7 uni_ass.6 >uni_ass.opr
-
-install:
- -cp 6500_as.1 > /usr/man/man1/6500_as.1
- -cp 6800_as.1 > /usr/man/man1/6800_as.1
- -cp 6809_as.1 > /usr/man/man1/6809_as.1
- -cp 8080_as.1 > /usr/man/man1/8080_as.1
- -cp i86_as.1 > /usr/man/man1/i86_as.1
- -cp m68k2_as.1 > /usr/man/man1/m68k2_as.1
- -cp pdp_as.1 > /usr/man/man1/pdp_as.1
- -cp ns_as.1 > /usr/man/man1/ns_as.1
- -cp z80_as.1 > /usr/man/man1/z80_as.1
- -cp z8000_as.1 > /usr/man/man1/z8000_as.1
- -tbl ack.1 >/usr/man/man1/ack.1
- -cp arch.1 /usr/man/man1/arch.1
- -cp LLgen.1 /usr/man/man1/LLgen.1
- -cp arch.5 /usr/man/man5/arch.5
- -cp libmon.7 /usr/man/man7/em_libmon.7
- -cp libpc.7 /usr/man/man7/em_libpc.7
- -cp cpp.6 /usr/man/man6/cpp.6
- -cp em_ass.6 /usr/man/man6/em_ass.6
- -cp em_decode.6 /usr/man/man6/em_decode.6
- -cp em_opt.6 /usr/man/man6/em_opt.6
- -cp em_pem.6 /usr/man/man6/em_pem.6
- -cp pc_prlib.7 /usr/man/man7/em_pc_prlib.7
- -cp uni_ass.6 /usr/man/man6/uni_ass.6
-
-opr:
- make pr | opr
-
-pr:
- @make all >make.pr.out 2>&1 &
- @cat *.opr
-
-clean:
- -rm -f *.opr
+++ /dev/null
-.\" $Header$
-.TH A.OUT 5
-.SH NAME
-a.out \- universal assembler load format
-.SH DESCRIPTION
-The load files produced by the universal assemblers look very
-much alike.
-These load files consist of sequences of variable length
-records, each describing a part of the initialized memory.
-Bss type memory is left uninitialized by the universal assembler
-and has to be initialized at run-time.
-The EM header em_head will perform this task on most systems.
-Each record consists of a \fIcount\fP, an \fIaddress\fP and
-\fIcount\fP bytes.
-The first byte should be placed at \fIaddress\fP, the second at
-\fIaddress+1\fP, etc.
-
-.nf
-struct loadf {
- unsigned short l_addr[2] ; /* address */
- short l_cnt ; /* count */
- unsigned char data[] ; /* data */
-} ;
-.fi
-
-This representation is machine dependent in two ways.
-First, the byte order in the first three fields is the byte order
-of the machine the universal assembler is running.
-Second, the format of the address differs from machine to machine.
-.br
-For example, for the Intel 8086 the first entry contains a
-16-bit offset and the second entry a segment number.
-The segment number has to be multiplied by 16 and added to
-the addres to obtain the address of the first byte to be
-initialized.
-.br
-The PDP 11 version stores the address in l_addr[0] and the type
-of the initialized memory in l_addr[1].
-Types 1 and 3 are absolute, 4 is text, 5 is data and 6 BSS.
-.br
-For all other currently available machines the
-array of shorts is 'replaced' by a long.
-This long contains the 32-bit address.
-.SH "SEE ALSO"
-uni_ass(VI)
-.SH BUGS
+++ /dev/null
-.\" $Header$
-.TH ARCH 1
-.SH NAME
-arch \- archive and library maintainer
-.SH SYNOPSIS
-.B arch
-key [ posname ] afile name ...
-.SH DESCRIPTION
-.I Arch
-maintains groups of files
-combined into a single archive file.
-Its main use
-is to create and update library files as used by a linker.
-It can be used, though, for any similar purpose.
-The Amsterdam compiler kit provides its own archiver with a
-fixed, machine-independent format, much like the UNIX-V7
-archive format.
-EM programs using libraries assume archives in EM format.
-.PP
-.I Key
-is one character from the set
-.B drqtpmx,
-optionally concatenated with
-one or more of
-.B vuaibcl.
-.I Afile
-is the archive file.
-The
-.I names
-are constituent files in the archive file.
-The meanings of the
-.I key
-characters are:
-.TP
-.B d
-Delete the named files from the archive file.
-.TP
-.B r
-Replace the named files in the archive file.
-If the optional character
-.B u
-is used with
-.B r,
-then only those files with
-modified dates later than
-the archive files are replaced.
-If an optional positioning character from the set
-.B abi
-is used, then the
-.I posname
-argument must be present
-and specifies that new files are to be placed
-after
-.RB ( a )
-or before
-.RB ( b
-or
-.BR i )
-.IR posname .
-Otherwise
-new files are placed at the end.
-.TP
-.B q
-Quickly append the named files to the end of the archive file.
-Optional positioning characters are invalid.
-The command does not check whether the added members
-are already in the archive.
-Useful only to avoid quadratic behavior when creating a large
-archive piece-by-piece.
-.TP
-.B t
-Print a table of contents of the archive file.
-If no names are given, all files in the archive are tabled.
-If names are given, only those files are tabled.
-.TP
-.B p
-Print the named files in the archive.
-.TP
-.B m
-Move the named files to the end of the archive.
-If a positioning character is present,
-then the
-.I posname
-argument must be present and,
-as in
-.B r,
-specifies where the files are to be moved.
-.TP
-.B x
-Extract the named files.
-If no names are given, all files in the archive are
-extracted.
-In neither case does
-.B x
-alter the archive file.
-.TP
-.B v
-Verbose.
-Under the verbose option,
-.I arch
-gives a file-by-file
-description of the making of a
-new archive file from the old archive and the constituent files.
-When used with
-.B t,
-it gives a long listing of all information about the files.
-When used with
-.BR p ,
-it precedes each file with a name.
-.TP
-.B c
-Create.
-Normally
-.I arch
-will create
-.I afile
-when it needs to.
-The create option suppresses the
-normal message that is produced when
-.I afile
-is created.
-.TP
-.B l
-Local.
-Normally
-.I arch
-places its temporary files in the directory /tmp.
-This option causes them to be placed in the local directory.
-.SH FILES
-/tmp/v* temporaries
-.SH "SEE ALSO"
-em_ass(I), arch(V),
-.SH BUGS
-If the same file is mentioned twice in an argument list,
-it may be put in the archive twice.
+++ /dev/null
-.\" $Header$
-.TH ARCH 5
-.SH NAME
-arch \- archive (library) file format
-.SH SYNOPSIS
-.B #include "/usr/em/h/arch.h"
-.SH DESCRIPTION
-The archive command
-.I arch
-is used to combine several files into
-one.
-Archives are used mainly as libraries to be searched
-by the EM assembler/linker em_ass(VI) or the universal
-assembler/linker em_unias(VI).
-.PP
-A file produced by
-.I arch
-has a magic number at the start,
-followed by the constituent files, each preceded by a file header.
-The magic number and header layout as described in the
-include file are:
-.RS
-.PP
-.nf
-.ta \w'#define 'u +\w'ARMAG 'u
-.so ../h/arch.h
-.fi
-.RE
-.LP
-The name is a null-terminated string;
-The sizes of the other entries are determined as follows:
-long's are 4 bytes in PDP-11 order, int are 2 bytes, low order
-byte first, char's are 1 byte.
-The date is in the
-form of
-.IR time (2);
-the user ID and group ID are numbers; the mode is a bit pattern
-per
-.IR chmod (2);
-the size is counted in bytes.
-.PP
-Each file begins on a even offset;
-a null byte is inserted between files if necessary.
-Nevertheless the size given reflects the
-actual size of the file exclusive of padding.
-.PP
-Notice there is no provision for empty areas in an archive
-file.
-.SH "SEE ALSO"
-arch(I), em_ass(VI), em_unias(VI)
-.SH BUGS
-Coding user and group IDs as characters is a botch.
+++ /dev/null
-.\" $Header$
-.TH EM I
-.ad
-.SH NAME
-em \- calling program for em interpreters
-.SH SYNOPSIS
-em [-t] [+fcp] [loadfile [args ... ...] ]
-.SH DESCRIPTION
-The loadfile ("e.out" if not specified) is opened to read the first 8 word header.
-The format of this header is explained in e.out(V).
-One of these 8 words is a flag word
-specifying the interpreter options requested at compile time.
-The usual setting of these options is +t -f -c -p.
-One of these options may be overridden at run time
-by the corresponding flag of em.
-Based on these options the name of the appropriate interpreter
-is constructed.
-.PP
-This interpreter is first searched for in /usr/em/mach/pdp/int, then in the current
-directory.
-.PP
-The flags control the following options that can be turned off
-or on by prepending them with - or + respectively:
-.IP t
-run time tests for undefined variables, array bounds etc...
-This option costs a small amount of memory and some time.
-However, it is very useful for debugging.
-.IP p
-profiling of the entire program. The interpreter maintain tables containing
-an estimate of the number of memory cycles used per source line.
-This option is expensive in time as well as in memory space.
-The result tables made at run time are dumped onto a file named
-em_runinf. This file is converted to human readable format
-by the program eminform(I) which writes the profiling information
-on a file called em_profile.
-.IP f
-maintain a bit map of all source lines that have been executed.
-This map is written also onto the file em_runinf and can be interpreted by eminform(I) which writes in this case the file em_flow.
-This option is almost free in time and space.
-.IP c
-count line usage in tables that
-contains for every source line the number of times it
-was entered.
-These tables are also written onto em_runinf.
-Eminform(I) can be used to convert this information into the
-file em_count.
-Cheap in time, expensive in memory space.
-.PP
-These flags
-give rise to 5 different interpreters which are in the
-directory /usr/em/mach/pdp/int
-.PP
-If the interpreter exits with a non-zero exit status, then the line numbers
-of the 64 last executed source lines are dumped on the file
-em_runinf
-in the current directory. Eminform(I) writes this information
-on the human readable file em_last.
-.SH "FILES"
-.IP /usr/em/mach/pdp/int/em_???? 35
-interpreters proper
-.PD 0
-.IP /usr/em/lib/pdp_int/em_????
-source of interpreter
-.IP /usr/em/mach/pdp/int/?+
-positive option switch
-.IP /usr/em/mach/pdp/int/?-
-negative option switch
-.IP em_runinf
-memory dump containing runtime information
-.IP em_profile
-profile data
-.IP em_count
-source line count data
-.IP em_flow
-source line flow data
-.IP em_last
-last lines executed
-.PD
-.SH "SEE ALSO"
-eminform(I), ack(I), int(I)
-.SH BUGS
-Most error messages are self explanatory.
-The interpreter stops in case of lack of space with an error
-message SEGVIO stack overflow.
-If runtime flags are turned on it is advisable to try again
-with the default options.
-Bugs should be reported to Evert Wattel.
+++ /dev/null
-.\" $Header$
-.TH EM_CG VI
-.ad
-.SH NAME
-em_cg \- EM to assembly code translator
-.SH SYNOPSIS
-/usr/em/lib/mach_cg [-d] [-p\fIn\fP] [-w\fIn\fP] [ infile [ outfile ] ]
-.SH DESCRIPTION
-Em_cg reads a compact EM-program, argument or standard input,
-and produces an assembly program on argument or standard output
-for the machine that is in its name.
-Flags recognized are:
-.IP -d
-Run in debugging mode,
-only possible when the translator is compiled in the right way.
-.IP -p\fIn\fP
-Set the ply to \fIn\fP, default 1.
-The ply is the maximum lookahead depth the code generator may take.
-Effects of this flag are machine dependent.
-.IP -w\fIn\fP
-Set the weight percentage for size to \fIn\fP %, default is 50.
-This sets the size/time tradeoff in the codegenerator.
-Effects are again machine dependent.
-.SH "SEE ALSO"
-ack(I)
-.PD 0
-.IP [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson "Description of a machine architecture for use with
-block structured languages" Informatica report IR-81.
-.SH AUTHOR
-Hans van Staveren, Vrije Universiteit
+++ /dev/null
-.\" $Header$
-.TH EM_DECODE VI
-.ad
-.SH NAME
-em_decode,em_encode \- compact to readable EM and v.v.
-.SH SYNOPSIS
-/usr/em/lib/em_decode [ inputfile [ outputfile ] ]
-.br
-/usr/em/lib/em_encode [ inputfile [ outputfile ] ]
-.SH DESCRIPTION
-Most programs involved with the EM project only produce and accept
-EM programs in compact form.
-These files are only machine readable.
-A description of this compact form can be found in [1].
-To inspect the code produced by compilers or to patch them for one reason
-or another, you need human readable assembly code.
-Em_decode will do the job for you.
-.PP
-Em_decode accepts the normal compact form in both optimized and
-unoptimized form
-.PP
-Sometimes you have to make some special routines directly
-in EM, for instance the routines implementing the system calls.
-At these times you may use em_encode to produce compact routines
-out of these human readable assembly modules.
-.PP
-The first argument is the input file.
-The second argument is the output file.
-Both programs can act as a filter.
-.SH "SEE ALSO"
-.IP [1]
-A.S.Tanenbaum, Ed Keizer, Hans van Staveren & J.W.Stevenson
-"Description of a machine architecture for use of
-block structured languages" Informatica rapport IR-81.
-.IP [2]
-ack(I)
-.SH DIAGNOSTICS
-Error messages are intended to be self-explanatory.
-.SH AUTHOR
-Johan Stevenson, Vrije Universiteit.
+++ /dev/null
-.\" $Header$
-.tr ~
-.TH EMINFORM I
-.ad
-.SH NAME
-eminform \- converts runtime information of interpreted em to
-human readable form.
-.SH SYNOPSIS
-eminform
-.SH DESCRIPTION
-The EM interpreter, em(I), has several debugging features built in.
-They can be activated by flag options to em(I).
-The EM interpreter collects the information while it runs the program.
-When the program is terminated, the interpreter dumps this information onto
-a file called em_runinf.
-Eminform converts this information in human readable form onto
-a set of files with fixed names, the file em_runinf itself is unlinked.
-.PP
-.in +15
-.ti -13
-~~em_last~~~~A circular buffer is used to keep track of
-the last collection of executed source lines.
-.ti -13
-~~em_flow~~~~A bit map for all source lines tells which lines
-are executed.
-.ti -13
-~~em_count~~~Count the number of times each source line was entered.
-.ti -13
-~~em_profile~Estimate the number of memory cycles
-spent on each source line.
-.in -15
-.LP
-The most common use of eminform is to print the numbers of the last executed
-source lines if an execution error occurred.
-No arguments are needed in this case.
-.LP
-Eminform will create only those files for which there were
-interpreter flags turned on. If no runtime error occurred and
-no flag was turned on the file em_runinf is not created. In
-this case eminform will give the error message "read header
-failed".
-.SH FILES
-em_runinf, em_last, em_flow, em_count, em_profile
-.SH "SEE ALSO"
-ack(I), int(I), em(I).
-.SH BUGS
-If an entire procedure is not touched, the the file name in
-which this procedure occured is unknown.
-If no em_runinf is available the error message is "read header
-failed" and a core dump is created.
-Bugs should be reported to Evert Wattel
+++ /dev/null
-.\" $Header$
-.TH I86_AS 1
-.ad
-.SH NAME
-i86_as \- assembler for Intel 8086
-.SH SYNOPSIS
-/usr/em/lib/i86_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP segments
-An address on the Intel 8086 consists of two pieces:
-a segment number and an offset. A memory address is computed as
-the segment number shifted left 4 bits + the offset.
-Assembly language addresses only give the offset, with the exception of
-the address of an inter-segment jump or call (see `addressing modes' below).
-For each segment type (.org, .text, .data, or .bss) the segment number
-must be given with the .sbase pseudo-instruction.
-The syntax is:
-.br
- .sbase <segment-id> expression
-.br
-with segment-id one of .org, .text, .data, or .bss.
-Example:
-.br
- .sbase .text 0x1000
-
-.IP registers
-The Intel 8086 has the following 16-bit registers:
-.br
-Four general registers: ax (accumulator), bx (base), cx (count), and dx (data).
-The upper halves and lower halves of these registers are separately
-addressable as ah, bh, ch, dh, and al, bl, cl, dl respectively.
-.br
-Two pointer registers: sp (stack pointer) and bp (base pointer).
-.br
-Two index registers: si (source index) and di (destination index).
-.br
-Four segment registers: cs (code), ds (data), ss (stack), and es (extra).
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning
-
-expr the value of `expr' is immediate data or
- an address offset. There is no special
- notation for immediate data.
-
-register one of the aforementioned general registers
- or their upper or lower halves, or one of the
- four segment registers.
-
-(expr) the value of expr is the address of the operand.
-
-(reg)
-expr (reg) the value of `expr' (if present) + the contents of
- `reg' (which must be a pointer or an index register)
- is the address of the operand.
-
-(preg) (ireg)
-expr (preg) (ireg)
- the value of `expr' (if present) + the contents of
- `preg' (which must be a pointer register) + the
- contents of `ireg' (which must be an index register)
- is the address of the operand.
-
-The next addressing mode is only allowed with the instructions
-"callf" or "jmpf".
-
-expr : expr the value of the first `expr' is a segment number,
- the value of the second `expr' is an address offset.
- The (absolute) address of the operand is computed
- as described above.
-.fi
-
-.IP instructions
-Each time an address is computed the assembler decide which segment register
-to use. You can override the assembler's choice by prefixing the instruction
-with one of eseg, cseg, sseg, or dseg; these prefixes indicate that the
-assembler should choose es, cs, ss, or ds instead.
-.br
-Example:
-.ti +8
-dseg movs
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-MCS-86 assembly language reference manual, 1978, Intel Corporation
-.SH EXAMPLE
-.nf
-.ta 8 16 24 32 40 48
-An example of Intel 8086 assembly language:
-
- _panic:
- push bp
- mov bp,sp
- .data
- _35:
- .word 24944
- .word 26990
- .word 14947
- .word 32
- .text
- call _disable
- mov ax,_35
- push ax
- call _str
- pop si
- push 4(bp)
- call _str
- pop si
- call _nlcr
- call _exit
- mov sp,bp
- pop bp
- ret
- .extern _nopanic
- _nopanic:
- push bp
- mov bp,sp
- .data
- _38:
- .word 28526
- .word 24944
- .word 26990
- .word 14947
- .word 32
- .text
- mov ax,_38
- push ax
- call _str
- pop si
- push 4(bp)
- call _str
- pop si
- push 6(bp)
- call _octal
- pop si
- mov sp,bp
- pop bp
- ret
-.fi
+++ /dev/null
-.\" $Header$
-.TH LIBMON VII
-.ad
-.SH NAME
-libmon \- library of system call routines with EM calling sequence
-.SH DESCRIPTION
-The modules in this library contain the UNIX system calls with EM calling sequence.
-This library is written in EM assembly language and can be used
-for interpreted programs, and 'a.out' programs.
-If these routines are used in Pascal programs, then the calling sequence
-requires some attention.
-Some hints may be useful:
-.IP -
-The c-option {$c+} allows you to declare zero-terminated string
-constants in Pascal like "/etc/passwd".
-Moreover, the identifier 'string' is then defined as type identifier for
-a pointer to these zero-terminated strings.
-.IP -
-The d-option {$d+} allows you to use double precision integers (longs).
-The lseek system call, for instance, needs a long argument and returns a long result.
-.IP -
-If the system call requires a pointer as argument use a 'var' parameter.
-For instance declare times as:
-.br
- procedure times(var t:timesbuf); extern;
-.br
-Note that a 'string' is already a pointer.
-.IP -
-When defining types, use packed records if two bytes must be allocated
-in a single word, as in
-.br
- device = packed record
-.br
- minor,major:0..255;
-.br
- end;
-.IP -
-If a collection of bits is needed, then define an enumerated type and
-a set of this enumerated type. The create mode of a file, for example,
-can be declared as:
-.br
- modebits = (XHIM,WHIM,RHIM,
-.br
- XYOU,WYOU,RYOU,
-.br
- XME, WME, RME,
-.br
- TEXT,SGID,SUID,... );
-.br
- creatmode = set of XHIM..SUID;
-.IP -
-There are special system call routines 'uread' and 'uwrite' in libpc(VII),
-because the names 'read' and 'write' are blocked by similar functions in Pascal.
-.PP
-The system call 'signal' exists, but uses 'sigtrp'.
-This EM system call has the
-following calling sequence:
-.br
- function sigtrp(signo,trapno:integer):integer;
-.br
-The action values of 'signal', odd for 'ignore' and zero
-for 'get back to default',
-may interfere with the EM procedure identification in some
-implementations.
-In most interpreters procedures in EM are numbered consecutively from zero up.
-The first argument of 'sigtrp' is the signal number 'signo' as for 'signal'.
-The second argument is an integer 'trapno', indicating the action to be performed
-when the signal is issued:
-.IP -2 8
-Reset the action for signal 'signo' to the default.
-.IP -3
-Ignore signal 'signo'.
-.IP "0-252"
-Perform an EM instruction TRP with error code 'trapno',
-whenever the signal 'signo' is issued.
-Note that the error codes 0-127 are reserved for EM machine errors
-and language runtime system errors.
-.PP
-The routine 'sigtrp' returns the old 'trapno' or -1 if an erroneous
-signal number is specified.
-Only the signal numbers 1, 2, 3, 13, 14, 15 and 16 may be used as argument
-for 'sigtrp'.
-.SH FILES
-.IP /usr/em/mach/*/lib/tail_mon
-.PD
-.SH "SEE ALSO"
-em(I), ack(I), *(II), libpc(VII)
-.SH DIAGNOSTICS
-All routines put the UNIX error code in the global variable 'errno'.
-Errno is not cleared by successful system calls, so it always gives
-the error of the last failed call.
-One exception: ptrace clears errno when successful.
-.SH AUTHOR
-Ed Keizer, Vrije Universiteit
-.SH BUGS
-There should be additional routines giving a fatal error when they fail.
-It would be pleasant to have routines,
-which print a nice message and stop execution for unexpected errors.
+++ /dev/null
-.\" $Header$
-.TH LIBPC VII
-.ad
-.SH NAME
-libpc \- library of external routines for Pascal programs
-.SH SYNOPSIS
-.ta 11
-const bufsize = ?;
-.br
-type br1 = 1..bufsize;
-.br
- br2 = 0..bufsize;
-.br
- br3 = -1..bufsize;
-.br
- ok = -1..0;
-.br
- buf = packed array[br1] of char;
-.br
- alfa = packed array[1..8] of char;
-.br
- string = ^packed array[1..?] of char;
-.br
- filetype = file of ?;
-.br
- long = record high,low:integer end;
-
-{all routines must be declared extern}
-
-function argc:integer;
-.br
-function argv(i:integer):string;
-.br
-function environ(i:integer):string;
-.br
-procedure argshift;
-
-procedure buff(var f:filetype);
-.br
-procedure nobuff(var f:filetype);
-.br
-procedure notext(var f:text);
-.br
-procedure diag(var f:text);
-.br
-procedure pcreat(var f:text; s:string);
-.br
-procedure popen(var f:text; s:string);
-.br
-procedure pclose(var f:filetype);
-
-procedure trap(err:integer);
-.br
-procedure encaps(procedure p; procedure q(n:integer));
-
-function perrno:integer;
-.br
-function uread(fd:integer; var b:buf; len:br1):br3;
-.br
-function uwrite(fd:integer; var b:buf; len:br1):br3;
-
-function strbuf(var b:buf):string;
-.br
-function strtobuf(s:string; var b:buf; len:br1):br2;
-.br
-function strlen(s:string):integer;
-.br
-function strfetch(s:string; i:integer):char;
-.br
-procedure strstore(s:string; i:integer; c:char);
-
-function clock:integer;
-.SH DESCRIPTION
-This library contains some often used external routines for Pascal programs.
-Two versions exist: one for the EM interpreter and another one
-that is used when programs are translated into PDP-11 code.
-The routines can be divided into several categories:
-.PP
-Argument control:
-.RS
-.IP argc 10
-Gives the number of arguments provided when the program is called.
-.PD 0
-.IP argv
-Selects the specified argument from the argument list and returns a
-pointer to it.
-This pointer is nil if the index is out of bounds (<0 or >=argc).
-.IP environ
-Returns a pointer to the i-th environment string (i>=0). Returns nil
-if i is beyond the end of the environment list (UNIX version 7).
-.IP argshift
-Effectively deletes the first argument from the argument list.
-Its function is equivalent to 'shift' in the UNIX shell: argv[2] becomes
-argv[1], argv[3] becomes argv[2], etc.
-It is a useful procedure to skip optional flag arguments.
-Note that the matching of arguments and files
-is done at the time a file is opened by a call to reset or rewrite.
-.PD
-.PP
-.RE
-Additional file handling routines:
-.RS
-.IP buff 10
-Turn on buffering of a file. Not very useful, because all
-files are buffered except standard output to a terminal and diagnostic output.
-Input files are always buffered.
-.PD 0
-.IP nobuff
-Turn off buffering of an output file. It causes the current contents of the
-buffer to be flushed.
-.IP notext
-Only useful for input files.
-End of line characters are not replaced by a space and character codes out of
-the ASCII range (0..127) do not cause an error message.
-.IP diag
-Initialize a file for output on the diagnostic output stream (fd=2).
-Output is not buffered.
-.IP pcreat
-The same as rewrite(f), except that you must provide the filename yourself.
-The name must be zero terminated. Only text files are allowed.
-.IP popen
-The same as reset(f), except that you must provide the filename yourself.
-The name must be zero terminated. Only text files are allowed.
-.IP pclose
-Gives you the opportunity to close files hidden in records or arrays.
-All other files are closed automatically.
-.PD
-.PP
-.RE
-String handling:
-.RS
-.IP strbuf 10
-Type conversion from character array to string.
-It is your own responsibility that the string is zero terminated.
-.PD 0
-.IP strtobuf
-Copy string into buffer until the string terminating zero byte
-is found or until the buffer if full, whatever comes first.
-The zero byte is also copied.
-The number of copied characters, excluding the zero byte, is returned. So if
-the result is equal to the buffer length, then the end of buffer is reached
-before the end of string.
-.IP strlen
-Returns the string length excluding the terminating zero byte.
-.IP strfetch
-Fetches the i-th character from a string.
-There is no check against the string length.
-.IP strstore
-Stores a character in a string. There is no check against
-string length, so this is a dangerous procedure.
-.PD
-.PP
-.RE
-Trap handling:
-.RS
-These routines allow you to handle almost all
-the possible error situations yourself.
-You may define your own trap handler, written in Pascal, instead of the
-default handler that produces an error message and quits.
-You may also generate traps yourself.
-.IP trap 10
-Trap generates the trap passed as argument (0..252).
-The trap numbers 128..252 may be used freely. The others are reserved.
-.PD 0
-.IP encaps
-Encapsulate the execution of 'p' with the trap handler 'q'.
-Encaps replaces the previous trap handler by 'q', calls 'p' and restores
-the previous handler when 'p' returns.
-If, during the execution of 'p', a trap occurs,
-then 'q' is called with the trap number as parameter.
-For the duration of 'q' the previous trap handler is restored, so that
-you may handle only some of the errors in 'q'. All the other errors must
-then be raised again by a call to 'trap'.
-.br
-Encapsulations may be nested: you may encapsulate a procedure while executing
-an encapsulated routine.
-.br
-Jumping out of an encapsulated procedure (non-local goto) is dangerous,
-because the previous trap handler must be restored.
-Therefore, you may only jump out of procedure 'p' from inside 'q' and
-you may only jump out of one level of encapsulation.
-If you want to exit several levels of encapsulation, use traps.
-See pc_emlib(VII) and pc_prlib(VII) for lists of trap numbers
-for EM machine errors and Pascal run time system errors.
-Note that 'p' may not have parameters.
-.PD
-.PP
-.RE
-UNIX system calls:
-.RS
-The routines of this category require global variables or routines
-of the monitor library libmon(VII).
-.IP uread 10
-Equal to the read system call.
-Its normal name is blocked by the standard Pascal routine read.
-.PD 0
-.IP uwrite
-As above but for write(II).
-.IP perrno
-Because external data references are not possible in Pascal,
-this routine returns the global variable errno, indicating the result of
-the last system call.
-.PD
-.PP
-.RE
-Miscellaneous:
-.RS
-.IP clock 10
-Return the number of ticks of user and system time consumed by the program.
-.PD
-.PP
-.RE
-The following program presents an example of how these routines can be used.
-This program is equivalent to the UNIX command cat(I).
-.nf
- {$c+}
- program cat(input,inp,output);
- var inp:text;
- s:string;
-
- function argc:integer; extern;
- function argv(i:integer):string; extern;
- procedure argshift; extern;
- function strlen(s:string):integer; extern;
- function strfetch(s:string; i:integer):char; extern;
-
- procedure copy(var fi:text);
- var c:char;
- begin reset(fi);
- while not eof(fi) do
- begin
- while not eoln(fi) do
- begin
- read(fi,c);
- write(c)
- end;
- readln(fi);
- writeln
- end
- end;
-
- begin {main}
- if argc = 1 then
- copy(input)
- else
- repeat
- s := argv(1);
- if (strlen(s) = 1) and (strfetch(s,1) = '-')
- then copy(input)
- else copy(inp);
- argshift;
- until argc <= 1;
- end.
-.fi
-.PP
-Another example gives some idea of the way to manage trap handling:
-.nf
-
- program bigreal(output);
- const EFOVFL=4;
- var trapped:boolean;
-
- procedure encaps(procedure p;
- procedure q(n:integer)); extern;
- procedure trap(n:integer); extern;
-
- procedure traphandler(n:integer);
- begin if n=EFOVFL then trapped:=true else trap(n) end;
-
- procedure work;
- var i,j:real;
- begin trapped:=false; i:=1;
- while not trapped do
- begin j:=i; i:=i*2 end;
- writeln('bigreal = ',j);
- end;
-
- begin
- encaps(work,traphandler);
- end.
-.fi
-.SH FILES
-.IP /usr/em/mach/*/lib/tail_pc 20
-.PD
-.SH "SEE ALSO"
-ack(I), pc_pem(VI), pc_prlib(VII), libmon(VII)
-.SH DIAGNOSTICS
-Two routines may cause fatal error messages to be generated.
-These are:
-.IP pcreat 10
-Rewrite error (trap 77) if the file cannot be created.
-.PD 0
-.IP popen
-Reset error (trap 76) if the file cannot be opened for reading
-.PD
-.SH AUTHOR
-Johan Stevenson, Vrije Universiteit.
-.br
-encaps: Ed Keizer, Vrije Universiteit.
+++ /dev/null
-.\" $Header$
-.TH M68K2_AS 1
-.ad
-.SH NAME
-m68k2_as \- assembler for Motorola 68000
-.SH SYNOPSIS
-/usr/em/lib/m68k2_as [options] argument ...
-.br
-/usr/em/lib/m68k4_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The 68000 has the following registers:
-seven data-registers (d1 - d7), seven address-registers (a1 - a6, sp)
-of which sp is the system stack pointer, a program counter (pc),
-a status register (sr), and a condition codes register (ccr) which is actually
-just the low order byte of the status register.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name)
-
-reg contents of `reg' is operand, where `reg' is
- one of the registers mentioned above (register direct)
-
-(areg) contents of `areg' is address of operand, where
- `areg' is an address-register
- (address register indirect)
-
-(areg)+ same as (areg), but after the address is used,
- `areg' is incremented by the operand length
- (postincrement)
-
--(areg) same as (areg), but before the address is used,
- `areg' is decremented by the operand length
- (predecrement)
-
-expr(areg)
-expr(pc) `expr' + the contents of the register yields the
- address of the operand (displacement)
-
-expr(areg, ireg)
-expr(pc, ireg) `expr' + the contents of the register + the contents
- of `ireg' yields the address of the operand. `ireg' is
- an address- or a data-register.
- `ireg' may be followed by .w or .l indicating whether
- the size of the index is a word or a long
- (displacement with index)
-
-expr `expr' is the address of the operand
- (absolute address)
-
-#expr `expr' is the operand (immediate)
-.fi
-
-Some instructions have as operand a register list. This list consists of
-one or more ranges of registers separated by '/'s. A register range consists
-of either one register (e.g. d3) or two registers separated by a '-'
-(e.g. a2-a4, or d4-d5). The two registers must be in the same set (address-
-or data-registers) and the first must have a lower number than the second.
-.IP instructions
-Some instructions can have a byte, word, or longword operand.
-This may be indicated by prepending the mnemonic with .b, .w, or .l
-respectively. Default is .w.
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-MC68000 16-bit microprocessor User's manual, Motorola Inc, 1979
-.SH EXAMPLE
-.sp 2
-.nf
-.ta 8 16 24 32 40 48 56 64
- .define .cii
-
- .text
- .cii:
- movem.l a0/d0/d1,.savreg
- move.l (sp)+,a0 ! return address
- move (sp)+,d0 ! destination size
- sub (sp)+,d0 ! destination - source size
- bgt 1f
- sub d0,sp ! pop extra bytes
- bra 3f
- 1:
- move (sp),d1
- ext.l d1
- swap d1
- asr #1,d0
- 2:
- move.w d1,-(sp)
- sub #1,d0
- bgt 2b
- 3:
- move.l a0,-(sp)
- movem.l .savreg,a0/d0/d1
- rts
-.fi
+++ /dev/null
-.\" $Header$
-.de TH
-.PD
-.lc
-.nr in 5
-.de hd
-'sp 2
-'tl '\\$1(\\$2)'Amsterdam Compiler Kit'\\$1(\\$2)'
-'sp 2
-\\..
-.wh -6 fo
-.wh 0 hd
-.nr pi 5
-..
-.de fo
-'sp 2
-'tl ''- % -''
-'bp
-..
-.de PD
-.nr pd 0.5v
-.if \\n(.$ .nr pd \\$1
-..
-.de SH
-.nr in 5
-.nr pi 5
-.in \\n(in
-.ti 0
-.sp \\n(pdu
-.ne 2
-.fi
-\s+3\fB\\$1\fP\s0
-.br
-..
-.de LP
-.PP
-..
-.de PP
-.sp \\n(pdu
-.ne 2
-.in \\n(in
-.nr pi 5
-.ns
-..
-.de IP
-.if \\n(.$-1 .nr pi \\$2
-.sp \\n(pdu
-.in \\n(in+\\n(pi
-.ta \\n(in \\n(in+\\n(pi
-.ti 0
-\ 1\fB\\$1\fR\ 1\c
-.if \w'\fB\\$1\fP'-\\n(pin+1n .br
-..
-.de RS
-.nr in +5
-.in +5
-..
-.de RE
-.in -5
-.nr in -5
-..
-.de RF
-\fI\\$1\fP(\\$2)\\$3
-..
+++ /dev/null
-.TH NS_ASS VI
-.ad
-.SH NAME
-ns_as \- National Semiconductor 16032 assembler/linker
-.SH SYNOPSIS
-\&..../lib/ns/as [options] argument ...
-.SH DESCRIPTION
-The assembler for the National Semiconductor 16032 is based
-on the universal assembler \fIuni_ass\fP(VI).
-The mnemonics for the instructions are taken from the NS-16000
-Programmers Reference Manual.
-The syntax of the instruction operands is similar to the syntax used
-in that manual,
-although the meaning is sometimes quite different.
-The cross assembler issued by National Semiconductor
-associates a type (sb,..) with each symbol
-and automatically generates sb offset mode for symbols of type sb.
-This assembler does not record the types,
-each symbol simply produces an untyped value.
-.sp 1
-The possible operands are:
-.IP "general registers
-These are called r0, r1, r2, r3, r4, r5, r6 and r7.
-The symbol REG is used to indicate use of any of these 8 registers
-in other operands.
-.IP "floating point registers
-These are called f0, f1, f2, f3, f4, f5, f6 and f7.
-.IP "dedicated registers
-All types of dedicated registers can be used with the appropriate instructions.
-Examples: sb, fp, intbase, ptb1.
-.IP expr(REG)
-register relative
-.IP expr(fp)
-frame pointer relative
-.IP expr(sb)
-static base relative
-.IP expr(sp)
-stack pointer relative
-.IP expr(pc)
-program counter relative,
-the expression indicates a location in memory from which the current value
-of '.' is subtracted by the assembler.
-E.g. "movw label(pc),r0; label: .word ..." moves the contents of the word
-at \fIlabel\fP to r0.
-.IP expr(expr(fb))
-.IP expr(expr(sb))
-.IP expr(expr(sp))
-memory relative
-.IP @expr
-absolute
-.IP external(expr)+expr
-The external mode is provided, although this assembler
-does not build a module table.
-.IP tos
-top of stack.
-.PD 0
-.sp 1
-.PP
-Usage of the scaled index operands is allowed.
-.br
-The convention used to indicate offset length by appending :B, :W or :D
-to offsets is not implemented.
-The assembler tries to find out the minimal size needed for any constant
-in an operand of the instruction placed in the text segment.
-Offsets in instructions outside '.text' are always four bytes.
-.PP
-All special operands, e.g. register list, configuration list, have
-the same format as in the Programmers Reference Manual.
-.PP
-Whenever possible the assembler automatically uses the short(quick) opcodes for
-jsr(jsb), jump(br), add(addq), cmp(cmpq) and mov(movq).
-.SH BUGS
-The data types floating and packed-decimal are not supported.
-.br
-Initialization of floating-point numbers is not possible.
-.br
-The mnemonics of the slave processor instructions are poorly documented,
-the format of the NS-16032S-6 data sheet is used.
-.br
-The documentation gave contradictory information on the format
-of a few instructions.
-.IP -
-Three different schemes are presented for the encoding
-of the last operand of the block instructions.
-.IP -
-Two different values are specified for
-the encoding of the msr register in smr and lmr instructions.
-.IP -
-Two different possibilities are given for the encoding of
-the instructions movsu and movus.
-.SH EXAMPLE
-.nf
-.ta 12 20 28 36
-
-00000000 0E0B02 setcfg [ m ]
- label:
-00000003 EC3E lprb psr,r7
-00000005 2D37 sprw intbase,r6
-
-00000007 EA7C br label
-
-00000009 02803B bsr rout1
-0000000C 228044 cxp rout1
-0000000F 1204 ret 4
-00000011 4204 rett 4
-00000013 328044 rxp rout1
-
-00000016 1E0300 rdval r0
-00000019 163028 scsr r5
-
-0000001C 3F32 shid r6
-0000001E 7F0B bispsrd r1
-00000020 7C17 caseb r2
-00000022 7FA806 cxpd @6
-
-00000025 021F jsr @rout1
-
-00000027 BEB529 absf f5,f6
-0000002A EE0538 movusw r7,r0
-0000002D 3E40A101 movbl 1,f5
-00000031 CE440003 cmpmb r0,r1,4
-
-00000035 CE4F0800 extsd r1,r1,0,1
-00000039 62A0 save [ r5, r7 ]
-0000003B 1E0B00 lmr bpr0,r0
-
-0000003E 0E8C04 skpst w
-00000041 CC0042 acbb 1,r0,label
-00000044 B2 rout1: wait
-00000045 7F950C0B adjspd 11(12(sb))
-00000049 7CA50D adjspb 13
-0000004C 7DB50102 adjspw external(1)+2
-00000050 7FBD adjspd tos
-
-00000052 7CED860807 adjspb 7(8(fp))[r6:w]
-
-.fi
-.SH "SEE ALSO"
-uni_ass(VI)
-.br
-NS 16000 Programmers Reference Manual. Publ. no. 420306565-001PB
-.br
-NS16032S-6, NS16032S-4 High Performance Microprocessors, november 1982
-.br
-publ. no. 420306619-002A.
-.PD 0
-.SH AUTHOR
-Ed Keizer, Vrije Universiteit
+++ /dev/null
-.\" $Header$
-.TH PC_PRLIB VII
-.ad
-.SH NAME
-pc_prlib \- library of Pascal runtime routines
-.SH SYNOPSIS
-.ta 11
-type alpha=packed array[1..8] of char;
-.br
- pstring= ^packed array[] of char;
-
-function _abi(i:integer):integer;
-.br
-function _abl(i:long):long;
-.br
-function _mdi(j,i:integer):integer;
-.br
-function _mdl(j,i:long):long;
-.br
-function _abr(r:real):real;
-.br
-function _sin(r:real):real;
-.br
-function _cos(r:real):real;
-.br
-function _atn(r:real):real;
-.br
-function _exp(r:real):real;
-.br
-function _log(r:real):real;
-.br
-function _sqt(r:real):real;
-.br
-function _rnd(r:real):real;
-
-type compared=-1..1;
-.br
- gotoinfo=record
-.br
- pcoffset:^procedure; { procedure id. without static link }
-.br
- nlocals: integer;
-.br
- end;
-
-function _bcp(sz:integer; s2,s1:pstring):compared;
-.br
-function _bts(size,high,low:integer; base:^set 0..(8*size-1))
- :set of 0..(8*size-1);
-.br
-procedure _gto(lb:^integer; p:^gotoinfo);
-
-procedure _new(size:integer; var p:^integer);
-.br
-procedure _dis(size:integer; var p:^integer);
-.br
-procedure _sav(var p:^integer);
-.br
-procedure _rst(var p:^integer);
-
-type arrdescr=record
-.br
- lowbnd: integer;
-.br
- diffbnds:integer;
-.br
- elsize: integer;
-.br
- end;
-.br
- arr1=array[] of ?;
-.br
- arr2=packed array[] of ?;
-
-procedure _pac(var ad,zd:arrdescr; var zp:arr2; i:integer;
-.br
- var ap:arr1);
-.br
-procedure _unp(var ad,zd:arrdescr; i:integer; var ap:arr1;
-.br
- var zp:arr2;);
-.br
-function _asz(var dp:arrdescr):integer;
-
-procedure _ass(line:integer; b:boolean);
-.br
-procedure procentry(var name:alpha);
-.br
-procedure procexit(var name:alpha);
-
-const lowbyte=[0..7];
-.br
- MAGIC =[1,3,5,7];
-.br
- WINDOW =[11];
-.br
- ELNBIT =[12];
-.br
- EOFBIT =[13];
-.br
- TXTBIT =[14];
-.br
- WRBIT =[15];
-.br
-type file=record
-.br
- ptr: ^char;
-.br
- flags: set of [0..15];
-.br
- fname: string;
-.br
- ufd: 0..15;
-.br
- size: integer;
-.br
- count: 0..buflen;
-.br
- buflen: max(512,size) div size * size;
-.br
- bufadr: packed array[1..max(512,size)]
-.br
- of char;
-.br
- end;
-.br
- filep=^file;
-.br
-const NFILES=15;
-.br
- _extfl:^array[] of filep;
-
-procedure _ini(var args:integer; var hb:integer;
- var p:array[] of filep; var mainlb:integer);
-.br
-procedure _hlt(status:0..255);
-
-procedure _opn(size:integer; f:filep);
-.br
-procedure _cre(size:integer; f:filep);
-.br
-procedure _cls(f:filep);
-
-procedure _get(f:filep);
-.br
-procedure _put(f:filep);
-.br
-function _wdw(f:filep):^char;
-.br
-function _efl(f:filep):boolean;
-
-function _eln(f:filep):boolean;
-.br
-function _rdc(f:filep):char;
-.br
-function _rdi(f:filep):integer;
-.br
-function _rdl(f:filep):long;
-.br
-function _rdr(f:filep):real;
-.br
-procedure _rln(f:filep);
-.br
-procedure _wrc(c:char; f:filep);
-.br
-procedure _wsc(w:integer; c:char; f:filep);
-.br
-procedure _wri(i:integer; f:filep);
-.br
-procedure _wsi(w:integer; i:integer; f:filep);
-.br
-procedure _wrl(l:long; f:filep);
-.br
-procedure _wsl(w:integer; l:long; f:filep);
-.br
-procedure _wrr(r:real; f:filep);
-.br
-procedure _wsr(w:integer; r:real; f:filep);
-.br
-procedure _wrf(ndigit:integer; w:integer; r:real; f:filep);
-.br
-procedure _wrs(l:integer; s:pstring; f:filep);
-.br
-procedure _wss(w:integer; l:integer; s:pstring; f:filep);
-.br
-procedure _wrb(b:boolean; f:filep);
-.br
-procedure _wsb(w:integer; b:boolean; f:filep);
-.br
-procedure _wrz(s:string; f:filep);
-.br
-procedure _wsz(w:integer; s:string; f:filep);
-.br
-procedure _wln(f:filep);
-.br
-procedure _pag(f:filep);
-.SH DESCRIPTION
-This library is used by the Pascal to EM compiler and
-contains all the runtime routines for standard Pascal programs.
-Most routines are written in C, a few in EM assembly language.
-These routines can be divided into several categories.
-A description of each category with its routines follows.
-.PP
-Arithmetic routines:
-.RS
-.IP _abi
-Compute the absolute value of an integer.
-.PD 0
-.IP _abl
-Compute the absolute value of a long.
-.IP _mdi
-Perform the Pascal modulo operation on integers.
-.IP _mdl
-Perform the Pascal modulo operation on longs.
-.IP _abr
-Compute the absolute value of a real.
-.IP _sin
-Compute the sine of a real.
-.IP _cos
-Compute the cosine of a real.
-.IP _atn
-Compute the arc tangent of a real.
-.IP _exp
-Compute the e-power of a real.
-.IP _log
-Compute the natural logarithm of a real.
-.IP _sqt
-Compute the square root of a real.
-.IP _rnd
-Return a real that when truncated will
-result in the nearest integer (-3.5->-4).
-.PD
-.PP
-.RE
-Miscellaneous routines:
-.RS
-.IP _bcp
-Compare two strings. Use dictionary ordering with the ASCII
-character set. The EM instruction CMU can not be used, because it needs
-an even number of bytes.
-.PD 0
-.IP _bts
-Include a range of elements from low to high in a set of size bytes
-at address base.(size can be divided by the wordsize)
-.IP _gto
-Execute a non-local goto. Lb points to the
-local base of the target procedure.
-A lb of zero indicates a jump to the program body, the lb of the main
-program is found in _m_lb, which is set by _ini.
-The new EM stack pointer is calculated by adding the number of locals
-to the new local base
-(jumping into statements is not allowed; there are no local generators
-in Pascal!).
-.PD
-.PP
-.RE
-Heap management:
-.RS
-.PP
-There is one way to allocate new heap space (_new), but two different
-incompatible ways to deallocate it.
-.PP
-The most general one is by using dispose (_dis).
-A circular list of free blocks, ordered from low to high addresses, is maintained.
-Merging free blocks is done when a new block enters the free list.
-When a new block is requested (_new), the free list is searched using a
-first fit algorithm.
-Two global variables are needed:
-.IP _highp 10
-Points to the free block with the highest address.
-.PD 0
-.IP _lastp
-Points to the most recently entered free block or to a block
-in the neighborhood of the most recently allocated block.
-.PD
-The free list is empty, when one of these pointers (but then at the same
-time both) is zero.
-.PP
-The second way to deallocate heap space is by using
-mark (_sav) and release (_rst). Mark saves the current value of the
-heap pointer HP in the program variable passed as a parameter.
-By calling release with this old HP value as its argument, the old HP value
-is restored, effectively deallocating all blocks requested between
-the calls to mark and release.
-The heap is used as second stack in this case.
-.PP
-It will be clear that these two ways of deallocating heap space
-can not be used together.
-To be able to maintain the free list, all blocks must be a multiple
-of n bytes long, with a minimum of n bytes,
-where n is the sum of the size of a word and a pointer in the
-EM implementation used.
-.PP
-In summary:
-.IP _new
-Allocate heap space.
-.PD 0
-.IP _dis
-Deallocate heap space.
-.IP _sav
-Save the current value of HP.
-.IP _rst
-Restore an old value of HP.
-.PD
-.PP
-.RE
-Array operations:
-.RS
-.PP
-The only useful form of packing implemented, is packing bytes into words.
-All other forms of packing and unpacking result in a plain copy.
-.IP _pac
-Pack an unpacked array 'a' into a packed array 'z'. 'ap' and 'zp'
-are pointers to 'a' and 'z'. 'ad' and 'zd'
-are pointers to the descriptors of 'a' and 'z'. 'i' is
-the index in 'a' of the first element to be packed.
-Pack until 'z' is full.
-.PD 0
-.IP _unp
-Unpack 'z' into 'a'. 'ap', 'zp', 'ad' and 'zd' are as for _pac. 'i' is
-the index in 'a' where the first element of 'z' is copied into.
-Unpack all elements of 'z'.
-.IP _asz
-Compute array size. Used for copying conformant arrays.
-.PD
-.PP
-.RE
-Debugging facilities:
-.RS
-The compiler allows you to verify assertions.
-It generates a call to the routine _ass to check the assertion at runtime.
-Another feature of the compiler is that it enables you to trace the
-procedure calling sequence. If the correct option is turned on, then
-a call to the procedure 'procentry' is generated at the start of each
-compiled procedure or function. Likewise, the routine 'procexit' is called
-just before a procedure or function exits.
-Default procedure 'procentry' and 'procexit' are available in this library.
-.IP _ass 10
-If 'b' is zero, then change eb[0] to 'line'
-(to give an error message with source line number) and call the error routine.
-.PD 0
-.IP procentry
-Print the name of the called procedure with up to seven argument words
-in decimal on standard output. Output must be declared in the program heading.
-.IP procexit
-Print the name of the procedure that is about to exit.
-Same remarks as for procentry.
-.PD
-.PP
-.RE
-Files:
-.RS
-.PP
-Most of the runtime routines are needed for file handling.
-For each file in your Pascal program a record of type file, as described
-above, is allocated, static if your file is declared in the outermost block,
-dynamic if it is declared in inner blocks.
-The fields in the file record are used for:
-.IP bufadr 10
-IO is buffered except for standard input and output if
-terminals are involved. The size of the buffer is the maximum of 512
-and the file element size.
-.PD 0
-.IP buflen
-The effective buffer length is the maximum number of file elements
-fitting in the buffer, multiplied by the element size.
-.IP size
-The file element size (1 or even).
-.IP flags
-Some flag bits are stored in the high byte and a magic pattern
-in the low byte provides detection of destroyed file
-information.
-.IP ptr
-Points to the file window inside the buffer.
-.IP count
-The number of bytes (the window inclusive) left in the buffer
-to be read or the number of free bytes (the window inclusive) for output files.
-.IP ufd
-The UNIX file descriptor for the file.
-.IP fname
-Points to the name of the file (INPUT for standard input,
-OUTPUT for standard output and LOCAL for local files).
-This field is used for generating error messages.
-.PD
-.PP
-The constants used by the file handling routines are:
-.IP WINDOW 10
-Bit in flags set if the window of an input file is initialized.
-Used to resolve the famous interactive input problem.
-.PD 0
-.IP EOFBIT
-Bit in flags set if end of file seen
-.IP ELNBIT
-Bit in flags set if linefeed seen
-.IP TXTBIT
-Bit in flags set for text files. Process linefeeds.
-.IP WRBIT
-Bit in flags set for output files
-.IP MAGIC
-Pattern for the low byte of flags
-.IP NFILES
-The maximum number of open files in UNIX
-.PD
-.PP
-.RE
-Prelude and postlude:
-.RS
-.PP
-These routines are called once for each Pascal program:
-.IP _ini
-When a file mentioned in the program heading is opened by reset or
-rewrite, its file pointer must be mapped onto one of the program
-arguments.
-The compiler knows how to map and therefore builds a table with
-a pointer to the file structure for each program argument.
-One of the first actions of the Pascal program is to call this procedure
-with this table as an argument.
-The global variable _extfl is used to save the address of this table.
-Another task of _ini is to initialize the standard input and output files.
-For standard output it must decide whether to buffer or not.
-If standard output is a terminal, then buffering is off by setting
-buflen to 1.
-Two other task of _ini are the copying of two pointers from
-the argument list to global memory, mainlb to _m_lb and hb to _hbase.
-The first contains the local base of the program body, the second
-contains the address of the hol containing the global variables
-of the program.
-A last task of _ini is to set the global variables _argc, _argv and _environ
-from args for
-possible reference later on.
-Args points to the argument count placed on the stack by the EM runtime system,
-see chapter 8 in [1].
-.PD 0
-.IP _hlt
-If the program is about to finish, the buffered files must be flushed.
-That is done by this procedure.
-.PD
-.PP
-.RE
-Opening and closing:
-.RS
-.PP
-Files in Pascal are opened for reading by reset and opened for writing by
-rewrite.
-Files to be rewritten may or may not exist already.
-Files not mentioned in the program heading are considered local files.
-The next steps must be done for reset and rewrite:
-.IP 1.
-If size is zero, then a text file must be opened with elements of
-size 1.
-.PD 0
-.IP 2.
-Find out if this file is mentioned in the program heading
-(scan table pointed to by _extfl).
-If not, then it is a local file and goto 7.
-.IP 3.
-If the file is standard input or output then return.
-.IP 4.
-If there are not enough arguments supplied, generate an error.
-.IP 5.
-If the file was already open, flush the buffer if necessary and close it.
-Note that reset may be used to force the buffer to be flushed.
-This is sometimes helpful against program or system crashes.
-.IP 6.
-If it is a reset, open the file, otherwise create it.
-In both cases goto 9.
-.IP 7.
-If the local file is to be written, then close it if it was open and
-create a new nameless file. First try to create it in /usr/tmp, then in /tmp
-and if both fail then try the current directory.
-See to it that the file is open for both reading and writing.
-.IP 8.
-If the local file is to be read
-and the file is opened already, then
-flush the buffer and seek to the beginning.
-Otherwise open a temporary file as described in 7.
-.IP 9.
-Initialize all the file record fields.
-.PD
-.PP
-The necessary procedures are:
-.IP _opn
-Reset a file
-.PD 0
-.IP _cre
-Rewrite a file
-.IP _cls
-Close a file. Closing of files is done for local files when the procedure
-in which they are declared exits.
-The compiler only closes local files if they are not part of a structured type.
-Files allocated in the heap are not closed when they are deallocated.
-There is an external routine 'pclose' in libP(VII), that may be called
-explicitly to do the closing in these cases.
-Closing may be necessary to flush buffers or to keep the number of
-simultaneously opened files below NFILES.
-Files declared in the outermost block are automatically closed when the
-program terminates.
-.PD
-.PP
-.RE
-General file IO:
-.RS
-.PP
-These routines are provided for general file IO:
-.IP _put
-Append the file element in the window to the file and advance the
-window.
-.IP _get
-Advance the file window so that it points to the next element
-of the file.
-For text files (TXTBIT on) the ELNBIT in flags is set if the new character
-in the window is a line feed (ASCII 10) and the character is then changed
-into a space.
-Otherwise the ELNBIT is cleared.
-.IP _wdw
-Return the current pointer to the file window.
-.IP _eof
-Test if you reached end of file.
-Is always true for output files.
-.PD
-.PP
-.RE
-Textfile routines:
-.RS
-.PP
-The rest of the routines all handle text files.
-.IP _eln
-Return true if the next character on an input file is an end-of-line marker.
-An error occurs if eof(f) is true.
-.PD 0
-.IP _rdc
-Return the character currently in the window and advance the window.
-.IP _rdi
-Build an integer from the next couple of characters on the file,
-starting with the character in the window.
-The integer may be preceded by spaces (and line feeds), tabs and a sign.
-There must be at least one digit.
-The first non-digit signals the end of the integer.
-.IP _rdl
-Like _rdi, but for longs.
-.IP _rdr
-Like _rdi, but for reals. Syntax is as required for Pascal.
-.IP _rln
-Skips the current line and clears the WINDOW flag, so that the
-next routine requiring an initialized window knows that it has to
-fetch the next character first.
-.IP _wrc
-Write a character, not preceeded by spaces.
-.IP _wsc
-Write a character, left padded with spaces up to a field width
-of 'w'.
-.IP _wri
-Write an integer, left padded with spaces up to a field width
-of 6.
-.IP _wsi
-Write an integer, left padded with spaces up to a field width
-of 'w'.
-.IP _wrl
-Write a long, left padded with spaces up to a field width
-of 11.
-.IP _wsl
-Write a long, left padded with spaces up to a field width
-of 'w'.
-.IP _wrr
-Write a real in scientific format,
-left padded with spaces up to a field width of 13.
-.IP _wsr
-Write a real in scientific format,
-left padded with spaces up to a field width of 'w'.
-.IP _wrf
-Write a real in fixed point format, with exactly 'ndigit' digits
-behind the decimal point, the last one rounded; it is left padded up to
-a field width of 'w'.
-.IP _wrs
-Write a string of length 'l', without additional spaces.
-.IP _wss
-Write a string of length 'l', left padded up to a field
-width of 'w'.
-.IP _wrb
-Write a boolean, represented by "true" or "false", left padded
-up to a field width of 5.
-.IP _wsb
-Write a boolean, represented by "true" or "false", left padded
-up to a field width of 'w'.
-.IP _wrz
-Write a C-type string up to the zero-byte.
-.IP _wsz
-Write a C-type string, left padded up to a field width of w.
-.IP _wln
-Write a line feed (ASCII 10).
-.IP _pag
-Write a form feed (ASCII 12).
-.PD
-.PP
-.RE
-All the routines to which calls are generated by the compiler are described above.
-They use the following global defined routines to do some of the work:
-.IP _rf 10
-Check input files for MAGIC and WRBIT.
-Initialize the window if WINDOW is cleared.
-.PD 0
-.IP _wf
-Check output files for MAGIC and WRBIT.
-.IP _incpt
-Advance the file window and read a new buffer if necessary.
-.IP _outcpt
-Write out the current buffer if necessary and advance the window.
-.IP _flush
-Flush the buffer if it is an output file.
-Append an extra line marker if EOLBIT is off.
-.IP _wstrin
-All output routines make up a string in a local buffer.
-They call _wstrin to output this buffer and to do the left padding.
-.IP _skipsp
-Skip spaces (and line feeds) on input files.
-.IP _getsig
-Read '+' or '-' if present.
-.IP _fstdig
-See to it that the next character is a digit. Otherwise error.
-.IP _nxtdig
-Check if the next character is a digit.
-.IP _getint
-Do the work for _rdi.
-.IP _ecvt
-Convert real into string of digits for printout in scientific notation.
-.IP _fcvt
-Convert real into string of digits for fixed point printout
-.IP -fif
-Split real into integer and fraction part
-.IP _fef
-Split real into exponent and fraction part
-.PD
-.PP
-The following global variables are used:
-.IP _lastp 10
-For heap management (see above).
-.PD 0
-.IP _highp
-For heap management (see above).
-.IP _extfl
-Used to save the argument p of _ini for later reference.
-.IP _hbase
-Used to save the argument hb of _ini for later reference.
-.IP _m_lb
-Used to store the local base of the main program.
-.IP _curfil
-Save the current file pointer, so that the
-error message can access the file name.
-.IP "_pargc, _pargv, _penvp"
-Used to access the arguments of the main program.
-.PD
-.SH FILES
-.IP /usr/em/lib/mach/*/lib/tail_pc 20
-The library used by ack[5] to link programs.
-.IP /usr/em/etc/pc_rterrors
-The error messages
-.PD
-.SH "SEE ALSO"
-.IP [1]
-A.S. Tanenbaum, Ed Keizer, Hans van Staveren & J.W. Stevenson
-"Description of a machine architecture for use of
-block structured languages" Informatica rapport IR-81.
-.PD 0
-.IP [2]
-K.Jensen & N.Wirth
-"PASCAL, User Manual and Report" Springer-Verlag.
-.IP [3]
-An improved version of the ISO standard proposal for the language Pascal
-ISO/TC97/SC5-N462, received November 1979.
-.IP [4]
-Ed Keizer, "The Amsterdam Compiler Kit reference manual".
-.br
-(try 'nroff /usr/emi/doc/pcref.doc').
-.IP [5]
-ack(I), pc_pem(VI)
-.PD
-.SH DIAGNOSTICS
-All errors discovered by this runtime system cause an EM TRP instruction
-to be executed. This TRP instruction expects the error number on top
-of the stack. See [1] for a more extensive treatment of the subject.
-.PP
-EM allows the user to specify a trap handling routine, called whenever
-an EM machine trap or a language or user defined trap occurs.
-One of the first actions in _ini is to specify that the routine _fatal,
-available in this library, will handle traps.
-This routine is called with an error code (0..252) as argument.
-The file "/usr/em/etc/pc_rterrors" is opened and searched for a message
-corresponding with this number.
-If the file can not be opened, or if the error number is not recorded
-in the file, then the same trap is generated again, but without
-a user-defined trap handler, so that the low levels generate an
-error message.
-Otherwise the following information is printed
-on file descriptor 2:
-.IP -
-The name of the Pascal program
-.PD 0
-.IP -
-The name of the file pointed to by _curfil, if the error number
-is between 96 and 127 inclusive.
-.IP -
-The error message (or the error number if not found).
-.IP -
-The source line number if not equal to 0.
-.PD
-.PP
-The routine _fatal stops the program as soon as the message is printed.
-.PP
-The following error codes are used by the Pascal runtime system:
-.IP 64
-more args expected
-.PD 0
-.IP 65
-error in exp
-.IP 66
-error in ln
-.IP 67
-error in sqrt
-.IP 68
-assertion failed
-.IP 69
-array bound error in pack
-.IP 70
-array bound error in unpack
-.IP 71
-only positive j in 'i mod j'
-.IP 72
-file not yet open
-.IP 73
-dispose error
-.sp
-.IP 96
-file xxx: not writable
-.IP 97
-file xxx: not readable
-.IP 98
-file xxx: end of file
-.IP 99
-file xxx: truncated
-.IP 100
-file xxx: reset error
-.IP 101
-file xxx: rewrite error
-.IP 102
-file xxx: close error
-.IP 103
-file xxx: read error
-.IP 104
-file xxx: write error
-.IP 105
-file xxx: digit expected
-.IP 106
-file xxx: non-ASCII char read
-.PD
-.PP
-.SH AUTHORS
-Johan Stevenson and Ard Verhoog, Vrije Universiteit.
-.SH BUGS
-Please report bugs to the authors.
+++ /dev/null
-.\" $Header$
-.TH PDP_AS 1
-.ad
-.SH NAME
-pdp_as \- assembler for PDP 11
-.SH SYNOPSIS
-/usr/em/lib/pdp_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The pdp11 has seven general registers, numbered r0 through r7.
-Of these, r6 is the stack pointer and can also be referenced to by `sp',
-r7 is the program counter and has `pc' as synonym. There are also six
-floating-point registers fr0 through fr5, but the names r0 through r5 can
-also be used. From the context will be derived what kind of register is meant.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name)
-
-reg contents of register reg is operand.
- (register)
-
-(reg) contents of reg is address of operand.
- (register deferred)
-
-(reg)+ as (reg), but after the operand is fetched
- the contents of reg is incremented by the
- size of the operand. (auto-increment)
-
-*(reg)+ contents of reg points to address of the operand.
- after the operand is fetched, reg is incremented
- by two. (auto-increment deferred)
-
--(reg) as (reg), but before the operand is fetched
- the contents of reg is decremented by the
- size of the operand. (auto-decrement)
-
-*-(reg) before the operand is fetched, reg is decremented
- by two. then the contents of reg points to the
- address of the operand. (auto-decrement deferred)
-
-expr(reg) value of expr + contents of reg yields address
- of operand. (index)
-
-*expr(reg) value of expr + contents of reg yields pointer
- to address of operand. (index deferred)
-
-$expr the value of expr is the operand. (immediate)
-
-*$expr the value of expr is the address of the operand.
- (absolute)
-
-expr expr is address of operand. (relative)
-
-*expr expr points to the address of the operand.
- (relative deferred)
-
-.fi
-.IP "condition code instructions"
-Two or more of the "clear" instructions (clc, cln, clv, clz), or
-two or more of the "set" instructions (sec, sen, sev, sez) may be
-or-ed together with `|' to yield a instruction that clears or sets two or more
-of the condition-bits. Scc and ccc are not predefined.
-.IP "extended branches"
-The assembler recognizes conditional branches with a "j" substituted for
-the "b". When the target is too remote for a simple branch, a converse branch
-over a jmp to the target is generated. Likewise jbr assembles into either br
-or jmp.
-.IP "floating-point instructions"
-The names of several floating-point instructions differ from the names
-in the handbook mentioned below. Synonyms ending in "d" for instructions ending
-in "f" are not recognized. Some instructions have different names; the mapping
-is as below.
-.nf
-.ta 8 16 24 32 40 48
-
-handbook pdp_as
-
-ldcif, ldclf,
-ldcid, ldcld movif
-
-stcfi, stcfl,
-stcdi, stcdl movfi
-
-ldcdf, ldcfd movof
-
-stcdf, stcfd movfo
-
-ldexp movie
-
-stexp movei
-
-ldd, ldf movf
-
-std, stf movf
-
-.fi
-The movf instruction assembles into stf, when the first operand is one of the
-first three floating-point registers, otherwise it assembles into ldf.
-.IP sys
-This instruction is synonymous with trap.
-.SH EXAMPLE
-An example of pdp11 assembly code.
-.nf
-.ta 8 16 24 32 40 48
-
-!this is the routine that reads numbers into r0
-!the number is terminated by any non digit
-!the non digit is left in r1
-innum: clr r3 !r3 will accumulate the number
-inloop: jsr pc,_getchar !read a character into r0
- cmp r0,$0121 !is it a Q?
- jeq quit
- cmp r0,$48 !is the character a digit?
- jlt indone !digits 0-9 have codes 060-071 octal
- cmp r0,$56
- jgt indone
- mul $10,r3 !r3 = 10 * r3
- sub $48,r3 !convert ascii code to numerical value
- add r0,r3 !r3 = old sum * 10 + new digi
- jbr inloop
-
-indone: mov r0,r1 !put the first non digit into r1
- mov r3,r0 !put the number read into r0
- rts pc !return to caller
-
-.fi
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-PDP11/60 processor handbook, Digital Equipment Corporation, 1977
-.SH BUGS
-You cannot use *reg in place of (reg). Likewise *(reg) is not understood as
-*0(reg).
+++ /dev/null
-.\" $Header$
-.tr ~
-.TH UNI_ASS VI
-.ad
-.SH NAME
-uni_ass \- universal assembler/loader
-.SH SYNOPSIS
-/usr/em/lib/\fImachine\fP_as [options] argument ...
-.SH DESCRIPTION
-The universal assembler is a framework allowing easy
-generation of an assembler for any byte oriented machine.
-The framework includes common pseudo instructions for name
-definition, label usage, storage allocation and initialization
-and expression evaluation.
-The resulting program assembles and links assembly modules.
-Arguments may be flags, assembly language modules or libraries.
-.br
-Flags are:
-.IP -d[\fIn\fP]
-Produce a listing on standard output, the octal number
-\fIn\fP is mainly used for debugging purposes.
-The default is 700. 500 and 600 give slightly different
-listings.
-.IP -s[\fIn\fP]
-Produce a human-readable symbol table on standard output.
-The default for \fIn\fP is 3.
-The value 2 causes a listing of only the symbols internal to
-the modules.
-The value 1 causes a listing of external symbols only.
-.IP -o
-The argument following this flag is taken as the name of the
-resulting load file.
-The default name is \fBa.out\fP.
-.PD
-.PP
-The assemblers assemble
-and link together assembly language modules
-machine
-from files and libraries,
-producing an a.out file.
-.PP
-Two different types of arguments are allowed:
-.IP "1-"
-Assembly language modules
-.PD 0
-.IP "2-"
-UNIX archives, as maintained by arch(I). These archives must
-only contain
-assembly language modules with \fI.define\fP as their first
-statement.
-.PD
-.PP
-Note that it is not possible to do a partial load;
-loading starts from assembly language and produces binary
-machine code. No symbol table and no relocation bits are produced.
-.SH "SEGMENTS and TYPES"
-The statements allocating and initializing space,
-like instructions and
-some pseudo-instruction reserve that space in the current
-segment.
-The currently reigning type of segment is determined by
-one of the pseudo-instructions: \fI.text, .data, .bss\fP and
-\&\fI.org\fP.
-The assembler concatenates all space allocated in each of the
-text, data and bss segments.
-That is: every byte in a text segment is followed by another
-byte in the text segment except the last, of which there is
-only one in each program.
-The org segment differs from the other three in the sense that
-the assembler makes no attempt to concatenate pieces of org
-segments.
-Each \fI.org\fP pseudo-instruction has a parameter telling where it
-should start allocating space.
-In the final stages of the assembly the text, data and bss
-segments are concatenated in that order after the length of
-each segment has been made a multiple of a machine dependent
-constant.
-The first segment (text) starts at the location that is given
-as an argument to the .base pseudo-instruction.
-The default is 0.
-.sp
-The labels defined in a particular segment
-have the type of that
-segment, other types are: \fIundefined\fP and \fIabsolute\fP.
-All variables that do not have a value have the type
-\fIundefined\fP, a good example is an unsatisfied external
-reference.
-Numbers have the type \fIabsolute\fP.
-The type of expressions depends on both the operators and the
-operands used.
-Generally, but not always, the following rule holds: whenever
-one of the operands is absolute and the resulting type is that
-of the other operand.
-Not every operation is allowed on every combination of types,
-for example: it is not allowed to add two \fItext\fP values.
-.SH SYNTAX
-.IP letters
-Both upper and lower case may be used and are seen as
-different.
-The underscore '_' is considered to be a letter.
-.IP identifiers
-Identifiers are a sequence of letters and digits, starting with
-a letter or a period '.'.
-Only the first eight characters are remembered by the
-assemblers, identifiers with the same first eight characters
-are considered to be identical.
-Identifiers can, only once, receive a value through assignment or a
-label definition.
-.IP "local labels"
-Local labels consist of a single digit.
-They can only be defined in the label part of a statement and
-used anywhere an identifier is allowed.
-They can be redefined at will.
-Two forms of use exist: \fIf\fPorward and \fIb\fPackward
-references.
-The first consists of the digit followed by an \fIf\fP
-and refers to the first definition of that label following the
-reference.
-The second consists of the digit followed by an \fIb\fP
-and refers to the last definition of the label before the
-reference.
-.IP strings
-Strings are enclosed in single "'" or double """ quotes.
-The use of \eddd where ddd is an octal number and \en, \er,
-\et, \eb and \ef is allowed and has the same meaning as in the
-C language.
-.IP numbers
-Numbers are a sequence of letters and digits, starting with a
-digit.
-No difference is made between small and capital letters.
-.br
-The base of the number is determined in the following way:
-.nf
-if the number ends with an 'h' it is hexadecimal else
- if the number starts with '0x' it is hexadecimal else
- if the number starts with '0' it is octal else
- it's decimal.
-.fi
-Note that the number '0x10h' is an illegal hexadecimal number,
-because 'x' is an illegal hexadecimal digit.
-The number should be written as '0x10' or '10h'.
-The range of numbers depends on the machine.
-A rule of the thumb is that the width of the machine's registers
-the same is as the number of bits allowed in numbers.
-.IP expressions
-The following operators are recognized:
-.nf
-.sp 1
- op type action
-
- | binary bitwise or
- & binary bitwise and
- ^ binary bitwise exclusive or
- + binary two's complement addition
- + unary no effect
- - binary two's complement subtraction
- - unary two's complement negation
- * binary two's complement multiplication
- / binary two's complement division
- % binary two's complement remainder
-.tr ~~
- ~ unary one's complement negation
-.tr ~
-.sp 1
-.fi
-The operator precedence is the same as in C.
-.br
-The operands allowed are: identifiers, numbers and expressions.
-The evaluation order can be changed using the brackets '[' and
-\&']'.
-.sp
-.IP comment
-The character '!' denotes the start of comment, every character
-up to the next newline is skipped.
-Exclamation marks in strings are not recognized as the start of
-comment.
-.IP statements
-Statements are separated by newlines and ';' and can be
-preceded by label definitions.
-Label definitions have the form "\fIidentifier\fP~:" or
-"\fIdigit\fP~:".
-Statements can be: empty, an assignment, an instruction or a
-pseudo-instruction.
-.IP assignment
-An assignment has the form:
-.br
- \fIidentifier\fP = \fIexpression\fP
-.br
-The identifier receives the value and type of the expression.
-.IP instruction
-The syntax of an instruction depends on the type of the target
-machine.
-An example of a assembly file is presented at
-the end of the document.
-.IP pseudo-instruction
-.de Pu
-.sp 1
-.ti +5
-\&\\$1
-.sp 1
-..
-.Pu ".extern \fIidentifier [, identifier]*\fP"
-The identifiers mentioned in the list are exported and can be
-used in other modules.
-.Pu ".define \fIidentifier [, identifier]*\fP"
-Used for modules that are to be part of a libary.
-The .define pseudo's should be the first in such modules.
-When scanning a module in a library the univeral assembler
-checks whether any of its unsatified external references is
-mentioned in a .define list. If so, it includes that module in
-the program.
-The identifiers mentioned in the list are exported and can be
-used in other modules.
-.Pu ".byte \fIexpression [, expression]*\fP"
-Initialize a sequence of bytes.
-This is not followed by automatic alignment.
-.Pu ".short \fIexpression [, expression]*\fP"
-Initialize a sequence of shorts (2-byte values).
-This is not followed by automatic alignment.
-.Pu ".long \fIexpression [, expression]*\fP"
-Initialize a sequence of longs (4-byte values).
-This is not followed by automatic alignment.
-.Pu ".word \fIexpression [, expression]*\fP"
-Initialize a sequence of words. The number of bytes occupied by
-a word depends on the target machine.
-This is not followed by automatic alignment.
-.Pu ".ascii \fIstring\fP"
-Initialize a sequence of bytes with the value of the bytes in
-the string.
-This is not followed by automatic alignment.
-.Pu ".asciz \fIstring\fP"
-Initialize a sequence of bytes with the value of the bytes in
-the string and terminate this with an extra zero byte.
-This is not followed by automatic alignment.
-.Pu ".align [\fIexpression\fP]"
-Adjust the current position to a multiple of the value of the
-expression.
-The default is the word-size of the target machine.
-.Pu ".space \fIexpression\fP"
-Allocate the indicated amount of bytes.
-The expression must be absolute.
-.Pu ".org \fIexpression\fP"
-Start an org segment with the location counter at the indicated
-value.
-The value of the expression must be absolute.
-.Pu ".text"
-.Pu ".data"
-.Pu ".bss"
-Start an segment of the indicated type.
-.Pu ".base \fIexpresssion\fP"
-Set the starting address of the first of the consecutive segments
-(text) to the value of the expression.
-The expression must be absolute.
-.Pu ".errnz \fIexpression\fP"
-Stop with a fatal error message when the value of the
-expression is non-zero.
-.SH "SEE ALSO"
-ack(I), arch(I), a.out(V)
-.SH "EXAMPLE"
-An example of INtel 8086 assembly code.
-.sp 2
-.nf
-.ta 8 16 32 40 48 56 64
- .define begbss
- .define hol0,.diverr,.reghp
- .define EIDIVZ
-
- EIDIVZ = 6
-
- base = 0x01C0
- topmem = 0xFFF0
-
- .org topmem-16
- .extern __n_line
- maxmem:
- __n_line:
- .space 16
- .errnz __n_line-0xFFE0
-
- .base base
-
- .text
- cld
- xor ax,ax
- mov (2),cs
- mov (0),.diverr
- mov sp,maxmem
- mov di,begbss
- mov cx,[[endbss-begbss]/2]&0x7FFF
- ! xor ax,ax ! ax still is 0
- rep stos
- mov ax,1
- push ax
- call _start
- 3:
- jmp 3b
- .diverr:
- push ax
- mov ax,EIDIVZ
- call .error
- pop ax
- iret
- cmp 0,4(bx)(di) ! just to show this addr. mode
-
- .data
- begdata:
- hol0:
- .word 0,0
- .word 0,0
- .word 3f
- .reghp:
- .word endbss
- 3:
- .asciz "PROGRAM"
- .sp 3
-.fi
-.SH DIAGNOSTICS
-Various diagnostics may be produced.
-The most likely errors, however, are unresolved references,
-probably caused by the omission of a library argument.
-.SH BUGS
-The resulting a.out file contains no information about the size
-and starting address of the segments.
-.br
-The resulting a.out file does not contain a symbol table.
-.br
-The alignment might give rise to internal assertion errors when
-the alignment requestes is larger than the machine dependent
-segment alignment.
-.br
-Identifiers declared as externals cannot be used as locals in
-any following module.
+++ /dev/null
-.TH Z8000_AS 1
-.ad
-.SH NAME
-z8000_as \- assembler for Zilog z8000 (segmented version)
-.SH SYNOPSIS
-/usr/em/lib/z8000_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP instructions
-Instruction mnemonics are implemented exactly as described in
-`Z8000 PLZ/ASM Assembly Language Programming Manual' and
-`AmZ8001/2 Processor Instruction Set'.
-.IP registers
-The z8000 has sixteen 16-bit general purpose registers specified
-as R0 through R15. All sixteen registers can be used as accumulators.
-In addition to this, fifteen of the sixteen registers may be used
-in addressing mode calculations as either indirect, index or
-base-address registers. Because the instruction format encoding
-uses the value zero to differentiate between various addressing
-modes, register R0 (or the register pair RR0) cannot be used as an
-indirect, index or base-address register.
-It is also possible to address registers as groups of 8, 32 or 64 bits.
-These registers are specified as follows.
-.nf
-.ta 8 16 24 32 40 48
-- RH0, RL0, RH1, RL1, ..., RH7, RL7 for 8-bit regis-
- ters. (`H' stands for high-order byte, and `L' stands
- for low-order byte within a word register). These
- registers overlap 16-bit registers R0 through R7.
-- RR0, RR2, ..., RR14 for 32-bit register pairs.
-- RQ0, RQ4, RQ8 and RQ12 for 64-bit register quadruples.
-.fi
-Besides register pair RR14 is used as stackpointer.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning (name-mnemonic)
-
-$expr the value of expr is the operand.
- (immediate-IM)
-
-reg contents of register reg is operand. Any
- register as described above is allowed.
- (register-R)
-
-*reg32 contents of register pair reg32 is add-
- ress of operand. Any register pair can
- be used except RR0.
- (indirect register-IR)
-
-expr expr is address of operand.
- (direct address-DA)
-
-expr(reg16) value of expr + contents of word regis-
- ter reg16 yields address of operand.
- Any word register can be used except R0.
- (indexed address-X)
-
-expr expr is address of operand. This mode
- is implied by its instruction. It is
- only used by CALR, DJNZ, JR, LDAR and
- LDR and is the only mode available to
- these instructions. In fact this mode
- differs not from the mode DA.
- (relative address-RA)
-
-reg32($expr) contents of register pair reg32 + value
- of expr yields address of operand. Any
- register pair can be used except RR0.
- (based address-BA)
-
-reg32(reg16) contents of register pair reg32 + con-
- tents of word register reg16 yields
- address of operand. Any register pair/
- word register can be used except RR0/R0.
- (based indexed address-BX)
-
-.fi
-.IP "segmented addresses"
-Segmented addresses require 23 bits, 7 bits for the segment number
-and 16 bits for the offset within a segment.
-So segment 0 contains addresses 0-FFFF, segment 1 contains addresses
-10000-1FFFF, and so on.
-.br
-Assembler syntax of addresses and immediate data is as described above
-(modes IM, DA and X).
-Thus the assembler treats e.g. address 2BC0F as an address in segment 2
-with offset BC0F within the segment.
-There is also an explicit way to express this using the, more unusual,
-syntax <<segment>>offset.
-.br
-There are two internal representations of segmented addresses
-depending on the size of the offset. If the offset fits into 8 bits
-the address is stored in one word (the low-order byte containing
-the offset, bits 8 to 14 containing the segment number and
-bit 15 containing a zero) otherwise the address is stored in two
-words (the lower word containing the offset, the upper word as
-before but bit 15 containing 1 indicating that the offset is in
-the next word).
-This is important for instructions which has an operand of mode DA
-or X.
-.IP "extended branches"
-When the target address in a relative jump/call (JR/CALR)
-does not fit into the instruction format, the assembler generates
-a corresponding `normal' jump/call (JP/CALL).
-.SH EXAMPLE
-An example of z8000 assembly code.
-.nf
-.ta 8 16 24 32 40 48
-
-! This z8000 assembly routine converts a positive number
-!(in R1) to a string representing the number and puts this
-!string into a buffer (R3 contains the starting address of
-!this buffer. The base is in R4 determining %x, %d or %o.
-
-convert:
- exts RR0 !sign-extend R1
- div RR0, R4 !divide by the base
- test R1 !R1 contains the quotient
- jr EQ, 5f
- !if quotient is 0 convert is ready
- !else push remainder onto the stack
- push *RR14, R0
- calr convert !and again...
- pop R0, *RR14
-5: add R0, $060 !add `0'
- cp R0, $071 !compare to `9'
- jr LE, 8f
- add R0, $7 !in case of %x `A'-`F'
-8: ldb 0(R3), RL0 !put character into buffer
- inc R3
- ret
-
-.fi
-.SH "SEE ALSO"
-uni_ass(6).
-.br
-ack(1).
-.br
-Z8000 PLZ/ASM Assembly Language Programming Manual, april 1979.
-.br
-AmZ8001/2 Processor Instruction Set, 1979.
-.SH BUGS
-You cannot use (reg16) instead of 0(reg16).
-.br
-Condition codes `Z' (meaning zero), `C' (meaning carry) and <nothing>
-(meaning always false) are not implemented.
-The first two because they also represent flags and the third one
-because it's useless.
-So for `Z'/`C' use `EQ'/`ULT'.
-.br
-The z8000 assembly instruction set as described in the book
-`AmZ8001/2 Processor Instruction Set' differs from the one
-described in the manual `Z8000 PLZ/ASM Assembly Language Programming
-Manual' in that the book includes CLRL, LDL (format F5.1) and
-PUSHL (format F5.1) which all in fact do not (!) work.
-.br
-On the other side the book excludes SIN, SIND, SINDR, SINI, SINIR,
-SOUT, SOUTD, SOTDR, SOUTI and SOTIR.
-Whether these instructions do work as described in the manual has not
-been tested yet.
+++ /dev/null
-.\" $Header$
-.TH z80_AS 1
-.ad
-.SH NAME
-z80_as \- assembler for Zilog z80
-.SH SYNOPSIS
-/usr/em/lib/z80_as [options] argument ...
-.SH DESCRIPTION
-This assembler is made with the general framework
-described in \fIuni_ass\fP(6).
-.SH SYNTAX
-.IP registers
-The z80 has six general-purpose 8-bit registers: b, c, d, e, h, l;
-an 8-bit accumulator: a; an 8-bit flag register: f; an 8-bit interrupt
-vector: i; an 8-bit memory refresh register: r; two 16-bit index registers:
-ix, iy; a 16-bit stack pointer: sp; and a 16-bit program counter: pc.
-The general-purpose registers can be paired to form three registers pairs of
-16 bits each: bc, de, hl.
-An alternate set of registers is provided that duplicates the accumulator,
-the flag register, and the general-purpose registers. The "exx"-instruction
-exchanges the contents of the two sets of general-purpose registers; the
-contents of the accumulator and flag register can be exchanged with the contents
-of their alternates by the "ex af, af2"-instruction.
-.IP "addressing modes"
-.nf
-.ta 8 16 24 32 40 48
-syntax meaning
-
-expr dependent on the instruction, the
- value of `expr' can be immediate
- data or the address of the operand.
- There is no special notation for
- immediate data.
-
-(ireg + expr)
-(ireg - expr) the contents of ireg (which must be
- one of the index-registers) + or -
- the - one byte - value of `expr'
- yield the address of the operand.
-
-(expr) the value of `expr' is the address of
- the operand.
-
-reg the contents of `reg' - one of the above-
- mentioned registers - is the operand.
-
-(reg) the contents of `reg' - one of the 16-bit
- registers except pc - is the address of
- the operand.
-
-nz, z, nc, c,
-po, pe, p, m the letters indicate a condition-code:
- nonzero, zero, carry, no carry,
- parity odd, parity even, sign positive,
- sign negative respectively. Used by conditional
- jump, call, and return instructions.
-
-.fi
-.IP instructions
-The jr-instruction will automatically be replaced by a jp-instruction if the
-target is too remote.
-.SH "SEE ALSO"
-uni_ass(6),
-ack(1),
-.br
-Z80 Users Manual, Joseph J. Carr, Reston Publishing Company, 1980
+++ /dev/null
-.\" $Header$
-.TH LLGEN 1
-.SH NAME
-LLgen, an extended LL(1) parser generator
-.SH SYNOPSIS
-\fBLLgen\fP
-[
-\fB\-vVxXfF\fP
-]
-file ...
-.SH DESCRIPTION
-\fILLgen\fP
-converts a context-free grammar into a set of
-functions which form a recursive descent parser with no backtrack.
-The grammar may be ambiguous;
-ambiguities can be broken by user specifications.
-.PP
-\fILLgen\fP
-reads each
-\fIfile\fP
-in sequence.
-Together, these files must constitute a context-free grammar.
-For each file,
-\fILLgen\fP
-generates an output file, which must be compiled by the
-C-compiler.
-In addition, it generates the files
-\fILpars.c\fP
-and
-\fILpars.h.\fP
-\fILpars.h\fP
-contains the
-\fIdefine\fP
-statements that associate the
-\fILLgen\fP-assigned `token-codes' with user declared `token-names'.
-This allows other source files, for instance the source file
-containing the lexical analyzer,
-to access the token-codes by
-using the token-names.
-\fILpars.c\fP
-contains the error recovery routines and tables. It must also
-be compiled by the C-compiler.
-.PP
-\fILLgen\fP
-will only update those output files that differ from their previous
-version.
-This allows
-\fILLgen\fP
-to be used with
-\fImake\fP
-(I) convieniently.
-.PP
-To obtain a working program, the user must also supply a
-lexical analyzer, as well as
-\fImain\fP
-and
-\fILLmessage\fP,
-an error reporting routine;
-\fILex\fP
-(I) is a useful program for creating lexical analysers usable
-by
-\fILLgen\fP.
-.PP
-If the
-\fB\-v\fP
-or the
-\fB\-V\fP
-flag is given, the file
-\fILL.output\fP
-is prepared, which contains a description of the conflicts that
-were not resolved.
-If it is given more than once,
-\fILLgen\fP
-will be more "verbose".
-If it is given three times, a complete description of the
-grammar will be supplied.
-.PP
-If the
-\fB\-x\fP
-or the
-\fB\-X\fP
-flag is given,
-the sets that are computed are extended with the nonterminal
-symbols and these extended sets are also included in the
-\fILL.output\fP
-file.
-.PP
-If the
-\fB\-f\fP
-or the
-\fB\-F\fP
-flag is given,
-\fILLgen\fP generates code, that enables the C-compiler to generate jump-
-tables for switches. This option should only be used when a large address
-space is available.
-.SH FILES
-LL.output verbose output file
-.br
-Lpars.c the error recovery routines
-.br
-Lpars.h defines for token names
-.SH "SEE ALSO"
-\fIlex\fP (I)
-.br
-\fImake\fP (I)
-.br
-\fILLgen, an Extended LL(1) Parser Generator\fP
-by C.J.H. Jacobs.
-.SH DIAGNOSTICS
-Are intended to be self-explanatory. They are reported
-on standard error. A more detailed report is found in the
-\fILL.output\fP
-file.
-.SH BUGS
-Because some file names are fixed, at most one
-\fILLgen\fP
-process can be active in a given directory at
-a time.
-.SH AUTHOR
-Ceriel J. H. Jacobs
+++ /dev/null
-# $Header$
-INSTALLDIR=../../bin
-LIBDIR=../../lib/LLgen
-
-all: cmp
-
-clean:
- -cd src; make clean
-
-install:
- cd src; make
- cp src/LLgen $(INSTALLDIR)/LLgen
- cp lib/rec $(LIBDIR)/rec
- cp lib/incl $(LIBDIR)/incl
-
-cmp:
- cd src; make
- -cmp src/LLgen $(INSTALLDIR)/LLgen
- -cmp lib/rec $(LIBDIR)/rec
- -cmp lib/incl $(LIBDIR)/incl
-
-distr:
- cd src; make distr
-
-opr:
- make pr | opr
-
-pr:
- @cd src; make pr
- @cd lib; make pr
+++ /dev/null
-$Header$
-
-To install LLgen, proceed as follows:
-
-- create a directory to put the libraryfiles in, f.i.
- /usr/local/lib/LLgen
-- cd to the src directory
-- adapt the file machdep.c, should be easy
-- adapt the Makefile, changing the options to the C-compiler if
- necessary.
-- change back to this directory
-- edit the Makefile. LIBDIR should be set to the directory for the
- library files, INSTALLDIR should be set to the directory where LLgen
- is to be put.
-- now type
- make install
-- This should do all the work.
-
-LLgen.1 contains a man-page.
+++ /dev/null
-/* $Header$ */
-
-#define LLin(x) (LLsets[(x)+LLi]&LLb)
-
-extern short *LLptr;
-extern char LLsets[];
-extern int LLi, LLb;
-extern int LLsymb;
-extern int LLcsymb;
-extern int LLscd;
-
-# include "Lpars.h"
+++ /dev/null
-/*
- * Some grammar independent code.
- * This file is copied into Lpars.c.
- */
-
-# ifndef NORCSID
-static char *rcsid = "$Header$";
-# endif
-
-#define LLSTSIZ 1024
-static short LLstack[LLSTSIZ]; /* Recovery stack */
-short * LLptr; /* ptr in it */
-#define LLmax (&LLstack[LLSTSIZ-1]) /* if beyond this, overflow */
-int LLscd; /* lookahead done or not? */
-int LLb,LLi;
-int LLsymb;
-int LLcsymb;
-static int LLlevel;
-static short * LLbase;
-
-static struct LLsaved {
- int LLs_i, LLs_b, LLs_s, LLs_c, LLs_t;
- short *LLs_p, *LLs_x;
-} LLsaved[LL_MAX];
-
-/* In this file are defined: */
-extern LLcheck();
-extern LLscan();
-extern LLpush();
-extern LLlpush();
-extern int LLpop();
-extern int LLsskip();
-static LLerror();
-extern LLnewlevel();
-extern LLoldlevel();
-
-LLcheck() {
- register c;
- /*
- * The symbol to be checked is on the stack.
- */
- if (!LLscd) {
- if ((c = LL_LEXI()) <= 0) c = EOFILE;
- LLsymb = c;
- }
- else LLscd = 0;
- if (LLsymb == *--LLptr) return;
- /*
- * If we come here, an error has been detected.
- * LLpop will try and recover
- */
- LLptr++;
- while (LLindex[LLsymb] < 0) {
- LLerror(0);
- if ((LLsymb = LL_LEXI()) <= 0) LLsymb = EOFILE;
- }
- LLcsymb = LLindex[LLsymb];
- LLb = LLbyte[LLcsymb];
- LLi = LLcsymb>>3;
- LLscd = 1;
- if (!LLpop()) LLerror(*LLptr);
- LLscd = 0;
-}
-
-LLscan(t) {
- /*
- * Check if the next symbol is equal to the parameter
- */
- if (!LLscd) {
- if ((LLsymb = LL_LEXI()) <= 0) LLsymb = EOFILE;
- }
- else LLscd = 0;
- if (LLsymb == t) return;
- /*
- * If we come here, an error has been detected
- */
- LLpush(t);
- LLscd = 1;
- while (LLindex[LLsymb] < 0) {
- LLerror(0);
- if ((LLsymb = LL_LEXI()) <= 0) LLsymb = EOFILE;
- }
- LLcsymb = LLindex[LLsymb];
- LLb = LLbyte[LLcsymb];
- LLi = LLcsymb>>3;
- if (!LLpop()) LLerror(t);
- LLscd = 0;
-}
-
-LLpush(t) {
- if (LLptr == LLmax) {
- LLerror(-1);
- }
- *LLptr++ = t;
-}
-
-LLlpush(d) {
- register i;
- register short *p;
-
- p = &LLlists[d];
- i = *p++;
- while(i--) {
- if (LLptr == LLmax) {
- LLerror(-1);
- }
- *LLptr++ = *p++;
- }
-}
-
-LLsskip() {
- /*
- * Error recovery, and not only that!
- * Skip symbols until one is found that is on the stack.
- * Return 1 if it is on top of the stack
- */
- register short *t;
- register i;
-
- for (;;) {
- if (!LLscd) {
-lab:
- if ((i = LL_LEXI()) <= 0) i = EOFILE;
- LLsymb = i;
- if ((i = LLindex[i]) < 0) {
- LLerror(0);
- goto lab;
- /*
- * Ugly, but we want speed
- * on possibly correct symbols !!
- * So, no breaks out of "for (;;)"
- */
- }
- LLcsymb = i;
- LLb = LLbyte[i];
- LLi = (i>>3);
- LLscd = 1;
- }
- t = LLptr-1;
- i = *t;
- if (!((i<=0 && LLsets[LLi-i]&LLb)||i==LLsymb)) {
- while (--t >= LLbase) {
- /*
- * If the element on the stack is negative,
- * its opposite is an index in the setarray,
- * otherwise it is a terminal symbol
- */
- i = *t;
- if ((i<=0&&LLsets[LLi-i]&LLb)||i==LLsymb){
- break;
- }
- }
- if (t >= LLbase) break;
- LLerror(0);
- LLscd = 0;
- }
- else {
- return 1;
- }
- }
- return t == LLptr - 1;
-}
-
-LLpop() {
- register i;
-
- i = LLsskip();
- LLptr--;
- return i;
-}
-
-static
-LLerror(d) {
-
- LLmessage(d);
- if (d < 0) exit(1);
-}
-
-LLnewlevel() {
- register struct LLsaved *p;
-
- if (!LLlevel++) {
- LLptr = LLstack;
- LLbase = LLstack;
- LLpush(EOFILE);
- }
- else {
- if (LLlevel > LL_MAX) LLerror(-1);
- p = &LLsaved[LLlevel - 2];
- p->LLs_p = LLptr;
- p->LLs_i = LLi;
- p->LLs_b = LLb;
- p->LLs_s = LLsymb;
- p->LLs_t = LLcsymb;
- p->LLs_c = LLscd;
- p->LLs_x = LLbase;
- LLbase = LLptr;
- LLpush(EOFILE);
- }
-}
-
-LLoldlevel() {
- register struct LLsaved *p;
-
- LLcheck();
- if (--LLlevel) {
- p = &LLsaved[LLlevel-1];
- LLptr = p->LLs_p;
- LLi = p->LLs_i;
- LLb = p->LLs_b;
- LLsymb = p->LLs_s;
- LLcsymb = p->LLs_t;
- LLbase = p->LLs_x;
- LLscd = p->LLs_c;
- }
-}
-
+++ /dev/null
-# $Header$
-PROF=
-LLOPT=-vvv -x
-CFLAGS=$(PROF) -O -DNDEBUG # -R
-LDFLAGS=-i
-OBJECTS = main.o gencode.o compute.o LLgen.o tokens.o check.o reach.o global.o name.o sets.o Lpars.o alloc.o machdep.o
-CFILES = main.c gencode.c compute.c LLgen.c tokens.c check.c reach.c global.c name.c sets.c Lpars.c alloc.c machdep.c
-FILES =types.h tunable.h extern.h io.h sets.h assert.h tokens.g LLgen.g main.c name.c compute.c sets.c gencode.c global.c check.c reach.c alloc.c machdep.c Makefile
-GFILES = tokens.g LLgen.g
-LINT = lint -b -DNDEBUG -DNORCSID
-
-all:
- @make parser "LLOPT=$(LLOPT)"
- @make LLgen "LDFLAGS=$(LDFLAGS)" "CC=$(CC)" "PROF=$(PROF)" "CFLAGS=$(CFLAGS)"
-
-parser: $(GFILES)
- LLgen $(LLOPT) $(GFILES)
- @touch parser
-
-LLgen: $(OBJECTS)
- $(CC) $(PROF) $(LDFLAGS) $(OBJECTS) -o LLgen
- @size LLgen
-
-pr :
- @pr $(FILES) ../lib/rec ../lib/incl
-
-lint:
- $(LINT) $(CFILES)
-
-clean:
- -rm -f *.o LL.temp LL.xxx LL.output LLgen
-
-distr:
- -rm -f parser
- make parser
-
-# The next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO
-LLgen.o: Lpars.h
-LLgen.o: assert.h
-LLgen.o: extern.h
-LLgen.o: io.h
-LLgen.o: tunable.h
-LLgen.o: types.h
-Lpars.o: Lpars.h
-alloc.o: extern.h
-alloc.o: types.h
-check.o: assert.h
-check.o: extern.h
-check.o: io.h
-check.o: sets.h
-check.o: tunable.h
-check.o: types.h
-compute.o: assert.h
-compute.o: extern.h
-compute.o: io.h
-compute.o: sets.h
-compute.o: tunable.h
-compute.o: types.h
-gencode.o: assert.h
-gencode.o: extern.h
-gencode.o: io.h
-gencode.o: sets.h
-gencode.o: tunable.h
-gencode.o: types.h
-global.o: io.h
-global.o: tunable.h
-global.o: types.h
-machdep.o: ../../../h/em_path.h
-machdep.o: types.h
-main.o: assert.h
-main.o: extern.h
-main.o: io.h
-main.o: sets.h
-main.o: types.h
-name.o: assert.h
-name.o: extern.h
-name.o: io.h
-name.o: tunable.h
-name.o: types.h
-reach.o: assert.h
-reach.o: extern.h
-reach.o: io.h
-reach.o: tunable.h
-reach.o: types.h
-sets.o: assert.h
-sets.o: extern.h
-sets.o: sets.h
-sets.o: types.h
-tokens.o: Lpars.h
-tokens.o: assert.h
-tokens.o: extern.h
-tokens.o: io.h
-tokens.o: tunable.h
-tokens.o: types.h
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * alloc.c
- * Interface to malloc() and realloc()
- */
-
-# include "types.h"
-# include "extern.h"
-
-# ifndef NORCSID
-static string rcsida = "$Header$";
-# endif
-
-static string e_nomem = "Out of memory";
-
-p_mem
-alloc(size) unsigned size; {
- register p_mem p;
- p_mem malloc();
-
- if ((p = malloc(size)) == 0) fatal(linecount,e_nomem);
- return p;
-}
-
-p_mem
-ralloc(p,size) p_mem p; unsigned size; {
- register p_mem q;
- p_mem realloc();
-
- if ((q = realloc(p,size)) == 0) fatal(linecount,e_nomem);
- return q;
-}
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * assert.h $Header$
- * an assertion macro
- */
-
-#ifndef NDEBUG
-#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__)
-#else
-#define assert(x) /* nothing */
-#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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * extern.h $Header$
- * Miscellanious constants and
- * some variables that are visible in more than one file
- */
-
-/*
- * options for the identifier search routine
- */
-# define JUSTLOOKING 0
-# define ENTERING 1
-# define BOTH 2
-
-/*
- * Now for some declarations
- */
-
-extern char ltext[]; /* input buffer */
-extern int nnonterms; /* number of nonterminals */
-extern int nterminals; /* number of terminals */
-extern p_start start; /* will contain startsymbols */
-extern int linecount; /* line number */
-extern int assval; /* to create difference between literals
- * and other terminals
- */
-extern t_nont nonterms[]; /* the nonterminal array */
-extern p_nont maxnt; /* is filled up until here */
-extern int order[]; /* order of nonterminals in the grammar,
- * important because actions are copied to
- * a temporary file in the order in which they
- * were read
- */
-extern int *maxorder; /* will contain &order[nnonterms] */
-extern t_entry h_entry[]; /* terminal and nonterminal entrys,
- * first NTERMINAL entrys reserved
- * for terminals
- */
-extern p_entry max_t_ent; /* will contain &h_entry[nterminals] */
-# define min_nt_ent &h_entry[NTERMINALS]
-extern string pentry[]; /* pointers to various allocated things */
-extern string e_noopen; /* Error message string used often */
-extern int verbose; /* Level of verbosity */
-extern string lexical; /* name of lexical analyser */
-extern int ntneeded; /* ntneeded = 1 if nonterminals are included
- * in the sets.
- */
-extern int ntprint; /* ntprint = 1 if they must be printed too in
- * the LL.output file (-x option)
- */
-# ifndef NDEBUG
-extern int debug;
-# endif not NDEBUG
-extern p_file files,pfile; /* pointers to file structure.
- * "files" points to the start of the
- * list */
-extern string LLgenid; /* LLgen identification string */
-extern t_token lextoken; /* the current token */
-extern int nerrors;
-extern int fflag; /* Enable compiler to generate jump tables
- * for switches?
- */
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * global.c
- * Contains declarations visible in several other source files
- */
-
-# include "types.h"
-# include "io.h"
-# include "tunable.h"
-
-# ifndef NORCSID
-static string rcsid4 = "$Header$";
-# endif
-
-char ltext[LTEXTSZ];
-t_entry h_entry[NTERMINALS+NNONTERMS+1];
-p_entry max_t_ent;
-t_nont nonterms[NNONTERMS+1];
-int nnonterms;
-int nterminals;
-int order[NNONTERMS+1];
-int *maxorder;
-p_start start;
-int linecount;
-int assval;
-string pentry[ENTSIZ];
-FILE *fout;
-FILE *fpars;
-FILE *finput;
-FILE *fact;
-p_nont maxnt;
-string f_pars = PARSERFILE;
-string f_out = OUTFILE;
-string f_temp = ACTFILE;
-string f_input;
-string e_noopen = "Cannot open %s";
-int verbose;
-string lexical;
-int ntneeded;
-int ntprint;
-# ifndef NDEBUG
-int debug;
-# endif not NDEBUG
-p_file files;
-p_file pfile;
-string LLgenid = "/* LLgen generated code from source %s */\n";
-t_token lextoken;
-int nerrors;
-int fflag;
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * io.h $Header$
- * Some important file names and variables
- */
-
-# include <stdio.h>
-# include <ctype.h>
-
-/* FILES */
-
-# define OUTFILE "LL.output" /* -v option */
-# define PARSERFILE "LL.xxx" /* This is what we want */
-# define ACTFILE "LL.temp" /* temporary file to save actions */
-# define HFILE "Lpars.h" /* file for "#define's " */
-# define RFILE "Lpars.c" /* Error recovery */
-
-extern FILE *finput;
-extern FILE *fpars;
-extern FILE *fact;
-extern FILE *fout;
-extern string f_pars;
-extern string f_temp;
-extern string f_out;
-extern string f_input;
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * machdep.c
- * Machine dependant things
- */
-
-
-# include "../../../h/em_path.h"
-# include "types.h"
-
-# ifndef NORCSID
-static string rcsid5 = "$Header$";
-# endif
-
-/* In this file the following routines are defined: */
-extern UNLINK();
-extern RENAME();
-extern string libpath();
-
-UNLINK(x) string x; {
- /* Must remove the file "x" */
-
- unlink(x); /* systemcall to remove file */
-}
-
-RENAME(x,y) string x,y; {
- /* Must move the file "x" to the file "y" */
-
- unlink(y);
- if(link(x,y)!=0)fatal(1,"Cannot link to %s",y);
- unlink(x);
-}
-
-string
-libpath(s) string s; {
- /* Must deliver a full pathname to the library file "s" */
-
- register string p;
- register length;
- p_mem alloc();
- string strcpy(), strcat();
- static string subdir = "/lib/LLgen/";
-
- length = strlen(EM_DIR) + strlen(subdir) + strlen(s) + 1;
- p = (string) alloc((unsigned) length);
- strcpy(p,EM_DIR);
- strcat(p,subdir);
- strcat(p,s);
- 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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * main.c
- * Contains main program, and some error message routines
- */
-
-# include "types.h"
-# include "io.h"
-# include "extern.h"
-# include "sets.h"
-# include "assert.h"
-
-# ifndef NORCSID
-static string rcsid6 = "$Header$";
-# endif
-
-static string rec_file;
-static string incl_file;
-
-/* In this file the following routines are defined: */
-extern int main();
-STATIC readgrammar();
-extern error();
-extern fatal();
-extern comfatal();
-extern copyfile();
-extern install();
-# ifndef NDEBUG
-extern badassertion();
-# endif not NDEBUG
-
-main(argc,argv) register string argv[]; {
- register string arg;
- string libpath();
- int nflag = 0;
-
- /* Initialize */
-
- maxorder = order;
- assval = 0400;
- /* read options */
-
- while (argc >= 2 && (arg = argv[1], *arg == '-')) {
- while (*++arg) {
- switch(*arg) {
- case 'v':
- case 'V':
- verbose++;
- continue;
- case 'n':
- case 'N':
- nflag++;
- continue;
- case 'f':
- case 'F':
- fflag++;
- continue;
-# ifndef NDEBUG
- case 'a':
- case 'A':
- debug++;
- continue;
-# endif not NDEBUG
- case 'r':
- case 'R':
- if (rec_file) {
- fprintf(stderr,"duplicate -r flag\n");
- exit(1);
- }
- rec_file = ++arg;
- break;
- case 'i':
- case 'I':
- if (incl_file) {
- fprintf(stderr,"duplicate -i flag\n");
- exit(1);
- }
- incl_file = ++arg;
- break;
- case 'x':
- case 'X':
- ntneeded = 1;
- ntprint = 1;
- continue;
- default:
- fprintf(stderr,"illegal option : %c\n",*arg);
- return 1;
- }
- break;
- }
- argv++;
- argc--;
- }
- /*
- * Now check wether the sets should include nonterminals
- */
- if (verbose == 2) ntneeded = 1;
- else if (! verbose) ntneeded = 0;
- /*
- * Initialise
- */
- if (!rec_file) rec_file = libpath("rec");
- if (!incl_file) incl_file = libpath("incl");
- if ((fact = fopen(f_temp,"w")) == NULL) {
- fputs("Cannot create temporary\n",stderr);
- return 1;
- }
- name_init();
- readgrammar(argc,argv);
- if (nflag) comfatal();
- setinit(ntneeded);
- maxnt = &nonterms[nnonterms];
- max_t_ent = &h_entry[nterminals];
- fclose(fact);
- /*
- * Now, the grammar is read. Do some computations
- */
- co_reach(); /* Check for undefined and unreachable */
- if (nerrors) comfatal();
- createsets();
- co_empty(); /* Which nonterminals produce empty? */
- co_first(); /* Computes first sets */
- co_follow(); /* Computes follow sets */
- co_symb(); /* Computes choice sets in alternations */
- conflchecks(); /* Checks for conflicts etc, and also
- * takes care of LL.output etc
- */
- if (nerrors) comfatal();
- co_contains(); /* Computes the contains sets */
- co_safes(); /* Computes safe terms and nonterminals.
- * Safe means : always called with a terminal
- * symbol that is guarantied to be eaten by
- * the term
- */
- if (argc-- == 1) {
- fputs("No code generation for input from standard input\n",stderr);
- } else gencode(argc);
- UNLINK(f_temp);
- UNLINK(f_pars);
- return 0;
-}
-
-STATIC
-readgrammar(argc,argv) char *argv[]; {
- /*
- * Do just what the name suggests : read the grammar
- */
- register p_file p;
- p_mem alloc();
-
- linecount = 0;
- f_input = "no filename";
- /*
- * Build the file structure
- */
- files = p = (p_file) alloc((unsigned) (argc+1) * sizeof(t_file));
- if (argc-- == 1) {
- finput = stdin;
- p->f_name = f_input = "standard input";
- p->f_firsts = 0;
- p->f_start = maxorder;
- pfile = p;
- LLparse();
- p->f_end = maxorder - 1;
- p++;
- } else {
- while (argc--) {
- if ((finput = fopen(f_input=argv[1],"r")) == NULL) {
- fatal(0,e_noopen,f_input);
- }
- linecount = 0;
- p->f_name = f_input;
- p->f_start = maxorder;
- p->f_firsts = 0;
- pfile = p;
- LLparse();
- p->f_end = maxorder-1;
- p++;
- argv++;
- fclose(finput);
- }
- }
- p->f_start = maxorder+1;
- p->f_end = maxorder;
- if (! lexical) lexical = "yylex";
- /*
- * There must be a start symbol!
- */
- if (start == 0) {
- fatal(linecount,"Missing %%start");
- }
- if (nerrors) comfatal();
-}
-
-/* VARARGS1 */
-error(lineno,s,t,u) string s,t,u; {
- /*
- * Just an error message
- */
- register FILE *f;
-
- f = stderr;
- ++nerrors;
- if (lineno) fprintf(f,"\"%s\", line %d : ",f_input,lineno);
- else fprintf(f,"\"%s\" : ",f_input);
- fprintf(f,s,t,u);
- putc('\n',f);
-}
-
-/* VARARGS1 */
-fatal(lineno,s,t,u) string s,t,u; {
- /*
- * Fatal error
- */
- error(lineno,s,t,u);
- comfatal();
-}
-
-comfatal() {
- /*
- * Some common code for exit on errors
- */
- if (fact != NULL) {
- fclose(fact);
- UNLINK(f_temp);
- }
- if (fpars != NULL) fclose(fpars);
- UNLINK(f_pars);
- exit(1);
-}
-
-copyfile(n) {
- /*
- * Copies a file indicated by the parameter to filedescriptor fpars.
- * If n != 0, the error recovery routines are copied,
- * otherwise a standard header is.
- */
- register c;
- register FILE *f;
-
- if ((f = fopen(n?rec_file:incl_file,"r")) == NULL) {
- fatal(0,"Cannot open libraryfile, call an expert");
- }
- while ((c = getc(f)) != EOF) putc(c,fpars);
- fclose(f);
-}
-
-install(target, source) string target, source; {
- /*
- * Copy the temporary file generated from source to target
- * if allowed (which means that the target must be generated
- * by LLgen from the source, or that the target is not present
- */
- register c;
- register FILE *f1;
- register FILE *f2;
- register string s1;
- register int i;
- char buf[100];
-
- /*
- * First open temporary, generated for source
- */
- if ((f1 = fopen(f_pars,"r")) == NULL) {
- fatal(0,e_noopen,f_pars);
- }
- i = 0;
- /*
- * Now open target for reading
- */
- if ((f2 = fopen(target,"r")) == NULL) {
- i = 1;
- fclose(f1);
- }
- else {
- /*
- * Create string recognised by LLgen. The target must
- * start with that!
- */
- (int) sprintf(buf,LLgenid,source ? source : ".");
- s1 = buf;
- while (*s1 != '\0' && *s1++ == getc(f2)) { /* nothing */ }
- /*
- * Ai,ai, it did not
- */
- if (*s1 != '\0') {
- fatal(0,"%s : not a file generated by LLgen",target);
- }
- rewind(f2);
- /*
- * Now compare the target with the temporary
- */
- while ((c = getc(f1)) != EOF && c == getc(f2)) { /* nothing */}
- if (c != EOF || getc(f2) != EOF) i = 1;
- fclose(f1);
- fclose(f2);
- }
- /*
- * Here, if i != 0 the target must be recreated
- */
- if (i) RENAME(f_pars,target);
-}
-
-#ifndef NDEBUG
-badassertion(asstr,file,line) char *asstr, *file; {
-
- fprintf(stderr,"Assertion \"%s\" failed %s(%d)\n",asstr,file,line);
- if (fact != NULL) fclose(fact);
- if (fpars != NULL) fclose(fpars);
- abort();
-}
-#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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * name.c
- * Defines the symboltable search routine and an initialising routine
- */
-
-# include "types.h"
-# include "tunable.h"
-# include "extern.h"
-# include "assert.h"
-# include "io.h"
-
-# ifndef NORCSID
-static string rcsid7 = "$Header$";
-# endif
-
-# define HASHSIZE 128
-
-static char name[NAMESZ]; /* space for names */
-static int iname; /* index in nametable */
-static p_entry h_root[HASHSIZE]; /* hash table */
-static string e_literal = "Illegal literal";
-
-/* Defined in this file are: */
-extern string store();
-extern name_init();
-STATIC int hash();
-extern t_gram search();
-
-string
-store(s) register string s; {
- /*
- * Store a string s in the name table
- */
- register string t,u;
-
- u = t = &name[iname];
- do { if (u > &name[NAMESZ-1]) fatal(linecount,"name table overflow");
- else *u++ = *s;
- } while (*s++);
- iname = u - name;
- return t;
-}
-
-name_init() {
- /*
- * Initialise hash-table and enter special terminal EOFILE
- */
- register p_entry *p;
- t_gram search();
-
- for(p = h_root; p<= &h_root[HASHSIZE-1]; p++) *p = 0;
- search(TERMINAL,"EOFILE",ENTERING);
-}
-
-STATIC int
-hash(str) string str; {
- /*
- * Compute the hash for string str
- */
- register i;
- register string l;
-
- l = str;
- i = 0;
- while (*l != '\0') i += *l++ & 0377;
- i += l - str;
- return i % HASHSIZE;
-}
-
-t_gram
-search(type,str,option) register string str; {
- /*
- * Search for object str.
- * It has type UNKNOWN, LITERAL, TERMINAL or NONTERM.
- * option can be ENTERING, JUSTLOOKING or BOTH.
- */
- register int val;
- register p_entry p;
- t_gram r;
- register int i;
-
- g_init(&r);
- g_setcont(&r,UNDEFINED);
- r.g_lineno = linecount;
- i = hash(str);
- /*
- * Walk hash chain
- */
- for (p = h_root[i]; p != (p_entry) 0; p = p->h_next) {
- if(!strcmp(p->h_name,str)) {
- val = p - h_entry;
- if (type == LITERAL &&
- (val >= NTERMINALS || p->h_num >= 0400)) continue;
- if (val>=NTERMINALS) {
- /* Should be a nonterminal */
- if (type == TERMINAL) {
- error(linecount,
- "%s : terminal expected",
- str);
- }
- g_settype(&r,NONTERM);
- g_setnont(&r,val - NTERMINALS);
- } else {
- if (type != LITERAL && p->h_num < 0400) {
- continue;
- }
- if (type == NONTERM) {
- error(linecount,
- "%s : nonterminal expected",
- str);
- continue;
- }
- g_setnont(&r, val);
- g_settype(&r, TERMINAL);
- }
- if (option==ENTERING) {
- error(linecount,
- "%s : already defined",str);
- }
- return r;
- }
- }
- if (option == JUSTLOOKING) return r;
- if (type == TERMINAL || type == LITERAL) {
- if (nterminals == NTERMINALS) {
- fatal(linecount,"too many terminals");
- }
- p = &h_entry[nterminals];
- } else {
- /*
- * type == NONTERM || type == UNKNOWN
- * UNKNOWN and not yet declared means : NONTERM
- */
- if (nnonterms == NNONTERMS) {
- fatal(linecount,"too many nonterminals");
- }
- p = &h_entry[NTERMINALS+nnonterms];
- }
- p->h_name = store(str);
- p->h_next = h_root[i];
- h_root[i] = p;
- if (type == NONTERM || type == UNKNOWN) {
- register p_nont q;
-
- q = &nonterms[nnonterms];
- q->n_rule = 0;
- q->n_lineno = linecount;
- q->n_string = f_input;
- q->n_follow = 0;
- q->n_flags = 0;
- q->n_contains = 0;
- p->h_num = 0;
- g_settype(&r, NONTERM);
- g_setnont(&r, nnonterms);
- nnonterms++;
- return r;
- }
- if (type == LITERAL) {
- if (str[0] == '\\') {
- /*
- * Handle escapes in literals
- */
- if (str[2] == '\0') {
- switch(str[1]) {
- case 'n' :
- val = '\n';
- break;
- case 'r' :
- val = '\r';
- break;
- case 'b' :
- val = '\b';
- break;
- case 'f' :
- val = '\f';
- break;
- case 't' :
- val = '\t';
- break;
- case '\'':
- val = '\'';
- break;
- case '\\':
- val = '\\';
- break;
- default :
- error(linecount,e_literal);
- }
- } else {
- /*
- * Here, str[2] != '\0'
- */
- if (str[1] > '3' || str[1] < '0' ||
- str[2] > '7' || str[2] < '0' ||
- str[3] > '7' || str[3] < '0' ||
- str[4] != '\0') error(linecount,e_literal);
- val = 64*str[1] - 73*'0' + 8*str[2] + str[3];
- }
- } else {
- /*
- * No escape in literal
- */
- if (str[1] == '\0') val = str[0];
- else error(linecount,e_literal);
- }
- p->h_num = val;
- } else {
- /*
- * Here, type = TERMINAL
- */
- p->h_num = assval++;
- }
- g_settype(&r, TERMINAL);
- g_setnont(&r, nterminals);
- nterminals++;
- return r;
-}
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * reach.c
- * Determine which nonterminals are reachable, and also check that they
- * are all defined.
- */
-
-# include "tunable.h"
-# include "types.h"
-# include "extern.h"
-# include "io.h"
-# include "assert.h"
-
-# ifndef NORCSID
-static string rcsid8 = "$Header$";
-# endif
-
-/* In this file the following routines are defined: */
-extern co_reach();
-STATIC reachable();
-STATIC reachwalk();
-
-co_reach() {
- /*
- * Check for undefined or unreachable nonterminals.
- * An undefined nonterminal is a fatal error!
- */
- register p_nont p;
- register p_start st;
- register p_file x = files;
- register int *s;
-
- /* Check for undefined nonterminals */
- for (p = nonterms; p < maxnt; p++) {
- if (! p->n_rule) {
- f_input = p->n_string;
- error(p->n_lineno,"nonterminal %s not defined",
- (min_nt_ent + (p - nonterms))->h_name);
- }
- }
- /*
- * Walk the grammar rules, starting with the startsymbols
- * Mark the nonterminals that are encountered with the flag
- * REACHABLE, and walk their rules, if not done before
- */
- for (st = start; st; st = st->ff_next) reachable(st->ff_nont);
- /*
- * Now check for unreachable nonterminals
- */
- for (; x->f_end < maxorder; x++) {
- f_input = x->f_name;
- for (s = x->f_start; s <= x->f_end; s++) {
- p = &nonterms[*s];
- if (! (p->n_flags & REACHABLE)) {
- error(p->n_lineno,"nonterminal %s unreachable",
- (min_nt_ent + (p - nonterms))->h_name);
- }
- }
- }
-}
-
-STATIC
-reachable(p) register p_nont p; {
- /*
- * Enter the fact that p is reachable, and look for implications
- */
- if (! (p->n_flags & REACHABLE)) {
- p->n_flags |= REACHABLE;
- /*
- * Now walk its grammar rule
- */
- if (p->n_rule) reachwalk(p->n_rule);
- }
-}
-
-STATIC
-reachwalk(p) register p_gram p; {
- /*
- * Walk through rule p, looking for nonterminals.
- * The nonterminals found are entered as reachable
- */
-
- for (;;) {
- switch(g_gettype(p)) {
- case ALTERNATION :
- reachwalk(((p_link) pentry[g_getcont(p)])->l_rule);
- break;
- case TERM :
- reachwalk(((p_term) pentry[g_getcont(p)])->t_rule);
- break;
- case NONTERM :
- reachable(&nonterms[g_getnont(p)]);
- break;
- case EORULE :
- 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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * sets.h $Header$
- * Some macros that deal with bitsets and their size
- */
-
-# define BITS (8 * sizeof (int))
-# define IN(a,i) ((a)[(i)/BITS] & (1<<((i) % BITS)))
-# define NTIN(a,i) ((a)[((i)+tbitset)/BITS]&(1<<((i)%BITS)))
-# define PUTIN(a,i) ((a)[(i)/BITS] |=(1<<((i) % BITS)))
-# define NTPUTIN(a,i) ((a)[((i)+tbitset)/BITS]|=(1<<((i)%BITS)))
-# define NBYTES(n) (((n) + 7) / 8)
-/*
- * The next two macros operate on byte counts!
- */
-# define NINTS(n) (((n) + (int) (sizeof(int) - 1)) / (int) sizeof(int))
-# define ALIGN(n) (NINTS(n) * (int) sizeof (int))
-
-extern int tbitset;
-extern p_set *setptr,*maxptr,*topptr;
-extern int tsetsize,setsize;
+++ /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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * tokens.g
- * Defines the tokens for the grammar of LLgen.
- * The lexical analyser and LLmes are also included here.
- */
-
-{
-# include "types.h"
-# include "io.h"
-# include "tunable.h"
-# include "extern.h"
-# include "assert.h"
-
-# ifndef NORCSID
-static string rcsidc = "$Header$";
-# endif
-
-/* Here are defined : */
-extern int scanner();
-extern LLmessage();
-extern int input();
-extern unput();
-extern skipcomment();
-STATIC linedirective();
-STATIC string cpy();
-STATIC string vallookup();
-}
-
-/* Classes */
-
-%token C_IDENT ; /* lextoken.t_string contains the identifier read */
-%token C_NUMBER ; /* lextoken.t_num contains the number read */
-%token C_LITERAL ; /* lextoken.t_string contains the literal read */
-
-/* Keywords */
-
-%token C_TOKEN ;
-%token C_START ;
-%token C_IF ;
-%token C_WHILE ;
-%token C_PERSISTENT ;
-%token C_FIRST ;
-%token C_LEXICAL ;
-%token C_AVOID ;
-%token C_PREFER ;
-%token C_DEFAULT ;
-
-%lexical scanner ;
-
-{
-
-/*
- * Structure for a keyword
- */
-
-struct keyword {
- string w_word;
- int w_value;
-};
-
-/*
- * The list of keywords, the most often used keywords come first.
- * Linear search is used, as there are not many keywords
- */
-
-static struct keyword resword[] = {
- { "token", C_TOKEN },
- { "avoid", C_AVOID },
- { "prefer", C_PREFER },
- { "persistent", C_PERSISTENT },
- { "default", C_DEFAULT },
- { "if", C_IF },
- { "while", C_WHILE },
- { "first", C_FIRST },
- { "start", C_START },
- { "lexical", C_LEXICAL },
- { 0, 0 }
-};
-
-static t_token savedtok; /* to save lextoken in case of an insertion */
-static int nostartline; /* = 0 if at the start of a line */
-
-scanner() {
- /*
- * Lexical analyser, what else
- */
- register ch; /* Current char */
- register i;
- register reserved = 0; /* reserved word? */
- int last; /* Char before current char */
-
- if (savedtok.t_tokno) { /*
- * A token has been inserted.
- * Now deliver the last lextoken again
- */
- lextoken = savedtok;
- savedtok.t_tokno = 0;
- return lextoken.t_tokno;
- }
- for (;;) { /*
- * First, skip space, comments, line directives, etc
- */
- do ch = input();
- while(isspace(ch));
- if (ch == '/') skipcomment(0);
- else if (ch == '#' && !nostartline) linedirective();
- else break;
- }
- /*
- * Now we have a first character of a token
- */
- switch(ch) {
- case EOF :
- return EOF;
- case '\'': /*
- * Literal, put it in ltext
- */
- i = 0;
- for (;;) {
- last = ch;
- ch = input();
- if (ch == '\n' || ch == EOF) {
- error(linecount,"missing '");
- break;
- }
- if (ch == '\'' && last != '\\') break;
- ltext[i] = ch;
- if (i < LTEXTSZ - 1) ++i;
- }
- ltext[i] = '\0';
- lextoken.t_string = ltext;
- return C_LITERAL;
- case '%' : /*
- * Start of a reserved word
- */
- reserved = 1;
- ch = input();
- /* Fall through */
- default :
- i = 0;
- if (isdigit(ch)) {
- if (reserved) {
- error(linecount," A reserved number ?");
- }
- while (isdigit(ch)) {
- i = 10 * i + (ch - '0');
- ch= input();
- }
- lextoken.t_num = i;
- unput(ch);
- return C_NUMBER;
- }
- if (isalpha(ch) || ch == '_') {
- do {
- if (reserved && isupper(ch)) ch += 'a' - 'A';
- ltext[i] = ch;
- if (i < LTEXTSZ - 1) ++i;
- ch = input();
- } while (isalnum(ch) || ch == '_');
- } else return ch;
- unput(ch);
- }
- ltext[i] = '\0';
- if (reserved) { /*
- * Now search for the keyword
- */
- register struct keyword *w;
-
- w = resword;
- while (w->w_word) {
- if (! strcmp(ltext,w->w_word)) {
- /*
- * Found it. Return token number.
- */
- return w->w_value;
- }
- w++;
- }
- error(linecount,"illegal reserved word");
- }
- lextoken.t_string = ltext;
- return C_IDENT;
-}
-
-static int backupc; /* for unput() */
-static int nonline; /* = 1 if last char read was a newline */
-
-input() {
- /*
- * Low level input routine, used by all other input routines
- */
- register c;
- register FILE *f;
-
- if(backupc) { /*
- * Last char was "unput()". Deliver it again
- */
- c = backupc;
- backupc = 0;
- return c;
- }
- f = finput;
- if ((c = getc(f)) == EOF) return c;
- nostartline = 1;
- if (!nonline) {
- linecount++;
- nostartline = 0;
- nonline = 1;
- }
- if (c == '\n') nonline = 0;
- return c;
-}
-
-unput(c) {
- /*
- * "unread" c
- */
- backupc = c;
-}
-
-skipcomment(flag) {
- /*
- * Skip comment. If flag != 0, the comment is inside a fragment
- * of C-code, so the newlines in it must be copied to enable the
- * C-compiler to keep a correct line count
- */
- register ch;
- int saved; /* line count on which comment starts */
-
- saved = linecount;
- if (input() != '*') error(linecount,"illegal comment");
- ch = input();
- while (ch != EOF) {
- if (flag && ch == '\n') putc(ch,fact);
- while (ch == '*') {
- if ((ch = input()) == '/') return;
- if (flag && ch == '\n') putc(ch,fact);
- }
- ch = input();
- }
- error(saved,"Comment does not terminate");
-}
-
-STATIC
-linedirective() {
- /*
- * Read a line directive
- */
- register ch;
- register i;
- string s_error = "Illegal line directive";
- string store();
- register string c;
-
- do { /*
- * Skip to next digit
- * Do not skip newlines
- */
- ch = input();
- } while (ch != '\n' && ! isdigit(ch));
- if (ch == '\n') {
- error(linecount,s_error);
- return;
- }
- i = ch - '0';
- ch = input();
- while (isdigit(ch)) {
- i = i*10 + (ch - '0');
- ch = input();
- }
- while (ch != '\n' && ch != '"') ch = input();
- if (ch == '"') {
- c = ltext;
- do {
- *c++ = ch = input();
- } while (ch != '"' && ch != '\n');
- if (ch == '\n') {
- error(linecount,s_error);
- return;
- }
- *--c = '\0';
- do {
- ch = input();
- } while (ch != '\n');
- /*
- * Remember the file name
- */
- if (strcmp(f_input,ltext)) f_input = store(ltext);
- }
- linecount = i;
-}
-
-STATIC string
-vallookup(s) {
- /*
- * Look up the keyword that has token number s
- */
- register struct keyword *p = resword;
-
- while (p->w_value) {
- if (p->w_value == s) return p->w_word;
- p++;
- }
- return 0;
-}
-
-STATIC string
-cpy(s,p,flag) register s; register string p; {
- /*
- * Create a piece of error message for token s and put it at p.
- * flag = 0 if the token s was deleted (in which case we have
- * attributes), else it was inserted
- */
- register string t = 0;
-
- switch(s) {
- case C_IDENT :
- if (!flag) t = lextoken.t_string;
- else t = "identifier";
- break;
- case C_NUMBER :
- t = "number";
- break;
- case C_LITERAL :
- if (!flag) {
- *p++ = '"';
- *p++ = '\'';
- t = lextoken.t_string;
- break;
- }
- t = "literal";
- break;
- case EOFILE :
- t = "endoffile";
- break;
- }
- if (!t) {
- t = vallookup(s);
- if (t) {
- *p++ = '%';
- }
- }
- if (t) { /*
- * We have a string for the token. Copy it
- */
- while (*t) *p++ = *t++;
- if (s == C_LITERAL && !flag) {
- *p++ = '\'';
- *p++ = '"';
- }
- return p;
- }
- /*
- * The token is a literal
- */
- *p++ = '\'';
- if (s >= 040 && s <= 0176) *p++ = s;
- else switch(s) {
- case '\b' : *p++ = '\\'; *p++ = 'b'; break;
- case '\f' : *p++ = '\\'; *p++ = 'f'; break;
- case '\n' : *p++ = '\\'; *p++ = 'n'; break;
- case '\r' : *p++ = '\\'; *p++ = 'r'; break;
- case '\t' : *p++ = '\\'; *p++ = 't'; break;
- default : *p++='0'+((s&0377)>>6); *p++='0'+((s>>3)&07);
- *p++='0'+(s&07);
- }
- *p++ = '\'';
- return p;
-}
-
-LLmessage(d) {
- /*
- * d is either 0, in which case the current token has been deleted,
- * or non-zero, in which case it represents a token that is inserted
- * before the current token
- */
- register string s,t;
- char buf[128];
-
- nerrors++;
- s = buf;
- if (d == 0) {
- s = cpy(LLsymb,s,0);
- t = " deleted";
- do *s++ = *t; while (*t++);
- } else {
- s = cpy(d,s,1);
- t = " inserted in front of ";
- do *s++ = *t++; while (*t);
- s = cpy(LLsymb,s,0);
- *s = '\0';
- }
- error(linecount,buf);
- if (d) { /*
- * Save the current token and make up some
- * attributes for the inserted token
- */
- savedtok = lextoken;
- savedtok.t_tokno = LLsymb;
- if (d == C_IDENT) lextoken.t_string = "dummy_identifier";
- else if (d == C_LITERAL) lextoken.t_string = "dummy_literal";
- else if (d == C_NUMBER) lextoken.t_num = 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
- *
- */
-
-/*
- * L L G E N
- *
- * An Extended LL(1) Parser Generator
- *
- * Author : Ceriel J.H. Jacobs
- */
-
-/*
- * tunable.h $Header$
- * Tunable constants
- */
-
-# define NNONTERMS 150 /* size of nonterminal array */
-# define NTERMINALS 150 /* size of terminal array */
-# define NAMESZ 3000 /* size of name table */
-# define LTEXTSZ 51 /* size of token */
-# define ENTSIZ 900 /* size of entry table, max 8191 */
+++ /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
-# $Header$
-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
-.\" $Header$
-.TH ACK I
-.ad
-.SH NAME
-ack \- Amsterdam Compiler Kit
-.SH SYNOPSIS
-\fBack\fP arguments
-.br
-\fBacc\fP arguments
-.br
-\fBapc\fP arguments
-.br
-\fImachine\fP arguments
-.SH DESCRIPTION
-This program transforms sources in several
-languages to load files for a variety of machines,
-internally using several phases.
-The transformation can be stopped at any phase.
-Combining sources from several languages is allowed.
-The run-time system of the first language mentioned,
-either in the program call name or in the arguments,
-is automatically included.
-The libraries of all other languages mentioned,
-containing most of the run-time systems,
-are also automatically included.
-Two types of load files can be distinguished,
-\fIa.out\fP files containing machine code and \fIe.out\fP
-files containing virtual EM machine code.
-The last type is designed for interpretation.
-Compilation time for interpretation is fast and gives many
-runtime checks,
-but execution is about seven times slower.
-Which combinations of languages and machines are allowed varies
-in time and depends on the installation.
-.PP
-The actions of \fIack\fP are to repeatedly transform files with a
-particular suffix into files with another suffix,
-finally combining the results into a load file.
-.PP
-\fIAck\fP recognizes the following suffixes:
-.IP .p
-Pascal program.
-.IP .c
-C module.
-.IP .e
-EM assembly module in human readable form.
-.IP .k
-Compact EM assembly code.
-.IP .m
-Optimized compact EM assembly code.
-.IP .s
-Machine assembly language code.
-.IP .o
-Object file.
-.PP
-\fIAck\fP accepts the following flags:
-.IP \-m\fImachine\fP
-This flag tells \fIack\fP to generate a load file for \fImachine\fP.
-\fIMachine\fP can also be used as the program call
-name, instead of \fIack\fP.
-e.g. \fIack \-m8086 file.p\fP is equivalent to \fI8086
-file.p\fP.
-.IP \-o
-The the next argument as the name of the resulting load file,
-instead of the default \fIa.out\fP or \fIe.out\fP.
-.IP \-O
-Use the EM peephole optimizer,
-this flag is superfluous when an machine code is generated.
-.IP \-LIB
-This flag tells the peephole optimizer
-.RF em_opt VI
-to add information about the visibility of the names used
-to each output module.
-This is needed by most
-assembler/linkers when these modules are to be inserted
-in libraries.
-.IP \-l\fIname\fP
-Tells \fIack\fP to insert a library module at this point.
-For example: the library \fImon\fP contains the
-routines for systems calls needed by both C and Pascal.
-.IP \-r.\fIsuffix\fP
-Most frontends and backends use one or
-more run-time libraries.
-These flags tell \fIack\fP to include the libraries needed when
-a file with \fIsuffix\fP would be included in the arguments.
-.IP \-L
-Disable the generation of code by the front ends to
-record line number and source file name at run-time.
-.IP \-p
-This flag tells both the Pascal and C front ends to include
-code enabling the user to do some monitoring/debugging.
-Each time a routine is entered the routine \fBprocentry\fP
-is called and just before each return \fBprocexit\fP is called.
-These routines are supplied with one parameter, a pointer
-to a string containing the name of the routine.
-.IP \-w
-Suppress all warning messages.
-.IP \-v
-Verbose.
-Print information while juggling with files.
-.IP \-g
-Try to run the resulting load file.
-No arguments can be passed this way,
-so it is only useful in simple cases.
-.IP \-I\fIdir\fP
-\&\`#include\' files whose names do not begin with \`/\' are
-always sought first in the directory of the \fIfile\fP argument,
-then in the directories named in \fB\-I\fP options,
-then in directories on a standard list.
-.IP \-D\fIname=def\fP
-.IP \-D\fIname\fP
-Define the \fIname\fP to the preprocessor,
-as if by \`#define\'.
-If no definition is given the \fIname\fP is defined as 1.
-.IP \-U\fIname\fP
-Remove any initial definition of \fIname\fP, before
-preprocessing.
-.IP \-c\fI.suffix\fP
-.IP \-c
-\fIAck\fP tries to transform each source into a file with the \fIsuffix\fP.
-When no \fIsuffix\fP is specified \fIack\fP stops just
-before the phase where it combines all arguments into a load file,
-thereby transforming the sources into \fI.k\fP, \fI.s\fP,
-\&\fI.o\fP or \fI.m\fP files.
-One extra \fIsuffix\fP is recognized here, \fI.i\fP,
-this tells \fIack\fP to only preprocess all human readable sources,
-producing files with \fIsuffix\fP \fI.i\fP.
-Note: \fIack\fP refuses to overwrite argument \fI.e\fP files.
-.IP \-t
-Preserve all intermediate files.
-.IP \-k
-Do not stop when an error occurs, but try to transform all
-other arguments as far as possible.
-.IP \-R\fIprogram=xxx\fP
-Replace the \fIprogram\fP by the pathname \fIxxx\fP.
-The program names referred to later in this manual are allowed here.
-.IP \-R\fIprogram\-xxx\fP
-The flag argument \fI\-xxx\fP is given to \fIprogram\fP.
-.IP \-E
-Produce a complete listing of each Pascal source program.
-Normally for each error, one message,
-including the source line number, is given.
-.IP \-e
-List only the erroneous lines of each Pascal source program.
-.IP \-{xxx}
-The string starting after \`{\' and terminated by a \`}\' is passed
-as an option string to the Pascal compiler and supersedes corresponding
-options given in the source file.
-See the ACK reference manual [4] for a list of options.
-.IP "\-+xxx, \-\-xxx"
-When you want to interpret your program, you may select some
-options during interpretation, like test, profile, flow, extra and count.
-A short description of these flags follows:
-.RS
-.IP " t(est)" 12
-test for undefined, overflow, array bound etc.
-.IP " f(low)"
-keep track of executed source lines.
-.IP " c(ount)"
-count the number of times a source line is executed.
-.IP " p(rofile)"
-count the memory cycles executed per source line.
-.RE
-.IP "" 5
-Test is on by default, the others are off. Normally, you give these
-flag options each time you run the interpreter.
-The EM assembler/linker gives you the opportunity to change
-the defaults per program.
-The changed options are recorded in the "e.out" header.
-These flags \-\- and \-+ are passed to the assembler for this purpose.
-So, \-\-t and \-+pfce invert the defaults.
-.IP \-.\fIsuffix\fP
-When linking multiple \fI.o\fP or \fI.m\fP files created by
-separate calls of \fIack\fP together, \fIack\fP cannot deduce
-the run-time system needed,
-unless called as \fIapc\fP or \fIacc\fP.
-This flag serves to tell \fIack\fP which runtime system is
-needed in such a case.
-For example: "ack \-c x.c ; ack \-.c x.o".
-.PP
-All arguments without a suffix or with an unrecognized suffix
-are passed to the loaders, as for flags.
-.SH PREPROCESSOR
-All C source programs are run through the preprocessor
-before they are fed to the compiler proper.
-Other human readable sources (Pascal programs and
-machine assembly) are only preprocessed when they start with a \`#\'.
-.PP
-\fIAck\fP adds a few macro definitions when it calls the
-preprocessor.
-These macro\'s contain the word- and pointer-size and the sizes
-of some basic types used by the Pascal and/or C compiler.
-All sizes are in bytes.
-.PP
-.TS
-tab(:);
-l l l l.
-EM_WSIZE:wordsize:EM_PSIZE:pointer size
-EM_SSIZE:size of shorts (C):EM_LSIZE:size of longs (C+Pascal)
-EM_FSIZE:size of floats (C):EM_DSIZE:size of doubles (C+Pascal)
-.TE
-.PP
-The name of the \fImachine\fP or something like it when
-the machine name is numeric is also defined (as 1).
-.SH PROGRAMS
-\fIAck\fP uses one or more programs in each phase of the
-transformation.
-The table below gives the names \fIack\fP uses for these
-programs.
-Internally \fIack\fP maintains a mapping of these names to pathnames
-for load files.
-The table specifies which type of files are accepted by each
-program as input and the file type produced as output.
-.TS
-tab(:);
-l l l l.
-input:name:output:description
-\&.c:cem:.k:C front end [4,5,6]
-\&.p:pc:.k:Pascal front end [2,3,6]
-\&.e:encode:.k:Compactify EM assembly language [1]
-\&.k:opt:.m:EM peephole optimizer
-\&.k .m:decode:.e:Produce human readable EM assembly
-\&.k .m:emass:e.out:Linker producing EM machine code [1]
-\&.m:be:.s:backend
-\&.s:asld:a.out:Assembler/linker producing machine code
-\&.s:as:.o:Assembler
-\&.o:ld:a.out:Linker producing machine code
-.TE
-.SH "SEE ALSO"
-.PD 0
-em_opt(VI), em_ass(VI), em_cg(VI)
-.IP [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson "Description of a machine architecture for use with
-block structured languages" Informatica report IR-81.
-.IP [2]
-K. Jensen and N. Wirth
-"PASCAL, User manual and report" Springer Verlag.
-.IP [3]
-The ISO Pascal standard proposal ISO/TC97/SC5-N462.
-.IP [4]
-B.W. Kernighan and D.M. Ritchie, \fIThe C Programming
-language\fP, Prentice-Hall, 1978
-.IP [5]
-D.M. Ritchie, \fI C Reference Manual\fP
-.IP [6]
-E.G. Keizer, Amsterdam Compiler Kit, reference manuals and UNIX manual pages.
-.PD
-.SH DIAGNOSTICS
-.PD
-The diagnostics are intended to be self\-explanatory.
-.SH BUGS
-The -g flag is inoperative.
-.br
-Not all warning messages are superseded by \fB\-w\fP.
-.br
-Argument assembly files are not preprocessed when fed into the
-universal assembler.
-.SH AUTHOR
-Ed Keizer, Vrije Universiteit, Amsterdam
+++ /dev/null
-#ifndef NORCSID
-#define RCS_ACK "$Header$"
-#endif
-
-/****************************************************************************/
-/* User settable options */
-/****************************************************************************/
-
-#define FRONTENDS "fe" /* The front-end definitions */
-#define TMPNAME "Ack%04x" /* Naming of 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 ;
-
-#define p_cont(elem) ((path *)l_content(elem))
-
-/* 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 int getpid();
-extern int unlink();
-extern int close();
-extern int open();
-extern int creat();
-
-/* Own routines */
-enum f_path getpath();
-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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#undef EXTERN
-#define EXTERN
-
-#include "data.h"
-
-#ifndef NORCSID
-static char rcs_data[] = RCS_DATA ;
-#endif
+++ /dev/null
-#ifndef NORCSID
-#define RCS_DATA "$Header$"
-#endif
-
-EXTERN char *stopsuffix; /* Suffix to stop at */
-EXTERN char *machine; /* The machine id */
-EXTERN char *callname; /* argv[0] */
-EXTERN char *rts; /* The runtime-system id */
-
-EXTERN list_head arguments; /* List of arguments */
-EXTERN list_head flags; /* List of flags */
-
-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 print 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[20]; /* The template for temporary file
- names */
-
-EXTERN trf *linker; /* Pointer to the Loader/Linker */
-EXTERN trf *cpp_trafo; /* Pointer to C-preprocessor */
-
-EXTERN path in; /* The current single 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 */
-/* */
-/***************************************************************/
-
-#ifndef NORCSID
-#define RCS_DMACH "$Header$"
-#endif
-
-
-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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-char *add_u(part,ptr) char *ptr ; {
- if ( part>=26 ) {
- ptr=add_u(part/26-1,ptr) ;
- }
- *ptr= part%26 + 'a' ;
- return ptr+1 ;
-}
-
-char *unique() {
- /* Get the next unique part of the internal filename */
- static int u_next = 0 ;
- static char buf[10] ;
- register char *ptr ;
-
- ptr=add_u(u_next,buf) ;
- *ptr=0 ;
- u_next++ ;
- return buf ;
-}
-
-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 ;
- static int out_used= 0 ;
-
- if ( !phase->t_next && !phase->t_isprep && outfile ) {
- if ( out_used ) {
- fuerror("only one output file allowed when using the -o flag") ;
- } else {
- if ( !phase->t_keep ) fatal("Removing result file") ;
- phase->t_outfile=outfile ;
- out_used++ ;
- }
- }
- if ( phase->t_combine ) {
- in.p_path= (char *)0 ;
- in.p_keep=YES ;
- in.p_keeps=NO ;
- }
- if ( phase->t_outfile && phase->t_keep ) {
- out.p_path=phase->t_outfile ;
- out.p_keeps=NO ;
- out.p_keep=YES ;
- } else {
- gr_init(&pathname) ;
- if ( !phase->t_keep && !t_flag ) {
- gr_cat(&pathname,TMP_DIR) ;
- gr_cat(&pathname,"/") ;
- gr_cat(&pathname,template) ;
- gr_cat(&pathname,unique()) ;
- out.p_keep=NO ;
- } else {
- if ( !p_basename ) {
- gr_cat(&pathname,"Ack") ;
- gr_cat(&pathname,unique()) ;
- p_basename=keeps(gr_start(pathname)) ;
- werror("Output written on %s%s",
- p_basename,phase->t_out) ;
- } 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 %s",out.p_path) ;
- return 0 ;
- }
- }
- return 1 ;
-}
-
-disc_files(phase) trf *phase ; {
- path temp ;
-
- if ( !phase->t_combine ) {
- file_final(&in) ;
- } else {
- disc_inputs(phase) ;
- }
- temp=in ; in=out ; out=temp ;
-}
-
-file_final(file) path *file ; {
- if ( file->p_path ) {
- if ( !file->p_keep && t_flag<=1 ) {
- if ( unlink(file->p_path)!=0 ) {
- werror("couldn't unlink %s",file->p_path);
- }
- }
- if ( file->p_keeps ) throws(file->p_path) ;
- }
- file->p_path= (char *)0 ;
- file->p_keeps=NO ;
- file->p_keep=NO ;
-}
-
-disc_inputs(phase) trf *phase ; {
- /* Remove all the input files of this phase */
- /* Only for combiners */
- register path *l_in ;
- register list_elem *elem ;
- scanlist( l_first(phase->t_inputs), elem) {
- l_in= p_cont(*elem) ;
- file_final(l_in) ;
- freecore(l_in) ;
- }
- l_clear(&phase->t_inputs) ;
-}
-
-rmfile(file) path *file ; {
- /* Remove a file, do not complain when is does not exist */
- if ( file->p_path ) {
- if ( t_flag<=1 ) unlink(file->p_path) ;
- if ( file->p_keeps ) throws(file->p_path) ;
- file->p_path= (char *)0 ;
- file->p_keeps=NO ;
- file->p_keep=NO ;
- }
-}
-
-rmtemps() {
- /* Called in case of disaster, always remove the current output file!
- */
- register list_elem *elem ;
-
- if ( t_flag>1 ) return ;
- rmfile(&out) ;
- file_final(&in) ;
- scanlist(l_first(tr_list),elem) {
- if ( t_cont(*elem)->t_combine && t_cont(*elem)->t_do ) {
- disc_inputs(t_cont(*elem)) ;
- }
- }
-}
-
-add_input(file,phase) path *file ; trf *phase ; {
- register path *store ;
-#ifdef DEBUG
- if ( debug ) {
- vprint("Adding %s to inputs of %s\n",
- file->p_path,phase->t_name) ;
- }
-#endif
- phase->t_do=YES ;
- if ( !phase->t_origname && orig.p_path[0]!='-' ) {
- /* This entry decides the name of the result */
- phase->t_origname= orig.p_path ;
- }
- store= (path *) getcore(sizeof (path)) ;
- *store = *file ;
- l_add(&phase->t_inputs,(char *)store) ;
- /* The task of getting rid of the string is passed to 'phase',
- as is the task to get rid of the file itself.
- */
- file->p_keeps=NO ; file->p_keep=YES ;
-}
+++ /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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_grows[] = RCS_GROWS ;
-#endif
-
-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
-#ifndef NORCSID
-#define RCS_GROWS "$Header$"
-#endif
-
-/* 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_list[] = RCS_LIST ;
-#endif
-
-/* 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_throw(header) Delete a list of strings.
- 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
-#ifndef NORCSID
-#define RCS_LIST "$Header$"
-#endif
-
-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>
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_ack[] = RCS_ACK ;
-#endif
-
-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 ;
- register trf *phase ;
-
- progname=argv[0];
- varinit();
- vieuwargs(argc,argv);
- if ( (frontend=getenv("ACKFE")) ) {
- setlist(frontend) ;
- } else {
- setlist(FRONTENDS);
- }
- if ( callname ) {
- if ( machine ) {
- fuerror("can not produce code for both %s and %s",
- callname,machine) ;
- }
- machine= callname ;
- }
- if ( !machine && ! (machine=getenv("ACKM")) ) {
-#ifdef ACKM
- machine= ACKM; /* The default machine */
-#else
- fuerror("No machine specified") ;
-#endif
- }
- setlist(machine);
- /* Find the linker, needed for argument building */
- scanlist(l_first(tr_list),elem) {
- if ( t_cont(*elem)->t_linker ) {
- linker= t_cont(*elem) ;
- }
- }
- transini();
- scanneeds();
- sprintf(template,TMPNAME,getpid()) ;
- 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 ( !rts ) rts="" ;
- setsvar(keeps(RTS),rts) ;
- if ( linker ) getmapflags(linker) ;
-
- scanlist(l_first(tr_list),elem) {
- phase=t_cont(*elem) ;
- if ( phase->t_combine && phase->t_do ) {
- if ( phase->t_blocked ) {
-#ifdef DEBUG
- if ( debug ) {
- vprint("phase %s is blocked\n",
- phase->t_name) ;
- }
-#endif
- disc_inputs(phase) ;
- continue ;
- }
- orig.p_keep=YES ;
- orig.p_keeps=NO ;
- orig.p_path=phase->t_origname ;
- if ( p_basename ) throws(p_basename) ;
- if ( orig.p_path ) {
- p_basename= keeps(basename(orig.p_path)) ;
- } else {
- p_basename=0 ;
- }
- if ( !startrf(phase) && !k_flag ) return 1 ;
- }
- }
-
- if ( n_error ) return n_error ;
-
- if ( g_flag ) {
- return do_run();
- }
-
- return 0 ;
-}
-
-char *srcvar() {
- return orig.p_path ;
-}
-
-varinit() {
- /* initialize the string variables */
- register char *envstr ;
-
- if ( envstr=getenv("EM_DIR") ) {
- setsvar(keeps(HOME),keeps(envstr)) ;
- } else {
- 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 ;
- int hide ;
-
- 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 */
- hide=NO ; /* Do not hide this flags to the phases */
- 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++] ;
- hide=YES ;
- break ;
- case 'O': Optflag++ ;
- break ;
- case 'v': if ( argp[2] ) {
- v_flag += atoi(&argp[2]) ;
- eaten=1 ;
- } else {
- v_flag++ ;
- }
-#ifdef DEBUG
- if ( v_flag>=3 ) debug=v_flag-2 ;
-#endif
- 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': 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 ) {
- if ( strcmp(rts,&argp[1])!=0 )
- fuerror("Two run-time systems?") ;
- } else {
- rts= &argp[1] ;
- keephead(rts) ; keeptail(rts) ;
- }
- eaten=1 ;
- break ;
- case 0 : nill_flag++ ; eaten++ ;
- hide=YES ;
- break;
- case 'w': w_flag++;
- 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 ;
- hide=YES ;
- }
- if ( !hide ) {
- register char *tokeep ;
- tokeep=keeps(argp) ;
- if ( argp[1]=='R' ) {
- do_Rflag(tokeep);
- } else {
- *tokeep |= NO_SCAN ;
- }
- l_add(&flags,tokeep) ;
- }
- if ( argp[2] && !eaten ) {
- werror("Unexpected characters at end of %s",argp) ;
- }
- }
- return ;
-}
-
-firstarg(argp) register char *argp ; {
- register char *name ;
-
- name=rindex(argp,'/') ;
- if ( name && *(name+1) ) {
- name++ ;
- } else {
- name= argp ;
- }
- callname= name;
-}
-
-/************************* argument processing ***********************/
-
-process(arg) char *arg ; {
- /* Process files & library arguments */
- trf *phase ;
- register trf *tmp ;
-
-#ifdef DEBUG
- if ( debug ) vprint("Processing %s\n",arg) ;
-#endif
- p_suffix= rindex(arg,SUFCHAR) ;
- orig.p_keep= YES ; /* Don't throw away the original ! */
- orig.p_keeps= NO;
- orig.p_path= arg ;
- if ( arg[0]=='-' || !p_suffix ) {
- if ( linker ) add_input(&orig,linker) ;
- return 1 ;
- }
- if ( p_basename ) throws(p_basename) ;
- p_basename= keeps(basename(arg)) ;
- /* Try to find a path through the transformations */
- switch( getpath(&phase) ) {
- case F_NOPATH :
- error("Cannot produce the desired file from %s",arg) ;
- if ( linker ) add_input(&orig,linker) ;
- return 1 ;
- case F_NOMATCH :
- if ( stopsuffix ) werror("Unknown suffix in %s",arg) ;
- if ( linker ) add_input(&orig,linker) ;
- return 1 ;
- case F_OK :
- break ;
- }
- if ( !phase ) return 1 ;
- for ( tmp=phase ; tmp ; tmp=tmp->t_next )
- if ( !tmp->t_visited ) {
- /* The flags are set up once.
- At the first time each phase is in a list.
- The program name and flags may already be touched
- by vieuwargs.
- */
- tmp->t_visited=YES ;
- if ( tmp->t_priority<0 )
- werror("Using phase %s (negative priority)",
- tmp->t_name) ;
- if ( !rts && tmp->t_rts ) rts= tmp->t_rts ;
- if ( tmp->t_needed ) {
- add_head(tmp->t_needed) ;
- add_tail(tmp->t_needed) ;
- }
- }
- if ( phase->t_combine ) {
- add_input(&orig,phase) ;
- return 1 ;
- }
- in= orig ;
- if ( !nill_flag ) {
- printf("%s\n",arg) ;
- }
- return startrf(phase) ;
-}
-
-int startrf(first) trf *first ; {
- /* Start the transformations at the indicated phase */
- register trf *phase ;
-
- phase=first ;
- for(;;) {
- switch ( phase->t_prep ) {
- /* BEWARE, sign extension */
- 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++ ;
- block(phase->t_next) ;
-#ifdef DEBUG
- if ( debug ) {
- if ( !orig.p_path ) {
- vprint("phase %s failed\n",
- phase->t_name ) ;
- } else {
- vprint("phase %s for %s failed\n",
- phase->t_name,orig.p_path) ;
- }
- }
-#endif
- return 0 ;
- }
- first=NO ;
- phase=phase->t_next ;
- if ( !phase ) {
-#ifdef DEBUG
-if ( debug ) vprint("Transformation sequence complete for %s\n",
- orig.p_path) ;
-#endif
- /* No more work on this file */
- if ( !in.p_keep ) {
- fatal("attempt to discard the result file") ;
- }
- if ( in.p_keeps ) throws(in.p_path) ;
- in.p_keep=NO ; in.p_keeps=NO ; in.p_path= (char *) 0 ;
- return 1 ;
- }
- if ( phase->t_combine ) {
- add_input(&in,phase) ;
- break ;
- }
- }
- return 1 ;
-}
-
-block(first) trf *first ; {
- /* One of the input files of this phase could not be produced,
- block all combiners taking their input from this one.
- */
- register trf *phase ;
- for ( phase=first ; phase ; phase=phase->t_next ) {
- if ( phase->t_combine ) phase->t_blocked=YES ;
- }
-}
-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 ; {
- trf *phase ;
-
- p_suffix= suffix ;
- switch ( getpath(&phase) ) {
- case F_OK :
- for ( ; phase ; phase= phase->t_next ) {
- 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("sorry, cannot produce the desired file(s) from %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
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#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>
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-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
- *
- */
-
-/* $Header$ */
-
-/*
- * 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;
-char *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;
-
- if ( !pc_path ) fatal("Missing compiler pathname specification\n") ;
- 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 ( !err_path ) fatal("Missing error file name\n") ;
- 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>
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_dmach[] = RCS_DMACH ;
-#endif
-
-/************************************************************************/
-/* */
-/* Read machine definitions and transformations */
-/* */
-/************************************************************************/
-
-#define COMMENT '#'
-
-#define VAR "var"
-#define PASS "name"
-#define IN "from"
-#define OUT "to"
-#define RES "outfile"
-#define PROG "program"
-#define MAPF "mapflag"
-#define ARGS "args"
-#define PROP "prop"
-#define STD_IN "stdin"
-#define STD_OUT "stdout"
-#define PREP "prep"
-#define OPT "optimizer"
-#define LINKER "linker"
-#define COMBINER "combiner"
-#define PRIO "priority"
-#define RUNT "rts"
-#define NEEDT "need"
-#define CALL "callname"
-#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(CALL,ty_name)==0 ) {
- if ( callname && strcmp(bol,callname)==0 ) {
- callname= (char *)0 ;
-#ifdef DEBUG
- if ( debug>=3 ) {
- vprint("found call name\n");
- }
-#endif
- }
- } 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 ;
- int name_seen=0 ;
-
- 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,STD_IN)==0 ) {
- if ( new->t_stdin ) twice=YES ;
- new->t_stdin= YES ;
- } else
- if ( strcmp(ty_name,STD_OUT)==0 ) {
- if ( new->t_stdout ) twice=YES ;
- new->t_stdout= YES ;
- } else
- if ( strcmp(ty_name,PREP)==0 ) {
- if ( strcmp(bol,"always")==0 ) {
- if ( new->t_prep ) twice=YES ;
- new->t_prep=YES ;
- } else
- if ( strcmp(bol,"cond")==0 ) {
- if ( new->t_prep ) twice=YES ;
- new->t_prep=MAYBE ;
- } else
- if ( strcmp(bol,"is")==0 ) {
- if ( new->t_isprep ) twice=YES ;
- new->t_isprep= YES ;
- } else
- {
- fuerror("illegal preprocessor spec in %s: %s",
- inname,bol) ;
- }
- } else
- if ( strcmp(ty_name,OPT)==0 ) {
- if ( new->t_optim ) twice=YES ;
- new->t_optim= YES ;
- } else
- if ( strcmp(ty_name,LINKER)==0 ) {
- if ( new->t_linker ) twice=YES ;
- new->t_linker= YES ;
- new->t_combine= YES ;
- } else
- if ( strcmp(ty_name,COMBINER)==0 ) {
- if ( new->t_combine ) twice=YES ;
- new->t_combine= YES ;
- } else
- if ( strcmp(ty_name,PRIO)==0 ) {
- new->t_priority= atoi(bol) ;
- } else
- if ( strcmp(ty_name,PROP)==0 ) {
- /* Obsolete by now, to be removed */
- 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 'L': new->t_linker=YES ;
- 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,RES)==0 ) {
- if ( new->t_outfile ) twice=YES ;
- new->t_outfile= keeps(bol) ;
- } else
- if ( strcmp(ty_name,CALL)==0 ) {
- if ( callname && strcmp(bol,callname)==0 ) {
- name_seen=1 ;
- callname= (char *)0 ;
-#ifdef DEBUG
- if ( debug>=3 ) {
- vprint("found call name in %s\n",
- new->t_name) ;
- }
-#endif
- }
- } 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="" ;
- /* Warning, side effect */
- if ( name_seen && new->t_rts ) {
- if ( rts && strcmp(rts,new->t_rts)!=0 ) {
- error("Attempt to use two run-time systems, %s and %s",
- rts, new->t_rts) ;
- }
- rts= new->t_rts ;
- keephead(rts) ; keeptail(rts) ;
- }
-#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 ;
- /* Try to read EM_DIR/lib/MACH/descr */
- gr_cat(&rline,EM_DIR) ;
- gr_cat(&rline,"/lib/") ; gr_cat(&rline,name) ;
- gr_cat(&rline,"/descr") ;
- infile= fopen(gr_start(rline),"r") ;
- if ( !infile ) {
- gr_throw(&rline) ;
- gr_cat(&rline,EM_DIR) ; gr_cat(&rline,"/") ;
- gr_cat(&rline,ACK_PATH); gr_cat(&rline,"/") ;
- gr_cat(&rline,name) ;
- infile= fopen(gr_start(rline),"r") ;
- }
- 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() {
- register int token ;
-
- if ( incore ) {
- if ( *inptr==0 ) return EOF ;
- return *inptr++ ;
- }
- token= getc(infile) ;
- if ( (token>=0177 || token <=0 ) && token !=EOF ) {
- fuerror("Non-ascii character in description file %s",inname);
- }
- return token ;
-}
-
-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>
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#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(phase->t_inputs), elem) {
- vprint(" %s",p_cont(*elem)->p_path);
- }
- 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<=1 ) 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 create %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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-enum f_path getpath(first) register trf **first ; {
- /* Try to find a transformation path */
-
- start_scan();
- /*
- The end result is the chaining of
- the consequtive phases with the t_next field.
- The list is scanned for possible transformations
- stopping at stopsuffix or the last transformation in the list.
- The scan flags are set by this process.
- When a transformation is found, it is compared with
- the last transformation found.
- */
- try(l_first(tr_list),p_suffix);
- return scan_end(first);
-}
-
-/******************** data used only while scanning *******************/
-
-static int last_pcount; /* The added priority of
- the best path so far */
-
-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 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_scan=NO ;
- }
- 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 a 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_next ) {
- /* We know what happens from this phase on,
- so take a shortcut.
- */
- register trf *sneak ;
- sneak= trafo ;
- while( sneak=sneak->t_next ) {
- sneak->t_scan=YES ;
- }
- scan_found() ;
- sneak= trafo ;
- while( sneak=sneak->t_next ) {
- sneak->t_scan=NO ;
- }
- return ;
- }
- if ( trafo->t_linker && stopsuffix && !*stopsuffix ) {
- trafo->t_scan=NO ;
- scan_found() ;
- return ;
- }
- if ( l_next(*scan) ) {
- try(l_next(*scan),trafo->t_out);
- } else {
- if ( !stopsuffix ) scan_found() ;
- }
- trafo->t_scan= NO ;
- }
- }
-}
-
-scan_found() {
- register list_elem *scan;
- int ncount, ocount, pcount ;
-
- suf_found= 1;
-#ifdef DEBUG
- if ( debug>=3 ) vprint("Scan found\n") ;
-#endif
- /* Gather data used in comparison */
- ncount=0; ocount=0; pcount=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++ ;
- pcount += t_cont(*scan)->t_priority ;
- }
- }
-#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, p:%d - new n:%d, o:%d, p:%d\n",
- last_ncount,last_ocount,last_pcount,
- ncount,ocount,pcount) ;
- }
-#endif
- if ( last_ncount== -1 || /* None found yet */
- last_pcount<pcount || /* Better priority */
- ( last_pcount==pcount && /* Same prio, and */
- ( 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_bscan=t_cont(*scan)->t_scan;
- }
- last_ncount=ncount; last_ocount=ocount; last_pcount=pcount;
- }
-}
-
-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(first) trf **first ; { /* Finalization */
- /* Return value indicating whether a transformation was found */
- /* Set the flags for the transformation up to, but not including,
- the combiner
- */
- register trf *prev, *curr ;
- register list_elem *scan;
-
-#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
- prev= (trf *)0 ; *first= prev ;
- scanlist(l_first(tr_list),scan) {
- curr= t_cont(*scan) ;
- if ( curr->t_bscan ) {
- if ( prev ) {
- prev->t_next= curr ;
- if ( curr->t_linker ) prev->t_keep=YES ;
- } else {
- *first= curr ;
- }
- if ( curr->t_next ) {
- return F_OK ;
- }
- prev=curr ;
- }
- }
- if ( cpp_trafo && stopsuffix &&
- strcmp(stopsuffix,cpp_trafo->t_out)==0 ) {
- cpp_trafo->t_keep=YES ;
- }
- if ( prev ) {
- prev->t_keep=YES ;
- }
- 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_trans[] = RCS_TRANS ;
-#endif
-
-/****************************************************************************/
-/* 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) ) {
- disc_files(phase) ;
- return 0 ;
- }
- getcallargs(phase) ;
- ok= runphase(phase) ;
- if ( !ok ) rmfile(&out) ;
- /* Free the space occupied by the arguments,
- except for the linker, since we are bound to exit soon
- and do not foresee further need of memory space */
- if ( !phase->t_linker ) discardargs(phase) ;
- disc_files(phase) ;
- return ok ;
-}
-
-getmapflags(phase) register trf *phase ; {
- register path *l_in ;
- 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_linker ) {
- scanlist(l_first(phase->t_inputs),elem) {
- l_in = p_cont(*elem) ;
- if ( mapflag(&(phase->t_mapf),l_in->p_path) ) {
- ptr= keeps(getvar(LIBVAR)) ;
- clr_noscan(ptr) ;
-#ifdef DEBUG
- if ( debug >=4 ) {
- vprint("phase %s, library %s(%s)\n",
- phase->t_name,l_in->p_path,ptr) ;
- }
-#endif
- if ( l_in->p_keeps) throws(l_in->p_path) ;
- l_in->p_path= ptr ;
- l_in->p_keeps=YES ;
- }
- }
- 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)) ;
-#ifdef DEBUG
- if ( debug >=4 ) {
- vprint("phase %s, added flag %s\n",
- phase->t_name,
- l_content(*elem) ) ;
- }
-#endif
- }
- }
- }
-}
-
-
-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(tr_list), elem) {
- phase = t_cont(*elem) ;
- if ( !phase->t_linker ) getmapflags(phase);
- }
- scanlist(l_first(R_list), elem) {
- set_Rflag(l_content(*elem)) ;
- }
- l_clear(&R_list) ;
- setpvar(keeps(NEEDS),needvar) ;
- setpvar(keeps(HEAD),headvar) ;
- setpvar(keeps(TAIL),tailvar) ;
-}
-
-set_Rflag(argp) register char *argp ; {
- register char *eos ;
- register list_elem *prog ;
- register int length ;
- char *eq, *colon ;
-
- eos= index(&argp[2],'-');
- eq= index(&argp[2],EQUAL) ;
- colon= index(&argp[2],':');
- if ( !eos ) {
- eos= eq ;
- } else {
- if ( eq && eq<eos ) eos= eq ;
- }
- if ( colon && ( !eos || eos>colon ) ) eos= colon ;
- if ( !eos ) {
- if ( !(argp[0]&NO_SCAN) ) werror("Incorrect use of -R flag") ;
- return ;
- }
- length= eos - &argp[2] ;
- scanlist(l_first(tr_list), prog) {
- if ( strncmp(t_cont(*prog)->t_name, &argp[2], length )==0 &&
- t_cont(*prog)->t_name[length]==0 /* Same name length */) {
- if ( *eos=='-' ) {
- if ( !(argp[0]&NO_SCAN) ) {
- /* If not already taken by a mapflag */
- l_add(&(t_cont(*prog)->t_flags),eos) ;
- }
- } else
- if ( *eos=='=' ) {
- t_cont(*prog)->t_prog= eos+1 ;
- } else {
- t_cont(*prog)->t_priority= atoi(eos+1) ;
- }
- argp[0] |= NO_SCAN ;
- return ;
- }
- }
- if ( !(argp[0]&NO_SCAN) ) werror("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) ;
- gr_add(&name,0) ; gr_add(&varval,0) ;
- 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 ;
-static list_head *comb_args ;
-
-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(*comb_args), elem ) {
- l_add(curargs,p_cont(*elem)->p_path) ;
- }
- }
- return ;
- }
- if ( in.p_path ) { /* Not for the combiners */
- temp=c_rep(string,repc,in.p_path) ;
- addargs(temp) ;
- throws(temp) ;
- } else { /* For the combiners */
- scanlist( l_first(*comb_args), elem ) {
- temp=c_rep(string,repc,p_cont(*elem)->p_path);
- 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 ;
- if (phase->t_combine) comb_args = &phase->t_inputs ;
- unravel( gr_start(arg2), addargs ) ;
- gr_throw(&arg2) ;
-}
-
-discardargs(phase) register trf *phase ; {
- l_throw(&phase->t_args) ;
-}
+++ /dev/null
-#ifndef NORCSID
-#define RCS_TRANS "$Header$"
-#endif
-
-/* 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' */
- char *t_outfile ; /* Resulting output file */
- 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 */
- int t_scan:1 ; /* Used while finding path's */
- int t_bscan:1 ; /* Best scan so far, while finding path's */
- int t_linker:1 ; /* The linker usurps all unrecognized flags */
- int t_do:1 ; /* Is in a path to execute */
- int t_blocked:1 ; /* An input file could not be produced */
- short t_priority ; /* Importance of including phase in scan */
- list_head t_inputs ; /* The input 'path's of a combiner */
- char *t_origname ; /* The basename of the output file */
- trf *t_next ; /* The transformation to be executed next */
- char *t_prog ; /* Pathname for load file */
- list_head t_flags ; /* List of flags */
- list_head t_args ; /* List of arguments */
-} ;
-
-#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>
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-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
-# $Header$
-d=../..
-l=$d/lib
-h=$d/h
-ASS_PATH=$l/em_ass
-
-SEP_OPT=-i
-
-CFLAGS=-O
-
-all: ass$(SEP_OPT)
-
-clean:
- -rm -f ass-i ass-n *.o maktab *.old asstb.c
-
-install : all
- cp ass$(SEP_OPT) $(ASS_PATH)
-
-cmp : all
- cmp ass$(SEP_OPT) $(ASS_PATH)
-
-lint: ass00.c ass30.c ass40.c ass50.c ass60.c ass70.c \
- ass80.c assci.c assda.c assrl.c asstb.c asscm.c
- lint -hpvbx \
- ass00.c ass30.c ass40.c ass50.c ass60.c ass70.c \
- ass80.c assci.c assda.c assrl.c asstb.c asscm.c
-
-
-ass-n: ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
- ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
- $l/em_data.a
- cc -n $(CFLAGS) -o ass-n \
- ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
- ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
- $l/em_data.a
-
-ass-i: ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
- ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
- $l/em_data.a
- cc -i $(CFLAGS) -o ass-i \
- ass00.o ass30.o ass40.o ass50.o ass60.o ass70.o \
- ass80.o assci.o assda.o assrl.o asstb.o asscm.o \
- $l/em_data.a
-
-ass00.o ass40.o ass60.o ass70.o ass80.o assrl.o: \
- $h/local.h $h/em_spec.h $h/as_spec.h \
- $h/em_flag.h $h/arch.h ass00.h assex.h
-
-assci.o: $h/local.h $h/em_spec.h $h/as_spec.h \
- $h/em_flag.h $h/em_mes.h $h/em_pseu.h \
- $h/em_ptyp.h $h/arch.h ass00.h assex.h
-
-ass30.o ass50.o : \
- $h/local.h $h/em_spec.h $h/as_spec.h \
- $h/em_flag.h ip_spec.h ass00.h assex.h
-
-ass80.o: $h/em_path.h
-
-assda.o: $h/local.h $h/em_spec.h $h/as_spec.h \
- $h/em_flag.h $h/arch.h ass00.h
-
-asscm.o: ass00.h
-
-asstb.o: asstb.c
-
-asstb.c: maktab ip_spec.t
- maktab ip_spec.t asstb.c
-
-maktab: maktab.c $h/em_spec.h ip_spec.h $h/em_flag.h \
- $l/em_data.a
- cc -O -o maktab maktab.c $l/em_data.a
-
-asprint: asprint.p
- apc -w -o asprint asprint.p
-
-opr:
- make pr ^ opr
-
-pr:
- @(pr ass00.h assex.h ip_spec.h ass?0.c ass[rcd]?.c \
- maktab.c ; pr -3 ip_spec.t)
+++ /dev/null
-#
-{$d+}
-program asprint(prog,output);
-
-const
-
- { 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 }
-
-type
- 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 }
- size= 0..32766; { 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 }
- 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
- { variables indicating the size of words and addresses }
- wsize: integer; { number of bytes in a word }
- asize: integer; { number of bytes in an address }
- pdsize: integer; { size of procedure descriptor in bytes = 2*asize }
-
- 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 }
- found:boolean; { scratch }
- opcode: byte;
- iclass: insclass;
- dispat: array[insclass, byte] of dispatch ;
- insr: mnem; { holds the instructionnumber }
- header: array[1..8] of adr;
-
- prog: file of byte; { program and initialized data }
-
-procedure getit; { start the ball rolling }
-var cset:set of char;
- f:ifset;
- 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
- if eof(prog) then
- begin writeln('Premature EOF on EM load file') ; halt end;
- 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;
-
- procedure skipbyte;
- var dummy: byte;
- begin dummy:=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;
- 1: writeln('Test flags: ',hdr);
- 2: if hdr<>0 then
- begin writeln('Unsolved references: ',hdr) end;
- 3: if hdr<>3 then
- begin writeln('Incorrect load file version') end;
- 4: wsize:=hdr ;
- 5: begin asize:=hdr ; pdsize:= asize+asize end;
- 6,7:
- if hdr<>0 then
- begin writeln('First header entry ',i,', is ',hdr) end;
- end
- end;
- writeln('word size',wsize,', pointer size',asize)
- end;
-
- procedure noinit;
- begin writeln('Illegal initialization'); halt end;
-
- procedure readint(a:adr;s:size);
- const mrange = 4;
- var i:size;
- val:double;
- cont: array[1..mrange] of byte;
- begin { construct integer out of byte sequence }
- if s<=mrange then
- begin
- for i:=1 to s do cont[i]:=readbyte ;
- if cont[s]>=128 then val:=cont[s]-256 else val:=cont[s];
- for i:= s-1 downto 1 do val:= val*256 + cont[i];
- writeln(', value ',val)
- end
- else
- begin
- write(', bytes(little endian) ');
- for i:=1 to s do write(readbyte:4) ;
- writeln
- end
- end;
-
- procedure readuns(a:adr;s:size);
- const mrange=3;
- var i:size;
- val:double;
- cont: array[1..mrange] of byte;
- begin { construct unsigned integer out of byte sequence }
- if s<=mrange then
- begin
- for i:=1 to s do cont[i]:=readbyte ;
- val:=0;
- for i:= s downto 1 do val:= val*256 + cont[i];
- writeln(', value ',val)
- end
- else
- begin
- write(', bytes(little endian) ');
- for i:=1 to s do write(readbyte:4) ;
- writeln
- end
- end;
-
- procedure readfloat(a:adr;s:size);
- var i:size; b:byte;
- begin { construct float out of string}
- i:=0;
- repeat { eat the bytes, construct the value and intialize at a }
- write(chr(readbyte)); i:=i+1;
- until b=0 ;
- end;
-
-begin
-
-#ifdef INSRT
- { initialize tables }
- 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);
-
-#endif
- { 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 }
- writeln('textsize ',header[NTEXT],', datasize ',header[SZDATA]);
- writeln('data descriptors: ',header[NDATA]);
- writeln('procedure descriptors: ',header[NPROC]);
- writeln('entry procedure: ',header[ENTRY]);
- if header[7]<>0 then writeln('Second header entry 7 is ',header[7]);
- if header[8]<>0 then writeln('Second header entry 8 is ',header[8]);
- { read program text }
- for i:=0 to header[NTEXT]-1 do skipbyte;
- { read data blocks }
- writeln; writeln('Data descriptors:');
- nexta:=0;
- for i:=1 to header[NDATA] do
- begin
- n:=readbyte;
- write(nexta:5,'- ');
- if n<>0 then
- begin
- elem:=readbyte; firsta:=nexta;
- case n of
- 1: { uninitialized words }
- begin
- writeln(elem,' uninitialised word(s)');
- nexta:= nexta+ elem*wsize ;
- end;
- 2: { initialized bytes }
- begin
- write(elem,' initialised byte(s)');
- for j:=1 to elem do
- begin
- if j mod 10 = 1 then
- begin writeln ; write(nexta:6,':') end ;
- write(readbyte:4); nexta:=nexta+1
- end;
- writeln
- end;
- 3: { initialized words }
- begin
- write(elem,' initialised word(s)');
- for j:=1 to elem do
- begin
- if j mod 8 = 1 then
- begin writeln ; write(nexta:6,':') end ;
- write(readword:9); nexta:=nexta+wsize
- end;
- writeln
- end;
- 4,5: { instruction and data pointers }
- begin
- if n=4 then
- write(elem,' initialised data pointers')
- else
- write(elem,' initialised instruction pointers');
- for j:=1 to elem do
- begin
- if j mod 8 = 1 then
- begin writeln ; write(nexta:6,':') end ;
- write(readadr:9); nexta:=nexta+asize
- end;
- writeln
- end;
- 6: { signed integers }
- begin
- write(elem,'-byte signed integer ');
- readint(nexta,elem); nexta:=nexta+elem
- end;
- 7: { unsigned integers }
- begin
- write(elem,'-byte unsigned integer ');
- readuns(nexta,elem); nexta:=nexta+elem
- end;
- 8: { floating point numbers }
- begin
- write(elem,'-byte floating point number ');
- readfloat(nexta,elem); nexta:=nexta+elem
- end;
- end
- end
- else
- begin
- repc:=readadr;
- amount:=nexta-firsta;
- writeln(repc,' copies of the data from ',firsta:2,' to ',nexta:2);
- nexta:= nexta + repc*amount ;
- end
- end;
- if header[SZDATA]<>nexta then writeln('Data initialization error');
- { read descriptor table }
- pd:=header[NTEXT];
- for i:=1 to header[NPROC]*pdsize do skipbyte;
-end;
-
-begin getit;
-#ifdef RTC
- 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;
-#endif
-end.
+++ /dev/null
-#include "ass00.h"
-#include "assex.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
- *
- */
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
-** Main routine of EM1-assembler/loader
-*/
-
-main(argc, argv)
- int argc;
- char **argv;
-{
- /*
- * Usage: ass [-[d][p][m][u]] [-s(s/m/l)] [ [file] [flag] ] ...
- * The d flag can be repeated several times, resulting in more
- * debugging information.
- */
-#ifdef EM_WSIZE
- char workspace[2000] ;
-#else
- char workspace[6000] ;
-#endif
- register char *cp ;
- register int argno ;
-
- progname = argv[0];
- for ( cp=argv[0] ; *cp ; ) if ( *cp++ == '/' ) progname= cp;
- for ( argno=1 ; argno<argc ; argno++ ) {
- if ( argv[argno][0] == '-' && LC(argv[argno][1]) == 's') {
- getsizes(&argv[argno][2]);
- break ;
- }
- }
- /* A piece of the interpreter's stack frame is used as
- free area initially */
- freearea( (area_t) workspace, (unsigned) sizeof workspace ) ;
- getcore();
- init_files();
- init_vars();
- while ( --argc )
- argument(*++argv);
- finish_up();
- exit(nerrors!=0);
-}
-
-getcore() {
- register size_t *p;
- size_t bytes;
- register unsigned n ;
- register char *base ;
-
- /*
- * xglobs[] should be located in front of mglobs[], see upd_reloc()
- */
-
- p = oursize; n = 0;
- n += (bytes.n_glab = p->n_glab * (sizeof *xglobs));
- n += (bytes.n_mlab = p->n_mlab * (sizeof *mglobs));
- n += (bytes.n_mproc = p->n_mproc * (sizeof *mprocs));
- n += (bytes.n_xproc = p->n_xproc * (sizeof *xprocs));
- n += (bytes.n_proc = p->n_proc * (sizeof *proctab));
- base = getarea(n);
- zero(base,n);
- xglobs = gbp_cast base; base += bytes.n_glab;
- mglobs = gbp_cast base; base += bytes.n_mlab;
- mprocs = prp_cast base; base += bytes.n_mproc;
- xprocs = prp_cast base; base += bytes.n_xproc;
- proctab = ptp_cast base; base += bytes.n_proc;
-}
-
-getsizes(str) char *str; {
-
- /*
- * accepts -ss (small), -sm (medium), -sl (large)
- */
-
- switch(LC(*str)) {
- default:error("bad size option %s",str);
- case 's': oursize = &sizes[0]; break;
- case 'm': oursize = &sizes[1]; break;
- case 'l': oursize = &sizes[2]; break;
- }
-}
-
-char oflag;
-
-argument(arg) char *arg; {
- register w;
-
- /*
- * This routine decides what to do with each argument.
- * It recognises flags and modules.
- * Furthermore, it knows a library when it sees it and
- * call archive() to split it apart.
- */
-
- if (oflag) {
- eout = arg;
- oflag=0;
- return;
- }
- if(*arg == '-') {
- flags(arg);
- return;
- }
- curfile = arg; /* for error messages etc. */
- if ((ifile = fopen(arg,"r")) == NULL) {
- error("can't open %s",arg);
- return;
- }
- inpoff = 2;
- if ((w = getu16()) == sp_magic )
- read_compact();
- else if (w == ARMAG) {
- archmode = TRUE;
- archive();
- archmode = FALSE;
- } else
- error("%s: bad format",arg);
- if (fclose(ifile) == EOF)
- ;
-}
-
-/*
-** process flag arguments
-*/
-
-static int memflg ;
-
-flags(arg)
- char *arg;
-{
- register char *argp;
- register on;
-
- argp = arg;
- while (*++argp)
- {
- switch(LC(*argp))
- {
- case 'd': d_flag++;break;
- case 'r': r_flag++;break;
- case 's': return ; /* s-flag is already scanned */
-#ifdef MEMUSE
- case 'm': memflg++ ; break ;
-#endif
- case 'p': ++procflag;break;
-#ifdef DUMP
- case 'u': ++c_flag;break;
-#endif
- case 'o': ++oflag; break;
- case 'w': ++wflag; break;
-#ifdef JOHAN
- case 'j': ++jflag; break;
-#endif
- case '-':
- case '+':
- on = (*argp == '+');
- while (*++argp) switch(LC(*argp)) {
- case 't': if (on) intflags |= 01;
- else intflags &= ~01;
- break;
- case 'p': if (on) intflags |= 02;
- else intflags &= ~02;
- break;
- case 'f': if (on) intflags |= 04;
- else intflags &= ~04;
- break;
- case 'c': if (on) intflags |= 010;
- else intflags &= ~010;
- case 'e': if (on) intflags |= 040;
- else intflags &= ~040;
- break;
- default:
- error("bad interpreter option %s",argp);
- }
- --argp;
- break;
- default:
- error("bad flag %s",argp);
- break;
- }
- }
-}
-
-do_proc() {
- /* One procedure has been read and will be processed.
- *
- * NOTE: The numbers of the passes, 1 3 4 and 5, are a remainder
- * of ancient times.
- */
-
- dump(1); if ( memflg>2 )memuse();
- pass_3(); dump(3);
- pass_4(); dump(4);
- pass_5(); if ( memflg>2 ) memuse() ;
- endproc(); if ( memflg>1 ) memuse() ;
-}
-
-archive() {
- register i;
- register char *p;
-
- /*
- * Read a library.
- * The format of the libary used is that of a UNIX/V7(PDP)-archive.
- *
- * NOTE: If it was allowed for an archive to contain
- * obligatory modules as well as optionals,
- * it would not be possible to speed up things a bit
- * by stopping when all references are resolved.
- * This is the only reason.
- */
-
- for(;;) {
- if (unresolved == 0) { /* no use for this library anymore */
- return;
- }
- p = chp_cast &archhdr;
- if ((i = fgetc(ifile))==EOF ) {
- return;
- }
- *p++ = i;
- for (i=1;i< sizeof archhdr.ar_name; i++)
- *p++ = get8();
- for (i=0;i<8;i++) get8();
- archhdr.ar_size= ((long)get16()<<16) ;
- archhdr.ar_size+= getu16();
- inpoff = 0; libeof = archhdr.ar_size;
- /*
- * UNIX archiveheader is read now, now process the contents
- * of it. Note that recursive archives are not implemented.
- *
- * The variable libeof is used by get8() to check
- * whether or not we try to pass the library-boundary.
- */
- if ( getu16() == sp_magic ) {
- read_compact();
- } else
- error("bad archive entry");
- skipentry();
- libeof = 0;
- } /* up to the next entry */
-}
-
-skipentry() {
-
- /*
- * for some reason the rest of this library entry needs to be
- * skipped. Do that now.
- */
- while(inpoff<libeof)
- get8();
- if(odd(libeof)) /* archive entries are evensized */
- if (fgetc(ifile) == EOF) /* except maybe the last one */
- ;
-}
-
-init_vars() {
-
- /*
- * A small collection of variables is initialized.
- * This occurs only for those that couldn't be initialized
- * at compile-time.
- */
-
-}
-
-init_files() {
-
- /*
- * The temporary files on which text and data are kept
- * during assembly are set up here.
- */
-#ifdef CPM
- unlink("????????.$$$");
- tfile=fopen("TFILE.$$$", "w");
- dfile=fopen("DFILE.$$$", "w");
- rtfile=fopen("RTFILE.$$$", "w");
- rdfile=fopen("RDFILE.$$$", "w");
-#else
- /*
- * The function tmpfil() returns a file-descriptor
- * of a file that is valid for reading and writing.
- * It has the nice property of generating truly unique names.
- */
-
- tfile=fdopen(tmpfil(),"w") ;
- dfile=fdopen(tmpfil(),"w") ;
- rtfile=fdopen(tmpfil(),"w") ;
- rdfile=fdopen(tmpfil(),"w") ;
-#endif
-}
-
-initproc() {
-
- /*
- * Called at the start of assembly of every procedure.
- */
-
- stat_t *prevstate ;
-
- prevstate= pst_cast getarea(sizeof pstate) ;
- *prevstate= pstate ;
- pstate.s_prevstat= prevstate ;
- pstate.s_curpro= prp_cast 0 ;
- pstate.s_fline= lnp_cast 0 ;
- pstate.s_fdata= l_data ;
- pstate.s_locl = (locl_t (*)[])
- getarea(LOCLABSIZE * sizeof (*(pstate.s_locl))[0]);
- zero(chp_cast pstate.s_locl,
- LOCLABSIZE * (unsigned) sizeof (*(pstate.s_locl))[0]);
- if ( memflg>2 ) memuse() ;
-}
-
-endproc() {
- /* Throw the contents of the line and local label table away */
- register line_t *lnp1;
- register locl_t *lbhead,*lbp,*lbp_next;
- register kind ;
- register stat_t *prevstate;
-
- while ( lnp1= pstate.s_fline ) {
- pstate.s_fline= lnp1->l_next ;
- kind= lnp1->type1 ;
- if ( kind>VALLOW ) kind=VALLOW ;
- freearea((area_t)lnp1,(unsigned)linesize[kind]) ;
- }
- prevstate= pstate.s_prevstat ;
- if ( prevstate!= pst_cast 0 ) {
- for ( lbhead= *pstate.s_locl;
- lbhead<&(*pstate.s_locl)[LOCLABSIZE] ; lbhead++ ) {
- for ( lbp=lbhead; lbp!= lbp_cast 0; lbp= lbp_next ) {
- lbp_next= lbp->l_chain;
- freearea((area_t)lbp,(unsigned)sizeof *lbp) ;
- }
- }
- pstate= *prevstate ;
- freearea((area_t)prevstate,(unsigned)sizeof *prevstate) ;
- }
-}
-
-init_module() {
-
- /*
- * Called at the start of every module.
- */
-
- holbase = 0;
- line_num = 1;
- mod_sizes = 0;
-}
-
-end_module() {
-
- /*
- * Finish a module.
- * Work to be done is mainly forgetting of local names,
- * and remembering of those that will live during assembly.
- */
-
- align(wordsize) ;
- setmode(DATA_NUL);
- dump(100);
- enmd_pro();
- enmd_glo();
- if ( memflg ) memuse() ;
-}
-
-enmd_pro() {
- register proc_t *p,*limit;
-
- /*
- * Check that all local procedures have been defined,
- * and forget them immediately thereafter.
- */
-
- limit = &mprocs[oursize->n_mproc];
- for (p=mprocs; p<limit; p++) {
- if (p->p_name[0] == 0)
- continue;
- if ((p->p_status&DEF)==0)
- error("undefined local procedure '%s'",p->p_name);
- }
- zero(chp_cast mprocs,(limit-mprocs)* (unsigned)sizeof *mprocs);
-
- /* Clobber all flags indicating that external procedures
- * were used in this module.
- */
-
- limit = &xprocs[oursize->n_xproc];
- for (p=xprocs; p<limit; p++) {
- p->p_status &= ~EXT ;
- }
-}
-
-enmd_glo() {
- register glob_t *mg,*xg,*limit;
-
- /*
- * Tougher then enmd_pro().
- * Check all the symbols used in this module that are
- * not to be forgotten immediately.
- * A difficulty arises here:
- * In the tables textreloc[] and datareloc[]
- * pointers are used to identify the symbols concerned.
- * These pointers point into mglobs[].
- * Since at the end of assembly only the value of xglobs[]
- * is defined, these pointers have to be changed.
- * upd_reloc() takes care of this.
- */
-
- limit = &mglobs[oursize->n_mlab];
- for ( mg = mglobs; mg < limit; mg++) {
- if (mg->g_name[0] == 0)
- continue;
- if ((mg->g_status&(EXT|DEF))==0)
- error("undefined local symbol '%s'",glostring(mg));
- if ((mg->g_status&EXT)==0)
- continue;
- xg = xglolookup(mg->g_name,ENTERING);
- switch(xg->g_status&(EXT|DEF)) {
- case 0: /* new symbol */
- if((mg->g_status&DEF)==0)
- ++unresolved;
- break;
- case EXT: /* already used but not defined */
- if(mg->g_status&DEF) {
- --unresolved;
- }
- break;
- }
- xg->g_status |= mg->g_status;
- if (mg->g_status&DEF)
- xg->g_val.g_addr = mg->g_val.g_addr;
- else
- mg->g_val.g_gp = xg; /* used by upd_reloc */
- } /* up to the next symbol */
- upd_reloc();
- zero(chp_cast mglobs,(limit-mglobs)*(unsigned) sizeof *mglobs);
-}
-
-finish_up()
-{
- /*
- * Almost done. Check for unresolved references,
- * make the e.out file and stop.
- */
-
-#ifdef JOHAN
- if ( jflag ) return ;
-#endif
-#ifdef DUMP
- c_print();
-#endif
- check_def();
- if ( nerrors==0 ) copyout();
-}
-
-#ifdef DUMP
-c_print() {
- if ( ! c_flag ) return ;
- c_dprint("primary",opcnt1) ;
- c_dprint("secondary",opcnt2) ;
- c_dprint("extra long",opcnt3) ;
-}
-
-c_dprint(str,cnt) char *str,*cnt ; {
- register int first,curr ;
- printf("unused %s opcodes\n",str) ;
- for ( first= -1 , curr=0 ; curr<=256 ; curr++ ) {
- if ( curr==256 || cnt[curr] ) {
- if ( first!= -1 ) {
- if ( first+1 == curr ) {
- printf("%3d\n",first ) ;
- } else {
- printf("%3d..%3d\n",first,curr-1) ;
- }
- first= -1 ;
- }
- } else {
- if ( first== -1 ) first=curr ;
- }
- }
-}
-#endif
-
-check_def() {
- register proc_t *p;
- register glob_t *g;
- register count;
-
- /*
- * Check for unresolved references.
- * NOTE: The occurring of unresolved references is not fatal,
- * although the use of the e.out file after this
- * occurring must be strongly discouraged.
- * Every use of the symbols concerned is undefined.
- */
-
- if (unresolved) {
- printf("Unresolved references\n Procedures:\n");
- count = oursize->n_xproc;
- for (p = xprocs; count--; p++)
- if (p->p_name[0] && (p->p_status&DEF)==0)
- printf(" %s\n",p->p_name);
- printf(" Data:\n");
- count = oursize->n_glab;
- for (g = xglobs; count--; g++)
- if (g->g_name[0] && (g->g_status&DEF)==0)
- printf(" %s\n",glostring(g));
- }
-}
-
-ertrap() { /* trap routine to drain input in case of compile errors */
-
- if (fileno(ifile)== 0)
- while (fgetc(ifile) != EOF)
- ;
- exit(1);
-}
+++ /dev/null
-#include <stdio.h>
-#include "../../h/em_spec.h"
-#include "../../h/as_spec.h"
-#include "../../h/em_flag.h"
-#include "../../h/arch.h"
-#include "../../h/local.h"
-
-#define RCS_ASS "$Header$"
-
-/*
- * compile time options
- */
-
-#define DUMP 1 /* dump between passes */
-/* #define TIMING 1 /* some timing measurements */
-/* #define JOHAN 1 /* dump the loaded instructions */
-/* #define MEMUSE 1 /* print memory usage statistics */
-
-#ifndef DUMP
-#define dump(x) /* nothing */
-#endif
-
-#ifndef TIMING
-#define timing() /* nothing */
-#endif
-
-#ifndef MEMUSE
-#define memuse() /* nothing */
-#endif
-
-/* Used to clear the upper byte(s) of characters.
- Not nessecary if your C-compiler does not sign-extend char's
-*/
-
-#ifdef CPM
-# define LC(ch) ( ((ch)<'A' | (ch)>'Z' ) ? (ch) : ((ch)-('A'-'a')))
-#else
-# define LC(ch) (ch)
-#endif
-
-#define ctrunc(val) ( (val)&0377 )
-
-#define odd(n) ((n)&1) /* Boolean odd function */
-
-#define lnp_cast (line_t *)
-#define gbp_cast (glob_t *)
-#define lbp_cast (locl_t *)
-#define prp_cast (proc_t *)
-#define ptp_cast (ptab_t *)
-#define rlp_cast (relc_t *)
-#define pst_cast (stat_t *)
-#define chp_cast (char *)
-#define ipp_cast (int **)
-#define iip_cast (int *)
-#define int_cast (int )
-
-typedef struct lines line_t;
-typedef struct loc_label locl_t;
-typedef struct glob_label glob_t;
-typedef struct rel relc_t;
-typedef struct procstat stat_t;
-typedef struct sizes size_t;
-typedef struct ar_hdr arch_t;
-typedef struct procs proc_t;
-typedef struct proctab ptab_t;
-typedef char * area_t;
-typedef long cons_t;
-
-typedef union {
- cons_t ad_i;
- locl_t *ad_lp;
- glob_t *ad_gp;
- proc_t *ad_pp;
- struct sad_ln {
- short ln_extra;
- short ln_first;
- } ad_ln ;
- struct sad_df {
- cons_t df_i;
- glob_t *df_gp;
- } ad_df;
-} addr_u;
-
-typedef union {
- cons_t rel_i;
- locl_t *rel_lp;
- glob_t *rel_gp;
-} rel_u;
-
-#define FOFFSET long /* offset into file */
-
-/*
- * Global variables and definitions for EM1-assembler/loader
- */
-
-#define DEFINING 0 /* parameters for glolookup */
-#define OCCURRING 1
-#define INTERNING 2
-#define EXTERNING 3
-#define SEARCHING 4
-#define ENTERING 5
-
-#define PRO_OCC 0 /* parameters for prolookup */
-#define PRO_DEF 1
-#define PRO_INT 2
-#define PRO_EXT 3
-
-#define TRUE 1
-#define FALSE 0
-
-#define IDLENGTH 8 /* length of glo's and pro's */
-#define MAXSTRING 200 /* Maximum string length accepted */
-#define LOCLABSIZE 128 /* size of local label hash table */
- /* may not be smaller */
-#define ABSSIZE 8
-
-struct lines {
- char instr_num; /* index into mnemon[] */
- char type1; /* see below */
- line_t *l_next; /* next in chain */
- char *opoff; /* pointer into opchoice[] */
- addr_u ad; /* depending on type, various pointers */
-};
-
-/* contents of type1 */
-#define MISSING 0 /* no operand */
-#define CONST 1 /* ad contains operand */
-#define PROCNAME 2 /* ad contains struct procs pointer */
-#define GLOSYM 3 /* ad contains pointer into mproc[] */
-#define LOCSYM 4 /* ad contains pointer into locs[] */
-#define GLOOFF 5 /* ad contains CONST and GLOSYM in ad_df */
-#define LINES 6 /* Line number setting, only param of pseudo*/
-#define VALLOW 7 /* value's between LOW and HIGH are x-MID */
-#define VALMID 50
-#define VALHIGH 127 /* to avoid sign extension problems */
-
-#define VAL1(x) ((x)-VALMID)
-
-/* Used to indicate a invalid contents of opoff */
-#define NO_OFF ((char *)-1)
-
-/* The structure containing procedure pertinent data */
-/* Used for environment stacking for nested PRO's */
-
-struct procstat {
- line_t *s_fline; /* points to first line of procedure */
- locl_t (*s_locl)[]; /* pointer to local labels */
- proc_t *s_curpro; /* identifies current procedure */
- relc_t *s_fdata; /* last datareloc before procedure */
- stat_t *s_prevstat; /* backward chain of nested procedures */
-} ;
-
-struct loc_label {
- locl_t *l_chain; /* The next label with same low order bits */
- char l_hinum; /* high bits of number of label */
- char l_defined; /* see below */
- int l_min,l_max; /* boundaries of value */
-};
-
-/* contents of l_defined */
-#define EMPTY 0 /* Empty slot */
-#define NO 1 /* not defined yet */
-#define YES 2 /* defined */
-#define SEEN 3 /* intermediate state */
-#define NOTPRESENT 4 /* Undefined and error message given */
-
-struct glob_label {
- char g_name[IDLENGTH+1]; /* name + null-byte */
- char g_status; /* see below */
- union {
- cons_t g_addr; /* value if status&DEF */
- struct glob_label *g_gp; /* ref. to xglobs */
- } g_val ;
-};
-
-#define glostring(gl) ((gl)->g_name)
-
-/* contents of g_status */
-#define DEF 01 /* defined */
-#define OCC 02 /* used */
-#define EXT 04 /* external */
-
-struct rel { /* for relocation tables */
- relc_t *r_next; /* chain */
- FOFFSET r_off; /* offset in text/data of word to relocate */
- rel_u r_val; /* constant or pointer to global symbol */
- int r_typ; /* different use in text or data */
-};
-
-/*
- * When used with textrelocation r_typ contains the flag bits as defined
- * in ip_spec.h together with the RELMNS bit if r_val contains an integer
- */
-
-#define RELMNS 020000 /* indicates integer i.s.o. glob */
-
-/* Contents of r_typ when used with data relocation */
-#define RELNULL 0
-#define RELGLO 1
-#define RELHEAD 2
-#define RELLOC 3
-#define RELADR 4
-
-/* modes of data output */
-#define DATA_NUL 0
-#define DATA_REP 1
-#define DATA_CONST 2
-#define DATA_BSS 3
-#define DATA_DPTR 4
-#define DATA_IPTR 5
-#define DATA_ICON 6
-#define DATA_UCON 7
-#define DATA_FCON 8
-#define DATA_BYTES 9
-
-/* name of procedure to be called first */
-#define MAIN "m_a_i_n"
-
-/* headers of datablocks written */
-#define HEADREP 0
-#define HEADBSS 1
-#define HEADBYTE 2
-#define HEADCONST 3
-#define HEADDPTR 4
-#define HEADIPTR 5
-#define HEADICON 6
-#define HEADUCON 7
-#define HEADFCON 8
-
-#define NDEFAULT 3 /* number of different sizes available */
-struct sizes {
- int n_mlab; /* # of global labels per module */
- int n_glab; /* # of extern global labels */
- int n_mproc; /* # of local procs per module */
- int n_xproc; /* # of external procs */
- int n_proc; /* total # of procedures */
-};
-
-struct procs { /* format of mprocs[] and xprocs[] */
- char p_name[IDLENGTH+1]; /* name + 1 null-byte */
- char p_status; /* same bits as g_status except REL */
- int p_num; /* unique procedure descriptor */
-};
-
-struct proctab {
- cons_t pr_off; /* distance from pb */
- cons_t pr_loc; /* number of bytes locals */
-};
+++ /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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_ip[] = RCS_IP ;
-#endif
-
-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) {
- if (lnp->ad.ad_i >= holsize) {
- hol_err_line= line_num ;
- }
- lnp->ad.ad_i += holbase;
- }
- } 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
-** 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
-** 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
-** 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
- * 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/*
- * 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, inpseudo and 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) ;
-}
-
-int getu16() {
- register int l_byte, h_byte;
-
- l_byte = get8();
- h_byte = get8();
- 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 *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';
-}
-
-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 and inpseudo */
- 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 data 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 ) {
- if ( valtype!=sp_scon) 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) ;
-}
-
-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,size-1) ;
- a_lnp->ad.ad_ln.ln_extra -= size ;
- size=0 ;
- } else {
- if( a_lnp) 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 ( !b_lnp ) { /* if a_lnp==0, so is b_lnp */
- fatal("Cannot perform exchange") ;
- }
- if ( ( size-= p2 )>0 ) {
- if ( ctrunc(b_lnp->instr_num) !=sp_fpseu ) {
- fatal("EXC inconsistency") ;
- }
- doinsert(b_lnp,line,size-1) ;
- b_lnp->ad.ad_ln.ln_extra -= size ;
- } else {
- doinsert(b_lnp,line,-1) ;
- }
- 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) ;
- databytes= wordsize ;
- setmode(DATA_REP) ;
- if ( wordsize<ABSSIZE ) {
- register factor = ABSSIZE/wordsize - 1 ;
- extadr( (cons_t) factor ) ;
- databytes += factor * wordsize ;
- }
- absout++ ;
- 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 ; {
- while ( databytes%size ) {
- 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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-static char rcs_ass[]= RCS_ASS ;
-static char rcs_ex[] = RCS_EX ;
-#endif
-
-/*
- * 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
- */
-
-#define RCS_EX "$Header$"
-
-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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-#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
-.\" $Header$
-.TH EM_ASS VI
-.ad
-.SH NAME
-em_ass \- EM assembler/loader
-.SH SYNOPSIS
-/usr/em/lib/em_ass [options] argument ...
-.SH DESCRIPTION
-Em_ass assembles and links EM modules.
-Arguments may be flags, EM modules or libraries.
-Flags recognized are:
-.IP "-ss, -sm, -sl"
-Indicate that your program is small, medium or large.
-Medium is the default.
-.IP -p
-List all procedure names together with base-address (decimal and octal),
-procedure number and module of definition.
-.IP -d
-Used for debugging em_ass itself.
-.PD
-.PP
-em_ass assembles and links together compact EM assembly language modules
-from files and libraries,
-producing an e.out file as described in [1].
-.PP
-Two different types of arguments are allowed:
-.IP "1 -"
-Compact EM assembly language modules (optimized or not), recognized by a
-magic number in the first word.
-.PD 0
-.IP "2 -"
-UNIX archives, as maintained by arch(I). These archives must contain
-EM modules only.
-.PD
-.PP
-EM modules may contain a library message specifying the names
-of procedures and external data defined inside the module.
-These will only be loaded
-if they contain definitions of procedures or data imported by
-previously assembled modules.
-When \fIack\fP(I) is provided with the -LIB flag it tells the
-EM-optimizer \fIem_opt\fP(VI) to insert a library messages
-when optimizing modules.
-The EM-archiver \fIarch\fP(I) can be used to create libraries
-from EM modules.
-.PP
-Note that it is not possible to do a partial load;
-loading starts from compact EM code and produces binary
-EM code. No symbol table and no relocation bits are produced.
-.SH "SEE ALSO"
-ack(I), arch(I)
-.PD 0
-.IP [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson "Description of a machine architecture for use with
-block structured languages" Informatica report IR-81.
-.SH DIAGNOSTICS
-Various diagnostics may be produced. In the case of compiler
-produced code the only messages to expect are "Out of memory"
-or of the
-form: Overflow in XXXX. The latter can usually be cured by giving
-a -sl flag,
-the former means your program is too big, dimishing
-the size of very large procedures can sometimes help.
-The most likely errors, however, are unresolved references,
-probably caused by the omission of a library argument.
-.SH AUTHOR
-Ed Keizer, Vrije Universiteit
+++ /dev/null
-/* Contents of flags used when describing interpreter opcodes */
-
-#define RCS_IP "$Header$"
-
-#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"
-
-#ifndef NORCSID
-static char rcs_id[] = "$Header$" ;
-#endif
-
-/* 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 ;
- if ( type==OPMINI || type==OPSHORT )
- error("Minies and shorties must have P or N") ;
- 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 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");
- unput(c);
- /* fall through */
- 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
-.TH
-.I cpp
-.SH NAME
-cpp \- C Pre-Processor
-.SH SYNOPSIS
-cpp [\-options] files
-.SH DESCRIPTION
-.I Cpp
-reads one or more files, expands macros and include
-files, and writes an input file for the C compiler.
-All output is to cpp.tmp (cpp.tmp.c on Unix).
-.br
-The following options are supported. On non-Unix systems,
-options may be given in either case.
-.IP -Ofile
-Output to this file, instead of the default.
-.IP -S
-Output to stdout, instead of the default.
-.IP -Idirectory
-Add this directory to the list of
-directories searched for #include "..." and #include <...>
-commands. Note that there is no space between the
-"-I" and the directory string. More than one -I command
-is permitted.
-.IP -L
-.I Cpp
-transmits line number information to
-the C compiler by outputting "#line <number>" records.
-If the -L option is given, this record will be transmitted
-as "#", allowing the output of
-.I cpp
-to be input to a compiler
-without an intervening preprocessor without error.
-.IP -Dname=value
-Define the name as if the programmer wrote
-.br
-.nf
- #define name value
-.fi
-.br
-at the start of the first file. If "=value" is not
-given, a value of "1" will be used.
-.br
-On non-unix systems, all alphabetic text will be forced
-to upper-case.
-.br
-.IP -Uname
-Undefine the name as if
-.br
-.nf
- #undef name
-.fi
-.br
-were given. On non-Unix systems, "name" will be forced to
-upper-case.
-The following names are always available unless undefined:
-.RS
-.IP __FILE__
-The input (or #include) file being compiled
-(as a quoted string).
-.IP __LINE__
-The line number being compiled.
-.IP __DATE__
-The date and time of compilation as
-a Unix ctime quoted string (the trailing newline is removed).
-.RE
-Thus,
-.br
-.nf
- printf("Bug at line %s,", __LINE__);
- printf(" source file %s", __FILE__);
- printf(" compiled on %s", __DATE__);
-.fi
-.IP
--Xnumber
-Enable debugging code. If no value is
-given, a value of 1 will be used. (For maintenence of
-.I cpp
-only.)
-.SH "COMMENTS IN MACRO TEXT AND ARGUMENT CONCATENATION"
-.br
-Comments are removed from the input text. The comment
-characters serve as an invisible token delimiter. Thus,
-the macro
-.nf
- #define CAT(a, b) b/**/a
- int value = CAT(1, 2);
-.fi
-Will generate "int value = 21;".
-.br
-A better way of concatenating arguments is as follows:
-.nf
- #define I(x)x
- #define CAT(x,y)I(x)y
- int value = CAT(1, 2);
-.fi
-If the above macros are defined without extraneous
-spaces, they will be transportable to other implementations.
-.br
-.SH DIFFERENCES
-.br
-The following is a list of differences between this
-pre-processor and the Unix V7 preprocessor which was
-written by John Reiser. It is probably not complete.
-.IP o
-Macro formal parameters are recognized within
-quoted strings and character constants in macro definitions.
-For example,
-.nf
- #define foo(a) "Today is a"
- printf(foo(tuesday));
-.fi
-Would print "Today is tuesday".
-.br
-Recognition of formal parameters in macro replacement
-strings is not permitted by the Draft ANSI C Standard.
-It is permitted in this implementation if cpp was
-compiled with the STRING_FORMAL parameter set appropriately.
-.br
-Unlike Reiser's implementation, the '\e' "quote next character"
-does just that. I.e.
-.nf
- #define foo(a) "Today is \ea a"
- printf(foo(tuesday));
-.fi
-Would print "Today is a tuesday". Note that this may
-not be portable.
-.IP o
-Reiser's implementation removes "escaped" linefeeds
-(The two character sequence \e<LF>) within macros. This
-implementation preserves them. For example, a macro which
-generates control commands might be written
-.nf
- #define foo(a, b) \e
- #define a b \e
-.fi
-.nf
- foo(fubar, foobar)
- int fubar;
-.fi
-The above would generate "int foobar;" and a warning message.
-Reiser's scan is slightly different.
-.SH "ANSI C STANDARD"
-.I Cpp
-implements most of the ANSI draft standard.
-You should be aware of the following:
-.IP o
-In the draft standard, the \en (backslash-newline)
-character is "invisible" to all processing. In this implementation,
-it is invisible to strings, but acts a "whitespace" (token-delimiter)
-outside of strings. This considerably simplifies error
-message handling.
-.IP o
-The following extensions to C are processed by cpp:
-.nf
-.sp 1
-.ta 4 27
- #elif expression (#else #if)
- '\exNNN' (Hexadecimal constants)
- '\ea' (Ascii BELL)
- '\ev' (Ascii VT)
- #if defined NAME (1 if defined, 0 if not)
- #if defined (NAME) (1 if defined, 0 if not)
- unary + (gag me with a spoon)
-.fi
-.IP o
-The draft standard has extended C, adding a string
-concatenation operator, where
-.br
-.nf
- "foo" "bar"
-.fi
-.br
-is regarded as the single string "foobar". It is not clear
-from the draft standard whether this applies to pre-processing
-if macro formals are recognized in strings.
-.SH "ERROR MESSAGES"
-.br
-Many.
-.br
-.SH AUTHOR
-.br
-Martin Minow
-.br
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-SHARE=../share
-CFLAGS=-DVERBOSE
-OBJECTS=bo.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o $(SHARE)/stack_chg.o $(SHARE)/go.o
-SRC=bo.c
-
-all: $(OBJECTS)
-bo: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o bo -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-bo.o: ../share/alloc.h
-bo.o: ../share/aux.h
-bo.o: ../share/debug.h
-bo.o: ../share/def.h
-bo.o: ../share/files.h
-bo.o: ../share/get.h
-bo.o: ../share/global.h
-bo.o: ../share/go.h
-bo.o: ../share/lset.h
-bo.o: ../share/map.h
-bo.o: ../share/put.h
-bo.o: ../share/types.h
-bo.o: ../../../h/em_mnem.h
-bo.o: ../../../h/em_pseu.h
-bo.o: ../../../h/em_spec.h
+++ /dev/null
-/* B R A N C H O P T I M I Z A T I O N
- *
- * B O . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../share/def.h"
-#include "../share/go.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-
-#define LP_BLOCKS lp_extend->lpx_ra.lpx_blocks
-
-STATIC int Sbo; /* #optimizations found */
-
-#define DLINK(l1,l2) l1->l_next=l2; l2->l_prev=l1
-
-/* This module performs some very simple branch optimizations.
- *
- * I) Look for pairs of basic blocks (B1,B2), such that
- * SUCC(b1) = {B2} and
- * PRED(B2) = {B1}.
- * In this case B1 and B2 can be combined into one block.
- * This optimization is mainly succesful:
- * 1) for switch statements in C, as the C compiler generates a branch
- * over the entire switch.
- * 2) for return statements, if the only way to return from a procedure
- * is via a return statement somewhere in the middle of the procedure.
- * II) Optimize while statements. Transformations like:
- * 1: jmp 2
- * tst cond 1:
- * beq 2f S
- * S 2:
- * jmp 1 tst cond
- * 2: bneq 1
- * are done by this optimization.
- */
-
-
-
-STATIC line_p last_code(lines,skip_pseu)
- line_p lines;
- bool skip_pseu;
-{
- /* Determine the last line of a list */
-
- register line_p l;
-
- for (l = lines; l->l_next != (line_p) 0; l = l->l_next);
- if (skip_pseu) {
- while (INSTR(l) < sp_fmnem || INSTR(l) > sp_lmnem) l = PREV(l);
- }
- return l;
-}
-
-STATIC short cc_tab[12] =
- {op_blt,op_zlt,op_ble,op_zle,op_beq,op_zeq,
- op_zne,op_bne,op_zgt,op_bgt,op_zge,op_bge};
-
-
-STATIC short rev_cond(cond)
- short cond;
-{
- register i;
-
- for (i = 0; i < 12; i++) {
- if (cond == cc_tab[i]) return cc_tab[11-i];
- }
- return op_nop;
-}
-
-STATIC bool is_bcc(l)
- line_p l;
-{
- return rev_cond(INSTR(l)) != op_nop;
-}
-
-
-STATIC bo_optloop(p,b,x,bra,bcc)
- proc_p p;
- bblock_p b,x;
- line_p bra,bcc;
-{
- bblock_p prevb,n;
- line_p l;
-
- if (b->b_start == bra) {
- b->b_start = (line_p) 0;
- } else {
- PREV(bra)->l_next = (line_p) 0;
- }
- PREV(bra) = (line_p) 0;
- bcc->l_instr = rev_cond(INSTR(bcc));
- n = x->b_next;
- l = n->b_start;
- if (l == (line_p) 0 || INSTR(l) != op_lab) {
- l = newline(OPINSTRLAB);
- l->l_instr = op_lab;
- INSTRLAB(l) = freshlabel();
- if (n->b_start != (line_p) 0) {
- DLINK(l,n->b_start);
- }
- n->b_start = l;
- }
- INSTRLAB(bcc) = INSTRLAB(l);
- for (prevb = p->p_start; prevb != (bblock_p) 0 && prevb->b_next != x;
- prevb = prevb->b_next);
- if (prevb == (bblock_p) 0) {
- p->p_start = x->b_next;
- } else {
- prevb->b_next = x->b_next;
- l = last_instr(prevb);
- if (l == (line_p) 0) {
- prevb->b_start = bra;
- } else {
- if (INSTR(l) == op_bra &&
- INSTRLAB(l) == INSTRLAB(bra)) {
- oldline(bra);
- } else {
- appnd_line(bra,l);
- }
- }
- }
- x->b_next = b->b_next;
- b->b_next = x;
-}
-
-
-
-STATIC bo_tryloop(p,loop)
- proc_p p;
- lset loop;
-{
- Lindex i,j;
- bblock_p b,x;
- line_p bra,bcc;
-
- for (i = Lfirst(loop); i != (Lindex) 0; i = Lnext(i,loop)) {
- b = (bblock_p) Lelem(i);
- if (b->b_next != (bblock_p) 0 && !Lis_elem(b->b_next,loop)) {
- j = Lfirst(b->b_succ);
- if (j != (Lindex) 0 &&
- (bra = last_instr(b)) != (line_p) 0 &&
- INSTR(bra) == op_bra) {
- x = (bblock_p) Lelem(j); /* single successor */
- if (Lis_elem(b->b_next,x->b_succ) &&
- is_bcc((bcc = last_instr(x)))) {
-OUTVERBOSE("branch optimization proc %d block %d\n", curproc->p_id,x->b_id);
- Sbo++;
- bo_optloop(p,b,x,bra,bcc);
- return;
- }
- }
- }
- }
-}
-
-
-
-STATIC bo_loops(p)
- proc_p p;
-{
- Lindex i;
- loop_p lp;
-
- for (i = Lfirst(p->p_loops); i != (Lindex) 0; i = Lnext(i,p->p_loops)) {
- lp = (loop_p) (Lelem(i));
- bo_tryloop(p,lp->LP_BLOCKS);
- }
-}
-
-STATIC mv_code(b1,b2)
- bblock_p b1,b2;
-{
- line_p l,x;
-
- l = last_code(b2->b_start,TRUE);
- DLINK(l,b1->b_start);
- x = l->l_next;
- if (INSTR(l) == op_bra) {
- rm_line(l,b2);
- }
- if (INSTR(x) == op_lab) {
- rm_line(x,b2);
- }
-}
-
-bo_switch(b)
- bblock_p b;
-{
- bblock_p s,x;
- Lindex i;
- line_p l;
-
- if (Lnrelems(b->b_succ) == 1) {
- s = (bblock_p) Lelem(Lfirst(b->b_succ));
- if (b->b_start != (line_p) 0 &&
- s->b_start != (line_p) 0 &&
- Lnrelems(s->b_pred) == 1 &&
- (s->b_next == (bblock_p) 0 ||
- !Lis_elem(s->b_next,s->b_succ))) {
- l = last_code(s->b_start,FALSE);
- if (INSTR(l) == ps_end) {
- if (PREV(l) == (line_p) 0) return;
- PREV(l)->l_next = (line_p) 0;
- PREV(l) = (line_p) 0;
- } else {
- l = (line_p) 0;
- }
-OUTVERBOSE("branch optimization in proc %d, block %d",curproc->p_id,b->b_id);
- Sbo++;
- Ldeleteset(b->b_succ);
- b->b_succ = s->b_succ;
- Ldeleteset(s->b_pred);
- s->b_succ = Lempty_set();
- s->b_pred = Lempty_set();
- for (i = Lfirst(b->b_succ); i != (Lindex) 0;
- i = Lnext(i,b->b_succ)) {
- x = (bblock_p) Lelem(i);
- Lremove(s,&x->b_pred);
- Ladd(b,&x->b_pred);
- if (x->b_idom == s) {
- x->b_idom = b;
- }
- }
- mv_code(s,b);
- s->b_start = l;
- }
- }
-}
-
-STATIC bo_extproc(p)
- proc_p p;
-{
- /* Allocate the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
- register bblock_p b;
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- lp->lp_extend = newralpx();
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- b->b_extend = newrabx();
- }
-}
-
-
-STATIC loop_blocks(p)
- proc_p p;
-{
- /* Compute the LP_BLOCKS sets for all loops of p */
-
- register bblock_p b;
- register Lindex i;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (i = Lfirst(b->b_loops); i != (Lindex) 0;
- i = Lnext(i,b->b_loops)) {
- Ladd(b,&(((loop_p) Lelem(i))->LP_BLOCKS));
- }
- }
-}
-
-STATIC bo_cleanproc(p)
- proc_p p;
-{
- /* Allocate the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
- register bblock_p b;
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- oldralpx(lp->lp_extend);
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- oldrabx(b->b_extend);
- }
-}
-
-bo_optimize(p)
- proc_p p;
-{
- bblock_p b;
-
- bo_extproc(p);
- loop_blocks(p);
- bo_loops(p);
- for (b = p->p_start; b != 0; b = b->b_next) {
- bo_switch(b);
- }
- bo_cleanproc(p);
-}
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,no_action,bo_optimize,no_action,no_action);
- report("branch optimizations", Sbo);
- exit(0);
-}
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=
-SHARE=../share
-CA=.
-OBJECTS=ca.o ca_put.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/aux.o $(SHARE)/debug.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/files.o $(SHARE)/map.o
-SRC=ca.h ca_put.h ca.c ca_put.c
-
-all: $(OBJECTS)
-ca: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o ca -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-ca.o: ../share/alloc.h
-ca.o: ../share/debug.h
-ca.o: ../share/files.h
-ca.o: ../share/get.h
-ca.o: ../share/global.h
-ca.o: ../share/lset.h
-ca.o: ../share/map.h
-ca.o: ../share/types.h
-ca.o: ca.h
-ca.o: ca_put.h
-ca_put.o: ../../../h/em_flag.h
-ca_put.o: ../../../h/em_mes.h
-ca_put.o: ../../../h/em_mnem.h
-ca_put.o: ../../../h/em_pseu.h
-ca_put.o: ../../../h/em_spec.h
-ca_put.o: ../share/alloc.h
-ca_put.o: ../share/debug.h
-ca_put.o: ../share/def.h
-ca_put.o: ../share/map.h
-ca_put.o: ../share/types.h
-ca_put.o: ca.h
+++ /dev/null
-/*
- * C O M P A C T A S S E M B L Y L A N G U A G E G E N E R A T I O N
- *
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "ca.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/files.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/get.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mes.h"
-#include "ca_put.h"
-
-
-/* This phase transforms the Intermediate Code of the global optimizer
- * to 'standard' compact assembly language, which will be processed
- * by the code generator.
- */
-
-
-short dlength;
-dblock_p *dmap;
-
-char **dnames, **pnames; /* Dynamically allocated arrays of strings.
- * pnames[i] contains a pointer to the name
- * of the procedure with proc_id i.
- */
-
-
-STATIC char **newnametab(tablen,namelen)
- short tablen,namelen;
-{
- register char **np, **tab;
-
- tab = (char **) newmap(tablen);
- for (np = &tab[1]; np <= &tab[tablen]; np++) {
- *np = (char *) newcore(namelen);
- }
- return tab;
-}
-
-
-STATIC line_p get_ca_lines(lf,p_out)
- FILE *lf;
- proc_p *p_out;
-{
- /* Read lines of EM text and link them.
- * Register messages are outputted immediately after the PRO.
- */
-
- line_p head, *pp, l;
- line_p headm, *mp;
- arg_p a;
-
- curinp = lf; /* EM input file */
- pp = &head;
- mp = &headm;
- headm = (line_p) 0;
- while (TRUE) {
- l = read_line(p_out);
- if (feof(curinp)) break;
- assert (l != (line_p) 0);
- if (INSTR(l) == ps_end && INSTR(head) != ps_pro) {
- /* Delete end pseudo after data-unit */
- oldline(l);
- break;
- }
- if (INSTR(l) == ps_mes && l->l_a.la_arg->a_a.a_offset == ms_reg) {
- /* l is a register message */
- if (l->l_a.la_arg->a_next == (arg_p) 0) {
- /* register message without arguments */
- oldline(l);
- } else {
- *mp = l;
- mp = &l->l_next;
- }
- } else {
- *pp = l;
- pp = &l->l_next;
- }
- if (INSTR(l) == ps_end) {
- break;
- }
- }
- *pp = (line_p) 0;
- if (INSTR(head) == ps_pro) {
- /* append register message without arguments to list */
- l = newline(OPLIST);
- l->l_instr = ps_mes;
- a = ARG(l) = newarg(ARGOFF);
- a->a_a.a_offset = ms_reg;
- *mp = l;
- l->l_next = head->l_next;
- head->l_next = headm;
- } else {
- assert(headm == (line_p) 0);
- }
- return head;
-}
-
-STATIC int makedmap(dbl)
- dblock_p dbl;
-{
- /* construct the dmap table */
-
- dblock_p d;
- int cnt;
-
- /* determine the length of the table */
-
- cnt = 0;
- for (d = dbl; d != (dblock_p) 0; d = d->d_next) cnt++;
- dmap = (dblock_p *) newmap(cnt);
- for (d = dbl; d != (dblock_p) 0; d = d->d_next) {
- assert(d->d_id) <= cnt;
- dmap[d->d_id] = d;
- }
- return cnt;
-}
-
-
-
-STATIC getdnames(dumpd)
- FILE *dumpd;
-{
- /* Read the names of the datalabels from
- * the dump file.
- */
-
- char str[IDL+1];
- char *s;
- int id;
- register int i;
-
- dnames = (char **) newnametab(dlength,IDL);
- for (;;) {
- if (fscanf(dumpd,"%d %s",&id,str) == EOF) return;
- assert(id <= dlength);
- s = dnames[id];
- for (i = 0; i < IDL; i++) {
- *s++ = str[i];
- }
- }
-}
-
-STATIC getpnames(dumpp)
- FILE *dumpp;
-{
- /* Read the names of the procedures from
- * the dump file.
- */
-
- char str[IDL+1];
- char *s;
- int id;
- register int i;
-
- pnames = (char **) newnametab(plength,IDL);
- for (;;) {
- if (fscanf(dumpp,"%d %s",&id,str) == EOF) return;
- assert(id <= plength);
- s = pnames[id];
- for (i = 0; i < IDL; i++) {
- *s++ = str[i];
- }
- }
-}
-
-
-STATIC bool name_exists(name,endp,endd)
- char *name;
- proc_p endp;
- dblock_p endd;
-{
- /* Search the proctable (from fproc to endp)
- * and the data block table (from fdblock to endd)
- * to see if the name is already in use.
- */
-
- proc_p p;
- dblock_p d;
-
- for (p = fproc; p != endp; p = p->p_next) {
- if (strncmp(name,pnames[p->p_id],IDL) == 0) return TRUE;
- }
- for (d = fdblock; d != endd; d = d->d_next) {
- if (strncmp(name,dnames[d->d_id],IDL) == 0) return TRUE;
- }
- return FALSE;
-}
-
-
-
-static int nn = 0;
-
-STATIC new_name(s)
- char *s;
-{
- s[0] = '_';
- s[1] = 'I';
- s[2] = 'I';
- sprintf(&s[3],"%d",nn);
- nn++;
-}
-
-
-
-STATIC uniq_names()
-{
- /* The names of all internal procedures and data blocks
- * are made different. As the optimizer combines several
- * modules into one, there may be name conflicts between
- * procedures or data blocks that were internal in
- * different source modules.
- */
-
- proc_p p;
- dblock_p d;
-
- for (p = fproc; p != (proc_p) 0; p = p->p_next) {
- if (!(p->p_flags1 & PF_EXTERNAL) &&
- name_exists(pnames[p->p_id],p,fdblock)) {
- new_name(pnames[p->p_id]);
- }
- }
- for (d = fdblock; d != (dblock_p) 0; d = d->d_next) {
- if (!(d->d_flags1 & DF_EXTERNAL) &&
- name_exists(dnames[d->d_id],(proc_p) 0,d) ) {
- new_name(dnames[d->d_id]);
- }
- }
-}
-main(argc,argv)
- int argc;
- char *argv[];
-{
- /* CA does not output proctable etc. files. Instead, its
- * pname2 and dname2 arguments contain the names of the
- * dump files created by IC.
- */
- FILE *f, *f2; /* The EM input and output. */
- FILE *df, *pf; /* The dump files */
- line_p lnp;
-
- fproc = getptable(pname); /* proc table */
- fdblock = getdtable(dname); /* data block table */
- dlength = makedmap(fdblock); /* allocate dmap table */
- df = openfile(dname2,"r");
- getdnames(df);
- fclose(df);
- pf = openfile(pname2,"r");
- getpnames(pf);
- fclose(pf);
- uniq_names();
- f = openfile(lname,"r");
- f2 = stdout;
- cputmagic(f2); /* write magic number */
- while ((lnp = get_ca_lines(f,&curproc)) != (line_p) 0) {
- cputlines(lnp,f2);
- }
- fclose(f);
- fclose(f2);
- exit(0);
-}
+++ /dev/null
-/*
- * C O M P A C T A S S E M B L Y L A N G U A G E G E N E R A T I O N
- *
- */
-
-
-#define PF_SYMOUT 01
-#define DF_SYMOUT 01
-
-extern dblock_p *dmap;
-
-extern char **dnames;
-extern char **pnames;
-
-extern byte em_flag[];
+++ /dev/null
-#include <stdio.h>
-#include "../share/types.h"
-#include "ca.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/map.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_flag.h"
-#include "../../../h/em_mes.h"
-#include "../share/alloc.h"
-
-#define outbyte(b) putc(b,outfile)
-
-FILE *outfile;
-
-STATIC proc_p thispro;
-
-STATIC outinst(m) {
-
- outbyte( (byte) m );
-}
-
-STATIC coutshort(i) short i; {
-
- outbyte( (byte) (i&BMASK) );
- outbyte( (byte) (i>>8) );
-}
-
-STATIC coutint(i) short i; {
-
- if (i>= -sp_zcst0 && i< sp_ncst0-sp_zcst0)
- outbyte( (byte) (i+sp_zcst0+sp_fcst0) );
- else {
- outbyte( (byte) sp_cst2) ;
- coutshort(i);
- }
-}
-
-STATIC coutoff(off) offset off; {
-
- if ((short) off == off)
- coutint((short) off);
- else {
- outbyte( (byte) sp_cst4) ;
- coutshort( (short) (off&0177777L) );
- coutshort( (short) (off>>16) );
- }
-}
-
-
-STATIC outsym(s,t)
- char *s;
- int t;
-{
- register byte *p;
- register unsigned num;
-
- if (s[0] == '.') {
- num = atoi(&s[1]);
- if (num < 256) {
- outbyte( (byte) sp_dlb1) ;
- outbyte( (byte) (num) );
- } else {
- outbyte( (byte) sp_dlb2) ;
- coutshort((short) num);
- }
- } else {
- p= s;
- while (*p && p < &s[IDL])
- p++;
- num = p - s;
- outbyte( (byte) t);
- coutint((short) num);
- p = s;
- while (num--)
- outbyte( (byte) *p++ );
- }
-}
-
-
-STATIC outdsym(dbl)
- dblock_p dbl;
-{
- outsym(dnames[dbl->d_id],sp_dnam);
-}
-
-
-STATIC outpsym(p)
- proc_p p;
-{
- outsym(pnames[p->p_id],sp_pnam);
-}
-
-
-STATIC outddef(id) short id; {
-
- dblock_p dbl;
-
- dbl = dmap[id];
- dbl->d_flags2 |= DF_SYMOUT;
- if (dbl->d_flags1 & DF_EXTERNAL) {
- outinst(ps_exa);
- outdsym(dbl);
- }
-}
-
-STATIC outpdef(p) proc_p p; {
- p->p_flags2 |= PF_SYMOUT;
- if (p->p_flags1 & PF_EXTERNAL) {
- outinst(ps_exp);
- outpsym(p);
- }
-}
-
-
-STATIC outdocc(obj) obj_p obj; {
- dblock_p dbl;
-
- dbl = obj->o_dblock;
- if ((dbl->d_flags2 & DF_SYMOUT) == 0) {
- dbl->d_flags2 |= DF_SYMOUT;
- if ((dbl->d_flags1 & DF_EXTERNAL) == 0) {
- outinst(ps_ina);
- outdsym(dbl);
- }
- }
-}
-
-
-STATIC outpocc(p) proc_p p; {
- if ((p->p_flags2 & PF_SYMOUT) == 0) {
- p->p_flags2 |= PF_SYMOUT;
- if ((p->p_flags1 & PF_EXTERNAL) == 0) {
- outinst(ps_inp);
- outpsym(p);
- }
- }
-}
-
-
-STATIC coutobject(obj)
- obj_p obj;
-{
- /* In general, an object is defined by a global data
- * label and an offset. There are two special cases:
- * the label is omitted if the object is part of the current
- * hol block; the offset is omitted if it is 0 and the label
- * was not omitted.
- */
- if (dnames[obj->o_dblock->d_id][0] == '\0') {
- coutoff(obj->o_off);
- } else {
- if (obj->o_off == 0) {
- outdsym(obj->o_dblock);
- } else {
- outbyte((byte) sp_doff);
- outdsym(obj->o_dblock);
- coutoff(obj->o_off);
- }
- }
-}
-
-
-STATIC cputstr(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;
- }
- coutint(length);
- while (abp != (argb_p) 0) {
- for (length=0;length<abp->ab_index;length++)
- outbyte( (byte) abp->ab_contents[length] );
- abp = abp->ab_next;
- }
-}
-
-
-STATIC outnum(n)
- int n;
-{
- if (n < 256) {
- outbyte((byte) sp_ilb1);
- outbyte((byte) n);
- } else {
- outbyte((byte) sp_ilb2);
- coutshort((short) n);
- }
-}
-
-
-STATIC numlab(n)
- int n;
-{
- if (n < sp_nilb0) {
- outbyte((byte) (n + sp_filb0));
- } else {
- outnum(n);
- }
-}
-
-
-STATIC cputargs(lnp)
- line_p lnp;
-{
- register arg_p ap;
- int cnt = 0;
- ap = ARG(lnp);
- while (ap != (arg_p) 0) {
- switch(ap->a_type) {
- case ARGOFF:
- coutoff(ap->a_a.a_offset);
- break;
- case ARGOBJECT:
- coutobject(ap->a_a.a_obj);
- break;
- case ARGPROC:
- outpsym(ap->a_a.a_proc);
- break;
- case ARGINSTRLAB:
- outnum(ap->a_a.a_instrlab);
- break;
- case ARGSTRING:
- outbyte((byte) sp_scon);
- cputstr(&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:
- coutint(ap->a_a.a_con.ac_length);
- cputstr(&ap->a_a.a_con.ac_con);
- break;
- default:
- assert(FALSE);
- }
- ap = ap->a_next;
- /* Avoid generating extremely long CON or ROM statements */
- if (cnt++ > 10 && ap != (arg_p) 0 &&
- (INSTR(lnp) == ps_con || INSTR(lnp) == ps_rom)) {
- cnt = 0;
- outbyte((byte) sp_cend);
- outinst(INSTR(lnp));
- }
- }
-}
-
-
-
-STATIC outoperand(lnp)
- line_p lnp;
-{
- /* Output the operand of instruction lnp */
-
- switch(TYPE(lnp)) {
- case OPNO:
- if ((em_flag[INSTR(lnp)-sp_fmnem]&EM_PAR) != PAR_NO) {
- outbyte((byte) sp_cend);
- }
- break;
- case OPSHORT:
- if (INSTR(lnp) == ps_sym) {
- outsym(dnames[SHORT(lnp)],sp_dnam);
- } else {
- coutint(SHORT(lnp));
- }
- break;
- case OPOFFSET:
- coutoff(OFFSET(lnp));
- break;
- case OPINSTRLAB:
- if (INSTR(lnp) == op_lab) {
- numlab(INSTRLAB(lnp));
- } else {
- if (INSTR(lnp) < sp_fpseu) {
- coutint(INSTRLAB(lnp));
- } else {
- numlab(INSTRLAB(lnp));
- }
- }
- break;
- case OPOBJECT:
- coutobject(OBJ(lnp));
- break;
- case OPPROC:
- outpsym(PROC(lnp));
- break;
- case OPLIST:
- cputargs(lnp);
- switch(INSTR(lnp)) {
- case ps_con:
- case ps_rom:
- case ps_mes:
- outbyte((byte) sp_cend);
- /* list terminator */
- break;
- }
- break;
- default:
- assert(FALSE);
- }
-}
-
-
-STATIC outvisibility(lnp)
- line_p lnp;
-{
- /* In EM names of datalabels and procedures can be made
- * externally visible, so they can be used in other files.
- * There are special EM pseudo-instructions to state
- * explicitly that a certain identifier is externally
- * visible (ps_exa,ps_exp) or invisible (ps_ina,ps_inp).
- * If there is no such pseudo for a certain identifier,
- * the identifier is external only if its first use
- * in the current file is an applied occurrence.
- * Unfortunately the global optimizer may change the
- * order of defining and applied occurrences.
- * In the first optimizer pass (ic) we record for each identifier
- * whether it is external or not. If necessary we generate
- * pseudo instructions here.
- */
-
- arg_p ap;
- short instr;
-
- instr = INSTR(lnp);
- switch(TYPE(lnp)) {
- case OPOBJECT:
- outdocc(OBJ(lnp));
- /* applied occurrence of a data label */
- break;
- case OPSHORT:
- if (instr == ps_sym) {
- outddef(SHORT(lnp));
- /* defining occ. data label */
- }
- break;
- case OPPROC:
- if (instr == ps_pro) {
- outpdef(PROC(lnp));
- /* defining occ. procedure */
- } else {
- outpocc(PROC(lnp));
- }
- break;
- case OPLIST:
- for (ap = ARG(lnp); ap != (arg_p) 0; ap = ap->a_next) {
- switch(ap->a_type) {
- case ARGOBJECT:
- outdocc(ap->a_a.a_obj);
- break;
- case ARGPROC:
- outpocc(ap->a_a.a_proc);
- break;
- }
- }
- break;
- }
-}
-
-
-cputlines(l,lf)
- line_p l;
- FILE *lf;
-{
- /* Output the lines in Campact assembly language
- * format.
- */
-
- line_p next,lnp;
-
- outfile = lf;
- for (lnp = l; lnp != (line_p) 0; lnp = next) {
- next = lnp->l_next;
- outvisibility(lnp); /* take care of visibiltity rules */
- if (INSTR(lnp) != ps_sym && INSTR(lnp) != op_lab) {
- outinst(INSTR(lnp));
- }
- outoperand(lnp);
- switch(INSTR(lnp)) {
- case ps_pro:
- thispro = PROC(lnp);
- /* fall through ... */
- case ps_end:
- coutoff(thispro->p_localbytes);
- }
- oldline(lnp);
- }
- if (thispro != (proc_p) 0) {
- oldmap(lmap,llength);
- }
-}
-
-cputmagic(lf)
- FILE *lf;
-{
- /* write the magic number */
-
- outfile = lf;
- coutshort(sp_magic);
-}
+++ /dev/null
-/* C O M P A C T A S S E M B L Y G E N E R A T I O N
- *
- * C A _ P U T . C
- *
- */
-
-
-extern cputlines();
-extern cputmagic();
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=
-SHARE=../share
-CF=.
-OBJECTS=cf.o cf_idom.o cf_loop.o cf_succ.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o
-SRC=cf.h cf_succ.h cf_idom.h cf_loop.h cf.c cf_succ.c cf_idom.c cf_loop.c
-all: $(OBJECTS)
-cf: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o cf -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-cf.o: ../../../h/em_mnem.h
-cf.o: ../share/alloc.h
-cf.o: ../share/cset.h
-cf.o: ../share/debug.h
-cf.o: ../share/files.h
-cf.o: ../share/get.h
-cf.o: ../share/global.h
-cf.o: ../share/lset.h
-cf.o: ../share/map.h
-cf.o: ../share/put.h
-cf.o: ../share/types.h
-cf.o: cf.h
-cf.o: cf_idom.h
-cf.o: cf_loop.h
-cf.o: cf_succ.h
-cf_idom.o: ../share/alloc.h
-cf_idom.o: ../share/debug.h
-cf_idom.o: ../share/lset.h
-cf_idom.o: ../share/types.h
-cf_idom.o: cf.h
-cf_loop.o: ../share/alloc.h
-cf_loop.o: ../share/debug.h
-cf_loop.o: ../share/lset.h
-cf_loop.o: ../share/types.h
-cf_loop.o: cf.h
-cf_succ.o: ../../../h/em_flag.h
-cf_succ.o: ../../../h/em_mnem.h
-cf_succ.o: ../../../h/em_pseu.h
-cf_succ.o: ../../../h/em_spec.h
-cf_succ.o: ../share/cset.h
-cf_succ.o: ../share/debug.h
-cf_succ.o: ../share/def.h
-cf_succ.o: ../share/global.h
-cf_succ.o: ../share/lset.h
-cf_succ.o: ../share/map.h
-cf_succ.o: ../share/types.h
-cf_succ.o: cf.h
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * M A I N R O U T I N E
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/map.h"
-#include "../share/files.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../../../h/em_mnem.h"
-#include "cf.h"
-#include "cf_succ.h"
-#include "cf_idom.h"
-#include "cf_loop.h"
-
-#define nexcfbx() (bext_p) newstruct(bext_cf)
-#define oldcfbx(x) oldstruct(bext_cf,x)
-
-STATIC cset lpi_set; /* set of procedures used in LPI instruction */
-STATIC cset cai_set; /* set of all procedures doing a CAI */
-
-
-/* The procedure getbblocks reads the EM textfile and
- * partitions every procedure into a number of basic blocks.
- */
-
-#define LABEL0 0
-#define LABEL 1
-#define NORMAL 2
-#define JUMP 3
-#define END 4
-#define AFTERPRO 5
-#define INIT 6
-
-
-/* These global variables are used by getbblocks and nextblock. */
-
-STATIC bblock_p b, *bp; /* b is the current basic block, bp is
- * the address where the next block has
- * to be linked.
- */
-STATIC line_p lnp, *lp; /* lnp is the current line, lp is
- * the address where the next line
- * has to be linked.
- */
-STATIC short state; /* We use a finite state machine with the
- * following states:
- * LABEL0: after the first (successive)
- * instruction label.
- * LABEL1: after at least two successive
- * instruction labels.
- * NORMAL: after a normal instruction.
- * JUMP: after a branch (conditional,
- * unconditional or CSA/CSB).
- * END: after an END pseudo
- * AFTERPRO: after we've read a PRO pseudo
- * INIT: initial state
- */
-
-
-STATIC nextblock()
-{
- /* allocate a new basic block structure and
- * set b, bp and lp.
- */
-
- b = *bp = freshblock();
- bp = &b->b_next;
- b->b_start = lnp;
- b->b_succ = Lempty_set();
- b->b_pred = Lempty_set();
- b->b_extend = newcfbx(); /* basic block extension for CF */
- b->b_extend->bx_cf.bx_bucket = Lempty_set();
- b->b_extend->bx_cf.bx_semi = 0;
- lp = &lnp->l_next;
-#ifdef TRACE
- fprintf(stderr,"new basic block, id = %d\n",lastbid);
-#endif
-}
-
-
-STATIC short kind(lnp)
- line_p lnp;
-{
- /* determine if lnp is a label, branch, end or otherwise */
-
- short instr;
- byte flow;
-
- if ((instr = INSTR(lnp)) == op_lab) return (short) LABEL;
- if (instr == ps_end) return (short) END;
- if (instr > sp_lmnem) return (short) NORMAL; /* pseudo */
- if ((flow = (em_flag[instr-sp_fmnem] & EM_FLO)) == FLO_C ||
- flow == FLO_T) return (short) JUMP; /* conditional/uncond. jump */
- return (short) NORMAL;
-}
-
-
-
-STATIC bool getbblocks(fp,kind_out,n_out,g_out,l_out)
- FILE *fp;
- short *kind_out;
- short *n_out;
- bblock_p *g_out;
- line_p *l_out;
-{
- bblock_p head = (bblock_p) 0;
- line_p headl = (line_p) 0;
-
- curproc = (proc_p) 0;
- /* curproc will get a value when we encounter a PRO pseudo.
- * If there is no such pseudo, we're reading only data
- * declarations or messages (outside any proc.).
- */
- curinp = fp;
- lastbid = (block_id) 0; /* block identier */
- state = INIT; /* initial state */
- bp = &head;
-
- for (;;) {
-#ifdef TRACE
- fprintf(stderr,"state = %d\n",state);
-#endif
- switch(state) {
- case LABEL0:
- nextblock();
- /* Fall through !! */
- case LABEL:
- lbmap[INSTRLAB(lnp)] = b;
- /* The lbmap table contains for each
- * label_id the basic block of that label.
- */
- lnp = read_line(&curproc);
- state = kind(lnp);
- if (state != END) {
- *lp = lnp;
- lp = &lnp->l_next;
- }
- break;
- case NORMAL:
- lnp = read_line(&curproc);
- if ( (state = kind(lnp)) == LABEL) {
- /* If we come accross a label
- * here, it must be the beginning
- * of a new basic block.
- */
- state = LABEL0;
- } else {
- if (state != END) {
- *lp = lnp;
- lp = &lnp->l_next;
- }
- }
- break;
- case JUMP:
- lnp = read_line(&curproc);
- /* fall through ... */
- case AFTERPRO:
- switch(state = kind(lnp)) {
- case LABEL:
- state = LABEL0;
- break;
- case JUMP:
- case NORMAL:
- nextblock();
- break;
- }
- break;
- case END:
- *lp = lnp;
-#ifdef TRACE
- fprintf(stderr,"at end of proc, %d blocks\n",lastbid);
-#endif
- if (head == (bblock_p) 0) {
- *kind_out = LDATA;
- *l_out = headl;
- } else {
- *kind_out = LTEXT;
- *g_out = head;
- *n_out = (short) lastbid;
- /* number of basic blocks */
- }
- return TRUE;
- case INIT:
- lnp = read_line(&curproc);
- if (feof(curinp)) return FALSE;
- if (INSTR(lnp) == ps_pro) {
- state = AFTERPRO;
- } else {
- state = NORMAL;
- headl = lnp;
- lp = &lnp->l_next;
- }
- break;
- }
- }
-}
-
-
-STATIC interproc_analysis(p)
- proc_p p;
-{
- /* Interprocedural analysis of a procedure p determines:
- * - all procedures called by p (the 'call graph')
- * - the set of objects changed by p (directly)
- * - whether p does a load-indirect (loi,lof etc.)
- * - whether p does a store-indirect (sti, stf etc.)
- * The changed/used variables information will be
- * transitively closed, i.e. if P calls Q and Q changes
- * a variable X, the P changes X too.
- * (The same applies for used variables and for use/store
- * indirect).
- * The transitive closure will be computed by main
- * after all procedures have been processed.
- */
-
- bblock_p b;
- line_p lnp;
- bool inloop;
-
- /* Allocate memory for structs and sets */
-
- p->p_use = newuse();
- p->p_change = newchange();
- p->p_change->c_ext = Cempty_set(olength);
- p->p_calling = Cempty_set(plength);
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- inloop = (Lnrelems(b->b_loops) > 0);
- for (lnp = b->b_start; lnp != (line_p) 0; lnp = lnp->l_next) {
- /* for all instructions of p do */
- switch(INSTR(lnp)) {
- case op_cal:
- Cadd(PROC(lnp)->p_id, &p->p_calling);
- /* add called proc to p_calling */
- if (inloop) {
- CALLED_IN_LOOP(PROC(lnp));
- }
- break;
- case op_cai:
- Cadd(p->p_id,&cai_set);
- break;
- case op_lpi:
- Cadd(PROC(lnp)->p_id, &lpi_set);
- /* All procedures that have their names used
- * in an lpi instruction, may be called via
- * a cai instruction.
- */
- PROC(lnp)->p_flags1 |= PF_LPI;
- break;
- case op_ste:
- case op_sde:
- case op_ine:
- case op_dee:
- case op_zre:
- Cadd(OBJ(lnp)->o_id, &p->p_change->c_ext);
- /* Add changed object to c_ext */
- break;
- case op_lil:
- case op_lof:
- case op_loi:
- case op_los:
- case op_lar:
- p->p_use->u_flags |= UF_INDIR;
- /* p does a load-indirect */
- break;
- case op_sil:
- case op_stf:
- case op_sti:
- case op_sts:
- case op_sar:
- p->p_change->c_flags |= CF_INDIR;
- /* p does a store-indirect */
- break;
- case op_blm:
- case op_bls:
- p->p_use->u_flags |= UF_INDIR;
- p->p_change->c_flags |= CF_INDIR;
- /* p does both */
- break;
- case op_mon:
- printf("mon not yet implemented\n");
- break;
- case op_lxl:
- case op_lxa:
- curproc->p_flags1 |= PF_ENVIRON;
- break;
- }
- }
- }
-}
-
-
-STATIC cf_cleanproc(p)
- proc_p p;
-{
- /* Remove the extended data structures of p */
-
- register bblock_p b;
- register Lindex pi;
- loop_p lp;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- oldcfbx(b->b_extend);
- }
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0; pi = Lnext(pi,
- p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- oldcflpx(lp->lp_extend);
- }
-}
-
-
-
-#define CHANGE_INDIR(ch) ((ch->c_flags & CF_INDIR) != 0)
-#define USE_INDIR(us) ((us->u_flags & UF_INDIR) != 0)
-#define CALLS_UNKNOWN(p) (p->p_flags1 & (byte) PF_CALUNKNOWN)
-#define BODY_KNOWN(p) (p->p_flags1 & (byte) PF_BODYSEEN)
-#define ENVIRON(p) (p->p_flags1 & (byte) PF_ENVIRON)
-
-
-STATIC bool add_info(q,p)
- proc_p q,p;
-{
- /* Determine the consequences for used/changed variables info
- * of the fact that p calls q. If e.g. q changes a variable X
- * then p changes this variable too. This routine is an
- * auxiliary routine of the transitive closure process.
- * The returned value indicates if there was any change in
- * the information of p.
- */
-
- change_p chp, chq;
- use_p usp, usq;
- bool diff = FALSE;
-
- chp = p->p_change;
- chq = q->p_change;
- usp = p->p_use;
- usq = q->p_use;
-
- if (!BODY_KNOWN(q)) {
- /* q is a procedure of which the body is not available
- * as EM text.
- */
- if (CALLS_UNKNOWN(p)) {
- return FALSE;
- /* p already called an unknown procedure */
- } else {
- p->p_flags1 |= PF_CALUNKNOWN;
- return TRUE;
- }
- }
- if (CALLS_UNKNOWN(q)) {
- /* q calls a procedure of which the body is not available
- * as EM text.
- */
- if (!CALLS_UNKNOWN(p)) {
- p->p_flags1 |= PF_CALUNKNOWN;
- diff = TRUE;
- }
- }
- if (IS_CALLED_IN_LOOP(p) && !IS_CALLED_IN_LOOP(q)) {
- CALLED_IN_LOOP(q);
- diff = TRUE;
- }
- if (!Cis_subset(chq->c_ext, chp->c_ext)) {
- /* q changes global variables (objects) that
- * p did not (yet) change. Add all variables
- * changed by q to the c_ext set of p.
- */
- Cjoin(chq->c_ext, &chp->c_ext);
- diff = TRUE;
- }
- if (CHANGE_INDIR(chq) && !CHANGE_INDIR(chp)) {
- /* q does a change-indirect (sil etc.)
- * and p did not (yet).
- */
- chp->c_flags |= CF_INDIR;
- diff = TRUE;
- }
- if (USE_INDIR(usq) && !USE_INDIR(usp)) {
- /* q does a use-indirect (lil etc.)
- * and p dis not (yet).
- */
- usp->u_flags |= UF_INDIR;
- diff = TRUE;
- }
- if (ENVIRON(q) && !ENVIRON(p)) {
- /* q uses or changes local variables in its
- * environment while p does not (yet).
- */
- p->p_flags1 |= PF_ENVIRON;
- diff = TRUE;
- }
- return diff;
-}
-
-
-
-STATIC trans_clos(head)
- proc_p head;
-{
- /* Compute the transitive closure of the used/changed
- * variable information.
- */
-
- register proc_p p,q;
- Cindex i;
- bool changes = TRUE;
-
- while(changes) {
- changes = FALSE;
- for (p = head; p != (proc_p) 0; p = p->p_next) {
- if (!BODY_KNOWN(p)) continue;
- for (i = Cfirst(p->p_calling); i != (Cindex) 0;
- i = Cnext(i,p->p_calling)) {
- q = pmap[Celem(i)];
- if (add_info(q,p)) {
- changes = TRUE;
- }
- }
- }
- }
-}
-
-
-
-
-indir_calls()
-{
- Cindex i;
- proc_p p;
-
- for (i = Cfirst(cai_set); i != (Cindex) 0; i = Cnext(i,cai_set)) {
- p = pmap[Celem(i)]; /* p does a CAI */
- Cjoin(lpi_set, &p->p_calling);
- }
- Cdeleteset(lpi_set);
- Cdeleteset(cai_set);
-}
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- FILE *f, *f2, *gf2; /* The EM input, EM output, basic block output */
- bblock_p g;
- short n, kind;
- line_p l;
-
- linecount = 0;
- fproc = getptable(pname); /* proc table */
- fdblock = getdtable(dname); /* data block table */
- lpi_set = Cempty_set(plength);
- cai_set = Cempty_set(plength);
- if ((f = fopen(lname,"r")) == NULL) {
- error("cannot open %s", lname);
- }
- if ((f2 = fopen(lname2,"w")) == NULL) {
- error("cannot open %s", lname2);
- }
- if ((gf2 = fopen(bname2,"w")) == NULL) {
- error("cannot open %s",bname2);
- }
- while (getbblocks(f,&kind,&n,&g,&l)) {
- /* read EM text of one unit and
- * (if it is a procedure)
- * partition it into n basic blocks.
- */
- if (kind == LDATA) {
- putunit(LDATA,(proc_p) 0,l,gf2,f2);
- } else {
- curproc->p_start = g;
- /* The global variable curproc points to the
- * current procedure. It is set by getbblocks
- */
- control_flow(g); /* compute pred and succ */
- dominators(g,n); /* compute immediate dominators */
- loop_detection(curproc); /* compute loops */
- interproc_analysis(curproc);
- /* Interprocedural analysis */
- cf_cleanproc(curproc);
- putunit(LTEXT,curproc,(line_p) 0,gf2,f2);
- /* output control flow graph + text */
- }
- }
- fclose(f);
- fclose(f2);
- fclose(gf2);
- indir_calls();
- trans_clos(fproc);
- /* Compute transitive closure of used/changed
- * variables information for every procedure.
- */
- if ((f = fopen(dname2,"w")) == NULL) {
- error("cannot open %s",dname2);
- }
- putdtable(fdblock,f);
- if ((f = fopen(pname2,"w")) == NULL) {
- error("cannot open %s",pname2);
- }
- putptable(fproc,f,TRUE);
- exit(0);
-}
+++ /dev/null
-/* C O N T R O L F L O W */
-
-/* Macro's for extended data structures: */
-
-#define B_SEMI b_extend->bx_cf.bx_semi
-#define B_PARENT b_extend->bx_cf.bx_parent
-#define B_BUCKET b_extend->bx_cf.bx_bucket
-#define B_ANCESTOR b_extend->bx_cf.bx_ancestor
-#define B_LABEL b_extend->bx_cf.bx_label
-
-#define LP_BLOCKS lp_extend->lpx_cf.lpx_blocks
-#define LP_COUNT lp_extend->lpx_cf.lpx_count
-#define LP_MESSY lp_extend->lpx_cf.lpx_messy
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * C F _ I D O M . C
- */
-
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/lset.h"
-#include "../share/alloc.h"
-#include "cf.h"
-
-
-/* The algorithm for finding dominators in a flowgraph
- * that is used here, was developed by Thomas Lengauer
- * and Robert E. Tarjan of Stanford University.
- * The algorithm is described in their article:
- * A Fast Algorithm for Finding Dominators
- * in a Flowgraph
- * which was published in:
- * ACM Transactions on Programming Languages and Systems,
- * Vol. 1, No. 1, July 1979, Pages 121-141.
- */
-
-
-#define UNREACHABLE(b) (b->B_SEMI == (short) 0)
-
-short dfs_nr;
-bblock_p *vertex; /* dynamically allocated array */
-
-
-STATIC dfs(v)
- bblock_p v;
-{
- /* Depth First Search */
-
- Lindex i;
- bblock_p w;
-
- v->B_SEMI = ++dfs_nr;
- vertex[dfs_nr] = v->B_LABEL = v;
- v->B_ANCESTOR = (bblock_p) 0;
- for (i = Lfirst(v->b_succ); i != (Lindex) 0; i = Lnext(i,v->b_succ)) {
- w = (bblock_p) Lelem(i);
- if (w->B_SEMI == 0) {
- w->B_PARENT = v;
- dfs(w);
- }
- }
-}
-
-
-
-STATIC compress(v)
- bblock_p v;
-{
- if (v->B_ANCESTOR->B_ANCESTOR != (bblock_p) 0) {
- compress(v->B_ANCESTOR);
- if (v->B_ANCESTOR->B_LABEL->B_SEMI < v->B_LABEL->B_SEMI) {
- v->B_LABEL = v->B_ANCESTOR->B_LABEL;
- }
- v->B_ANCESTOR = v->B_ANCESTOR->B_ANCESTOR;
- }
-}
-
-
-
-STATIC bblock_p eval(v)
- bblock_p v;
-{
- if (v->B_ANCESTOR == (bblock_p) 0) {
- return v;
- } else {
- compress(v);
- return v->B_LABEL;
- }
-}
-
-
-
-STATIC linkblocks(v,w)
- bblock_p v,w;
-{
- w->B_ANCESTOR = v;
-}
-
-
-
-dominators(r,n)
- bblock_p r;
- short n;
-{
- /* Compute the immediate dominator of every basic
- * block in the control flow graph rooted by r.
- */
-
- register short i;
- Lindex ind, next;
- bblock_p v,w,u;
-
- dfs_nr = 0;
- vertex = (bblock_p *) newmap(n);
- /* allocate vertex (dynamic array). All remaining
- * initializations were done by the routine
- * nextblock of get.c.
- */
- dfs(r);
- for (i = dfs_nr; i > 1; i--) {
- w = vertex[i];
- for (ind = Lfirst(w->b_pred); ind != (Lindex) 0;
- ind = Lnext(ind,w->b_pred)) {
- v = (bblock_p) Lelem(ind);
- if (UNREACHABLE(v)) continue;
- u = eval(v);
- if (u->B_SEMI < w->B_SEMI) {
- w->B_SEMI = u->B_SEMI;
- }
- }
- Ladd(w,&(vertex[w->B_SEMI]->B_BUCKET));
- linkblocks(w->B_PARENT,w);
- for (ind = Lfirst(w->B_PARENT->B_BUCKET); ind != (Lindex) 0;
- ind = next) {
- next = Lnext(ind,w->B_PARENT->B_BUCKET);
- v = (bblock_p) Lelem(ind);
- Lremove(v,&w->B_PARENT->B_BUCKET);
- u = eval(v);
- v->b_idom = (u->B_SEMI < v->B_SEMI ? u : w->B_PARENT);
- }
- }
- for (i = 2; i <= dfs_nr; i++) {
- w = vertex[i];
- if (w->b_idom != vertex[w->B_SEMI]) {
- w->b_idom = w->b_idom->b_idom;
- }
- }
- r->b_idom = (bblock_p) 0;
- oldmap(vertex,n); /* release memory for dynamic array vertex */
-}
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * I M M E D I A T E D O M I N A T O R S
- */
-
-
-extern dominator(); /* (bblock_p head, short n)
- * Compute for every basic block its immediate
- * dominator. The dominator relation is hence
- * recorded as a tree in which every node contains
- * a pointer to its parent, which is its
- * immediate dominator.
- * 'n' is the number of nodes (basic blocks) in
- * the control flow graph.
- */
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * C F _ L O O P . C
- */
-
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/lset.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "cf.h"
-
-#define MARK_STRONG(b) b->b_flags |= BF_STRONG
-#define MARK_FIRM(b) b->b_flags |= BF_FIRM
-#define BF_MARK 04
-#define MARK(b) b->b_flags |= BF_MARK
-#define MARKED(b) (b->b_flags&BF_MARK)
-#define INSIDE_LOOP(b,lp) Lis_elem(b,lp->LP_BLOCKS)
-
-
-
-/* The algorithm to detect loops that is used here is taken
- * from: Aho & Ullman, Principles of Compiler Design, section 13.1.
- * The algorithm uses the dominator relation between nodes
- * of the control flow graph:
- * d DOM n => every path from the initial node to n goes through d.
- * The dominator relation is recorded via the immediate dominator tree
- * (b_idom field of bblock struct) from which the dominator relation
- * can be easily computed (see procedure 'dom' below).
- * The algorithm first finds 'back edges'. A back edge is an edge
- * a->b in the flow graph whose head (b) dominates its tail (a).
- * The 'natural loop' of back edge n->d consists of those nodes
- * that can reach n without going through d. These nodes, plus d
- * form the loop.
- * The whole process is rather complex, because different back edges
- * may result in the same loop and because loops may partly overlap
- * each other (without one being nested inside the other).
- */
-
-
-
-STATIC bool same_loop(l1,l2)
- loop_p l1,l2;
-{
- /* Two loops are the same if:
- * (1) they have the same number of basic blocks, and
- * (2) the head of the back edge of the first loop
- * also is part of the second loop, and
- * (3) the tail of the back edge of the first loop
- * also is part of the second loop.
- */
-
- return (l1->LP_COUNT == l2->LP_COUNT &&
- Lis_elem(l1->lp_entry, l2->LP_BLOCKS) &&
- Lis_elem(l1->lp_end, l2->LP_BLOCKS));
-}
-
-
-
-STATIC bool inner_loop(l1,l2)
- loop_p l1,l2;
-{
- /* Loop l1 is an inner loop of l2 if:
- * (1) the first loop has fewer basic blocks than
- * the second one, and
- * (2) the head of the back edge of the first loop
- * also is part of the second loop, and
- * (3) the tail of the back edge of the first loop
- * also is part of the second loop.
- */
-
- return (l1->LP_COUNT < l2->LP_COUNT &&
- Lis_elem(l1->lp_entry, l2->LP_BLOCKS) &&
- Lis_elem(l1->lp_end, l2->LP_BLOCKS));
-}
-
-
-
-STATIC insrt(b,lpb,s_p)
- bblock_p b;
- lset *lpb;
- lset *s_p;
-{
- /* Auxiliary routine used by 'natural_loop'.
- * Note that we use a set rather than a stack,
- * as Aho & Ullman do.
- */
-
- if (!Lis_elem(b,*lpb)) {
- Ladd(b,lpb);
- Ladd(b,s_p);
- }
-}
-
-
-STATIC loop_p natural_loop(d,n)
- bblock_p d,n;
-{
- /* Find the basic blocks of the natural loop of the
- * back edge 'n->d' (i.e. n->d is an edge in the control
- * flow graph and d dominates n). The natural loop consists
- * of those blocks which can reach n without going through d.
- * We find these blocks by finding all predecessors of n,
- * up to d.
- */
-
- loop_p lp;
- bblock_p m;
- lset loopblocks;
- Lindex pi;
- lset s;
-
- lp = newloop();
- lp->lp_extend = newcflpx();
- lp->lp_entry = d; /* loop entry block */
- lp->lp_end = n; /* tail of back edge */
- s = Lempty_set();
- loopblocks = Lempty_set();
- Ladd(d,&loopblocks);
- insrt(n,&loopblocks,&s);
- while ((pi = Lfirst(s)) != (Lindex) 0) {
- m = (bblock_p) Lelem(pi);
- Lremove(m,&s);
- for (pi = Lfirst(m->b_pred); pi != (Lindex) 0;
- pi = Lnext(pi,m->b_pred)) {
- insrt((bblock_p) Lelem(pi),&loopblocks,&s);
- }
- }
- lp->LP_BLOCKS = loopblocks;
- lp->LP_COUNT = Lnrelems(loopblocks);
- return lp;
-}
-
-
-STATIC loop_p org_loop(lp,loops)
- loop_p lp;
- lset loops;
-{
- /* See if the loop lp was already found via another
- * back edge; if so return this loop; else return 0.
- */
-
- register Lindex li;
-
- for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
- if (same_loop((loop_p) Lelem(li), lp)) {
-#ifdef DEBUG
- /* printf("messy loop found\n"); */
-#endif
- return (loop_p) Lelem(li);
- }
- }
- return (loop_p) 0;
-}
-
-
-
-STATIC collapse_loops(loops_p)
- lset *loops_p;
-{
- register Lindex li1, li2;
- register loop_p lp1,lp2;
-
- for (li1 = Lfirst(*loops_p); li1 != (Lindex) 0; li1 = Lnext(li1,*loops_p)) {
- lp1 = (loop_p) Lelem(li1);
- lp1->lp_level = (short) 0;
- for (li2 = Lfirst(*loops_p); li2 != (Lindex) 0;
- li2 = Lnext(li2,*loops_p)) {
- lp2 = (loop_p) Lelem(li2);
- if (lp1 != lp2 && lp1->lp_entry == lp2->lp_entry) {
- Ljoin(lp2->LP_BLOCKS,&lp1->LP_BLOCKS);
- oldcflpx(lp2->lp_extend);
- Lremove(lp2,loops_p);
- }
- }
- }
-}
-
-
-STATIC loop_per_block(lp)
- loop_p lp;
-{
- bblock_p b;
-
- /* Update the b_loops sets */
-
- register Lindex bi;
-
- for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
- bi = Lnext(bi,lp->LP_BLOCKS)) {
- b = (bblock_p) Lelem(bi);
- Ladd(lp,&(b->b_loops));
- }
-}
-
-
-
-STATIC loop_attrib(loops)
- lset loops;
-{
- /* Compute several attributes */
-
- register Lindex li;
- register loop_p lp;
- loop_id lastlpid = 0;
-
- for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
- lp = (loop_p) Lelem(li);
- lp->lp_id = ++lastlpid;
- loop_per_block(lp);
- }
-}
-
-
-
-STATIC nest_levels(loops)
- lset loops;
-{
- /* Compute the nesting levels of all loops of
- * the current procedure. For every loop we just count
- * all loops of which the former is an inner loop.
- * The running time is quadratic in the number of loops
- * of the current procedure. As this number tends to be
- * very small, there is no cause for alarm.
- */
-
- register Lindex li1, li2;
- register loop_p lp;
-
- for (li1 = Lfirst(loops); li1 != (Lindex) 0; li1 = Lnext(li1,loops)) {
- lp = (loop_p) Lelem(li1);
- lp->lp_level = (short) 0;
- for (li2 = Lfirst(loops); li2 != (Lindex) 0;
- li2 = Lnext(li2,loops)) {
- if (inner_loop(lp,(loop_p) Lelem(li2))) {
- lp->lp_level++;
- }
- }
- }
-}
-
-
-STATIC cleanup(loops)
- lset loops;
-{
- /* Throw away the LP_BLOCKS sets */
-
- register Lindex i;
-
- for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) {
- Ldeleteset(((loop_p) Lelem(i))->LP_BLOCKS);
- }
-}
-
-
-STATIC bool does_exit(b,lp)
- bblock_p b;
- loop_p lp;
-{
- /* See if b may exit the loop, i.e. if it
- * has a successor outside the loop
- */
-
- Lindex i;
-
- for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) {
- if (!INSIDE_LOOP(Lelem(i),lp)) return TRUE;
- }
- return FALSE;
-}
-
-
-STATIC mark_succ(b,lp)
- bblock_p b;
- loop_p lp;
-{
- Lindex i;
- bblock_p succ;
-
- for (i = Lfirst(b->b_succ); i != (Lindex) 0; i = Lnext(i,b->b_succ)) {
- succ = (bblock_p) Lelem(i);
- if (succ != b && succ != lp->lp_entry && INSIDE_LOOP(succ,lp) &&
- !MARKED(succ)) {
- MARK(succ);
- mark_succ(succ,lp);
- }
- }
-}
-
-
-STATIC mark_blocks(lp)
- loop_p lp;
-{
- /* Mark the strong and firm blocks of a loop.
- * The last set of blocks consists of the end-block
- * of the loop (i.e. the head of the back edge
- * of the natural loop) and its dominators
- * (including the loop entry block, i.e. the
- * tail of the back edge).
- */
-
- register bblock_p b;
-
- /* First mark all blocks that are the successor of a
- * block that may exit the loop (i.e. contains a
- * -possibly conditional- jump to somewhere outside
- * the loop.
- */
-
- if (lp->LP_MESSY) return; /* messy loops are hopeless cases */
- for (b = lp->lp_entry; b != (bblock_p) 0; b = b->b_next) {
- if (!MARKED(b) && does_exit(b,lp)) {
- mark_succ(b,lp);
- }
- }
-
- /* Now find all firm blocks. A block is strong
- * if it is firm and not marked.
- */
-
- for (b = lp->lp_end; ; b = b->b_idom) {
- MARK_FIRM(b);
- if (!MARKED(b)) {
- MARK_STRONG(b);
- }
- if (b == lp->lp_entry) break;
- }
-}
-
-
-
-STATIC mark_loopblocks(loops)
- lset loops;
-{
- /* Determine for all loops which basic blocks
- * of the loop are strong (i.e. are executed
- * during every iteration) and which blocks are
- * firm (i.e. executed during every iteration with
- * the only possible exception of the last one).
- */
-
- Lindex i;
- loop_p lp;
-
- for (i = Lfirst(loops); i != (Lindex) 0; i = Lnext(i,loops)) {
- lp = (loop_p) Lelem(i);
- mark_blocks(lp);
- }
-}
-
-
-
-loop_detection(p)
- proc_p p;
-{
- /* Find all natural loops of procedure p. Every loop is
- * assigned a unique identifying number, a set of basic
- * blocks, a loop entry block and a nesting level number.
- * Every basic block is assigned a nesting level number
- * and a set of loops it is part of.
- */
-
- lset loops; /* the set of all loops */
- loop_p lp,org;
- register bblock_p b;
- bblock_p s;
- Lindex si;
-
- loops = Lempty_set();
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (si = Lfirst(b->b_succ); si != (Lindex) 0;
- si = Lnext(si,b->b_succ)) {
- s = (bblock_p) Lelem(si);
- if (dom(s,b)) {
- /* 'b->s' is a back edge */
- lp = natural_loop(s,b);
- if ((org = org_loop(lp,loops)) == (loop_p) 0) {
- /* new loop */
- Ladd(lp,&loops);
- } else {
- /* Same loop, generated by several back
- * edges; such a loop is called a messy
- * loop.
- */
- org->LP_MESSY = TRUE;
- Ldeleteset(lp->LP_BLOCKS);
- oldcflpx(lp->lp_extend);
- oldloop(lp);
- }
- }
- }
- }
- collapse_loops(&loops);
- loop_attrib(loops);
- nest_levels(loops);
- mark_loopblocks(loops); /* determine firm and strong blocks */
- cleanup(loops);
- p->p_loops = loops;
-}
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * L O O P D E T E C T I O N
- */
-
-extern loop_detection(); /* (proc_p p)
- * Detect all loops of procedure p.
- * Every basic block of p is assigned
- * a set of all loops it is part of.
- * For every loop we record the number
- * of blocks it contains, the loop entry
- * block and its nesting level (0 = outer
- * loop, 1 = loop within loop etc.).
- */
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * C F _ S U C C . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/def.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_flag.h"
-#include "../../../h/em_mnem.h"
-#include "cf.h"
-#include "../share/map.h"
-
-extern char em_flag[];
-
-
-STATIC succeeds(succ,pred)
- bblock_p succ, pred;
-{
- assert(pred != (bblock_p) 0);
- if (succ != (bblock_p) 0) {
- Ladd(succ, &pred->b_succ);
- Ladd(pred, &succ->b_pred);
- }
-}
-
-
-#define IS_RETURN(i) (i == op_ret || i == op_rtt)
-#define IS_CASE_JUMP(i) (i == op_csa || i == op_csb)
-#define IS_UNCOND_JUMP(i) (i <= sp_lmnem && (em_flag[i-sp_fmnem] & EM_FLO) == FLO_T)
-#define IS_COND_JUMP(i) (i <= sp_lmnem && (em_flag[i-sp_fmnem] & EM_FLO) == FLO_C)
-#define TARGET(lnp) (lbmap[INSTRLAB(lnp)])
-#define ATARGET(arg) (lbmap[arg->a_a.a_instrlab])
-
-
-
-STATIC arg_p skip_const(arg)
- arg_p arg;
-{
- assert(arg != (arg_p) 0);
- switch(arg->a_type) {
- case ARGOFF:
- case ARGICN:
- case ARGUCN:
- break;
- default:
- error("bad case descriptor");
- }
- return arg->a_next;
-}
-
-
-STATIC arg_p use_label(arg,b)
- arg_p arg;
- bblock_p b;
-{
- if (arg->a_type == ARGINSTRLAB) {
- /* arg is a non-null label */
- succeeds(ATARGET(arg),b);
- }
- return arg->a_next;
-}
-
-
-
-STATIC case_flow(instr,desc,b)
- short instr;
- line_p desc;
- bblock_p b;
-{
- /* Analyse the case descriptor (given as a ROM pseudo instruction).
- * Every instruction label appearing in the descriptor
- * heads a basic block that is a successor of the block
- * in which the case instruction appears (b).
- */
-
- register arg_p arg;
-
- assert(instr == op_csa || instr == op_csb);
- assert(TYPE(desc) == OPLIST);
- arg = ARG(desc);
- arg = use_label(arg,b);
- /* See if there is a default label. If so, then
- * its block is a successor of b. Set arg to
- * next argument.
- */
- if (instr == op_csa) {
- arg = skip_const(arg); /* skip lower bound */
- arg = skip_const(arg); /* skip lower-upper bound */
- while (arg != (arg_p) 0) {
- /* All following arguments are case labels
- * or zeroes.
- */
- arg = use_label(arg,b);
- }
- } else {
- /* csb instruction */
- arg = skip_const(arg); /* skip #entries */
- while (arg != (arg_p) 0) {
- /* All following arguments are alternatively
- * an index and an instruction label (possibly 0).
- */
- arg = skip_const(arg); /* skip index */
- arg = use_label(arg,b);
- }
- }
-}
-
-
-
-STATIC line_p case_descr(lnp)
- line_p lnp;
-{
- /* lnp is the instruction just before a csa or csb,
- * so it is the instruction that pushes the address
- * of a case descriptor on the stack. Find that
- * descriptor, i.e. a rom pseudo instruction.
- * Note that this instruction will always be part
- * of the procedure in which the csa/csb occurs.
- */
-
- register line_p l;
- dblock_p d;
- obj_p obj;
- dblock_id id;
-
- if (lnp == (line_p) 0 || (INSTR(lnp)) != op_lae) {
- error("cannot find 'lae descr' before csa/csb");
- }
- /* We'll first find the ROM and its dblock_id */
- obj = OBJ(lnp);
- if (obj->o_off != (offset) 0) {
- error("bad 'lae descr' before csa/csb");
- /* We require a descriptor to be an entire rom,
- * not part of a rom.
- */
- }
- d = obj->o_dblock;
- assert(d != (dblock_p) 0);
- if (d->d_pseudo != DROM) {
- error("case descriptor must be in rom");
- }
- id = d->d_id;
- /* We'll use the dblock_id to find the defining occurrence
- * of the rom in the EM text (i.e. a rom pseudo). As all
- * pseudos appear at the beginning of a procedure, we only
- * have to look in its first basic block.
- */
- assert(curproc != (proc_p) 0);
- assert(curproc->p_start != (bblock_p) 0);
- l = curproc->p_start->b_start; /* first instruction of curproc */
- while (l != (line_p) 0) {
- if ((INSTR(l)) == ps_sym &&
- SHORT(l) == id) {
- /* found! */
- assert((INSTR(l->l_next)) == ps_rom);
- return l->l_next;
- }
- l = l->l_next;
- }
- error("cannot find rom pseudo for case descriptor");
- /* NOTREACHED */
-}
-
-
-
-STATIC last2_instrs(b,last_out,prev_out)
- bblock_p b;
- line_p *last_out,*prev_out;
-{
- /* Determine the last and one-but-last instruction
- * of basic block b. An end-pseudo is not regarded
- * as an instruction. If the block contains only 1
- * instruction, prev_out is 0.
- */
-
- register line_p l1,l2;
-
- l2 = b->b_start; /* first instruction of b */
- assert(l2 != (line_p) 0); /* block can not be empty */
- if ((l1 = l2->l_next) == (line_p) 0 || INSTR(l1) == ps_end) {
- *last_out = l2; /* single instruction */
- *prev_out = (line_p) 0;
- } else {
- while(l1->l_next != (line_p) 0 && INSTR(l1->l_next) != ps_end) {
- l2 = l1;
- l1 = l1->l_next;
- }
- *last_out = l1;
- *prev_out = l2;
- }
-}
-
-
-
-control_flow(head)
- bblock_p head;
-{
- /* compute the successor and predecessor relation
- * for every basic block.
- */
-
- register bblock_p b;
- line_p lnp, prev;
- short instr;
-
- for (b = head; b != (bblock_p) 0; b = b->b_next) {
- /* for every basic block, in textual order, do */
- last2_instrs(b, &lnp, &prev);
- /* find last and one-but-last instruction */
- instr = INSTR(lnp);
- /* The last instruction of the basic block
- * determines the set of successors of the block.
- */
- if (IS_CASE_JUMP(instr)) {
- case_flow(instr,case_descr(prev),b);
- /* If lnp is a csa or csb, then the instruction
- * just before it (i.e. prev) must be the
- * instruction that pushes the address of the
- * case descriptor. This descriptor is found
- * and analysed in order to build the successor
- * and predecessor sets of b.
- */
- } else {
- if (!IS_RETURN(instr)) {
- if (IS_UNCOND_JUMP(instr)) {
- succeeds(TARGET(lnp),b);
- } else {
- if (IS_COND_JUMP(instr)) {
- succeeds(TARGET(lnp),b);
- succeeds(b->b_next, b);
- /* Textually next block is
- * a successor of b.
- */
- } else {
- /* normal instruction */
- succeeds(b->b_next, b);
- }
- }
- }
- }
- }
-}
+++ /dev/null
-/* C O N T R O L F L O W
- *
- * S U C C E S S O R / P R E D E C E S S O R R E L A T I O N S
- */
-
-extern control_flow(); /* (bblock_p head)
- * Compute for every basic block
- * its successors and predecessors
- * in the control flow graph.
- */
+++ /dev/null
-
-EMH=../../../h
-EML=../../../lib
-SHARE=../share
-OBJECTS=cj.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o $(SHARE)/stack_chg.o $(SHARE)/go.o
-SRC=cj.c
-
-all: $(OBJECTS)
-cj: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o cj -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-cj.o: ../../../h/em_mnem.h
-cj.o: ../../../h/em_spec.h
-cj.o: ../share/alloc.h
-cj.o: ../share/aux.h
-cj.o: ../share/debug.h
-cj.o: ../share/def.h
-cj.o: ../share/files.h
-cj.o: ../share/get.h
-cj.o: ../share/global.h
-cj.o: ../share/go.h
-cj.o: ../share/lset.h
-cj.o: ../share/map.h
-cj.o: ../share/put.h
-cj.o: ../share/stack_chg.h
-cj.o: ../share/types.h
+++ /dev/null
-/* C R O S S J U M P I N G
- *
- * CJ.H
- *
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../share/def.h"
-#include "../share/stack_chg.h"
-#include "../share/go.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-
-
-/* Cross jumping performs optimzations like:
- *
- * if cond then goto L1; if cond then goto L1
- * S1; -----> S1;
- * S2; goto L3;
- * goto L2; L1:
- * L1: S3;
- * S3; L3:
- * S2; S2;
- * L2:
- *
- * CJ looks for two basic blocks b1 and b2 with the following properties:
- * - there exists a basic block S such that SUCC(b1) = SUCC(b2) = {S}
- * (so both have only 1 successor)
- * - the last N (N > 0) instructions of b1 and b2, not counting a possible
- * BRAnch instruction, are the same.
- * As a result of the first condition, at least of the two blocks must end
- * on an (unconditional) BRAnch instruction. If both end on a BRA, one block
- * is chosen at random. Assume this block is b1. A new label L is put just
- * before the N common instructions of block b2 (so this block is split
- * into two). The BRA of b1 is changed into a BRA L. So dynamically the same
- * instructions are executed in a slightly different order; yet the size of
- * the code has become smaller.
- */
-
-
-STATIC int Scj; /* number of optimizations found */
-
-
-
-#define DLINK(l1,l2) l1->l_next=l2; l2->l_prev=l1
-
-
-STATIC bool same_instr(l1,l2)
- line_p l1,l2;
-{
- /* See if l1 and l2 are the same instruction */
-
- if (l1 == 0 || l2 == 0 || TYPE(l1) != TYPE(l2)) return FALSE;
- if (INSTR(l1) != INSTR(l2)) return FALSE;
- switch(TYPE(l1)) {
- case OPSHORT: return SHORT(l1) == SHORT(l2);
- case OPOFFSET: return OFFSET(l1) == OFFSET(l2);
- case OPPROC: return PROC(l1) == PROC(l2);
- case OPOBJECT: return OBJ(l1) == OBJ(l2);
- case OPINSTRLAB: return INSTRLAB(l1) == INSTRLAB(l2);
- case OPNO: return TRUE;
- default: return FALSE;
- }
-}
-
-
-
-STATIC line_p last_mnem(b)
- bblock_p b;
-{
- /* Determine the last line of a list */
-
- register line_p l;
-
- for (l = b->b_start; l->l_next != (line_p) 0; l = l->l_next);
- while (INSTR(l) < sp_fmnem || INSTR(l) > sp_lmnem) l = PREV(l);
- return l;
-}
-
-
-STATIC bool is_desirable(text)
- line_p text;
-{
- /* We avoid to generate a BRAnch in the middle of some expression,
- * as the code generator will write the contents of the fakestack
- * to the real stack if it encounters a BRA. We do not avoid to
- * split the parameter-pushing code of a subroutine call into two,
- * as the parameters are pushed on the real stack anyway.
- * So e.g. "LOL a ; LOL b; ADI" will not be split, but
- * "LOL a; LOL b; CAL f" may be split.
- */
-
- line_p l;
- bool ok;
- int stack_diff,pop,push;
-
- stack_diff = 0;
- for (l = text; l != (line_p) 0; l = l->l_next) {
- switch(INSTR(l)) {
- case op_cal:
- case op_asp:
- case op_bra:
- return TRUE;
- }
- line_change(l,&ok,&pop,&push);
- /* printf("instr %d, pop %d, push %d, ok %d\n",INSTR(l),pop,push,ok); */
- if (!ok || (stack_diff -= pop) < 0) {
- return FALSE;
- } else {
- stack_diff += push;
- }
- }
- return TRUE;
-}
-
-
-STATIC cp_loops(b1,b2)
- bblock_p b1,b2;
-{
- /* Copy the loopset of b2 to b1 */
-
- Lindex i;
- loop_p lp;
- for (i = Lfirst(b2->b_loops); i != (Lindex) 0;
- i = Lnext(i,b2->b_loops)) {
- lp = (loop_p) Lelem(i);
- Ladd(lp,&b1->b_loops);
- }
-}
-
-
-STATIC jump_cross(l1,l2,b1,b2)
- line_p l1,l2;
- bblock_p b1,b2;
-{
- /* A cross-jump from block b2 to block b1 is found; the code in
- * block b2 from line l2 up to the BRAnch is removed; block b1 is
- * split into two; the second part consists of a new label
- * followed by the code from l1 till the end of the block.
- */
-
- line_p l;
- bblock_p b;
- bblock_p s;
-
- /* First adjust the control flow graph */
- b = freshblock(); /* create a new basic block */
- b->b_succ = b1->b_succ;
- /* SUCC(b1) = {b} */
- b1->b_succ = Lempty_set(); Ladd(b,&b1->b_succ);
- /* SUCC(b2) = {b} */
- Ldeleteset(b2->b_succ); b2->b_succ = Lempty_set(); Ladd(b,&b2->b_succ);
- /* PRED(b) = {b1,b2} */
- b->b_pred = Lempty_set(); Ladd(b1,&b->b_pred); Ladd(b2,&b->b_pred);
- /* PRED(SUCC(b)) := PRED(SUCC(b)) - {b1,b2} + {b} */
- assert(Lnrelems(b->b_succ) == 1);
- s = (bblock_p) Lelem(Lfirst(b->b_succ));
- Lremove(b1,&s->b_pred); Lremove(b2,&s->b_pred); Ladd(b,&s->b_pred);
- cp_loops(b,b1);
- b->b_idom = common_dom(b1,b2);
- b->b_flags = b1->b_flags;
- b->b_next = b1->b_next;
- b1->b_next = b;
-
- /* Now adjust the EM text */
- l = PREV(l1);
- if (l == (line_p) 0) {
- b1->b_start = (line_p) 0;
- } else {
- l->l_next = (line_p) 0;
- }
- l = newline(OPINSTRLAB);
- l->l_instr = op_lab;
- INSTRLAB(l) = freshlabel();
- DLINK(l,l1);
- b->b_start = l;
- for (l = l2; INSTR(l) != op_bra; l = l->l_next) {
- assert (l != (line_p) 0);
- rm_line(l,b2);
- }
- INSTRLAB(l) = INSTRLAB(b->b_start);
-}
-
-
-STATIC bool try_tail(b1,b2)
- bblock_p b1,b2;
-{
- /* See if b1 and b2 end on the same sequence of instructions */
-
- line_p l1,l2;
- bblock_p b = (bblock_p) 0;
- int cnt = 0;
- /* printf("try block %d and %d\n",b1->b_id,b2->b_id); */
-
- if (b1->b_start == (line_p) 0 || b2->b_start == (line_p) 0) return FALSE;
- l1 = last_mnem(b1);
- l2 = last_mnem(b2);
- /* printf("consider:\n"); showinstr(l1); showinstr(l2); */
- if (INSTR(l1) == op_bra) {
- b = b1;
- l1 = PREV(l1);
- }
- if (INSTR(l2) == op_bra) {
- b = b2;
- l2 = PREV(l2);
- }
- assert(b != (bblock_p) 0);
- while(same_instr(l1,l2)) {
- cnt++;
- l1 = PREV(l1);
- l2 = PREV(l2);
- /* printf("consider:\n"); showinstr(l1); showinstr(l2); */
- }
- if (cnt >= 1) {
- l1 = (l1 == 0 ? b1->b_start : l1->l_next);
- l2 = (l2 == 0 ? b2->b_start : l2->l_next);
- if (is_desirable(l1)) {
- if (b == b1) {
- jump_cross(l2,l1,b2,b1);
- Scj++;
- } else {
- jump_cross(l1,l2,b1,b2);
- Scj++;
- }
- return TRUE;
- }
- }
- return FALSE;
-}
-
-
-
-STATIC bool try_pred(b)
- bblock_p b;
-{
- /* See if there is any pair (b1,b2), both in PRED(b) for
- * which we can perform cross jumping.
- */
-
- register bblock_p b1,b2;
- register Lindex i,j;
- lset s = b->b_pred;
-
- for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i,s)) {
- b1 = (bblock_p) Lelem(i);
- if (Lnrelems(b1->b_succ) != 1) continue;
- for (j = Lfirst(s); j != (Lindex) 0; j = Lnext(j,s)) {
- b2 = (bblock_p) Lelem(j);
- if (b1 != b2 && Lnrelems(b2->b_succ) == 1) {
- if (try_tail(b1,b2)) return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-
-
-cj_optimize(p)
- proc_p p;
-{
- /* Perform cross jumping for procedure p.
- * In case cases a cross-jumping optimization which give
- * new opportunities for further cross-jumping optimizations.
- * Hence we repeat the whole process for the entire procedure,
- * untill we find no further optimizations.
- */
-
- bblock_p b;
- bool changes = TRUE;
-
- while(changes) {
- changes = FALSE;
- b = p->p_start;
- while (b != (bblock_p) 0) {
- if (try_pred(b)) {
- changes = TRUE;
- } else {
- b = b->b_next;
- }
- }
- }
-}
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,no_action,cj_optimize,no_action,no_action);
- report("cross jumps",Scj);
- exit(0);
-}
-
-
-
-/******
- * Debugging stuff
- */
-
-extern char em_mnem[]; /* The mnemonics of the EM instructions. */
-
-STATIC showinstr(lnp) line_p lnp; {
-
- /* Makes the instruction in `lnp' human readable. Only lines that
- * can occur in expressions that are going to be eliminated are
- * properly handled.
- */
- if (lnp == 0) return;
- if (INSTR(lnp) < sp_fmnem || INSTR(lnp) > sp_lmnem) {
- printf("\t*** ?\n");
- return;
- }
-
- printf("\t%s", &em_mnem[4 * (INSTR(lnp)-sp_fmnem)]);
- switch (TYPE(lnp)) {
- case OPNO:
- break;
- case OPSHORT:
- printf(" %d", SHORT(lnp)); break;
- case OPOBJECT:
- printf(" %d", OBJ(lnp)->o_id); break;
- case OPOFFSET:
- printf(" %D", OFFSET(lnp)); break;
- default:
- printf(" ?"); break;
- }
- printf("\n");
-} /* showinstr */
-
-
-STATIC print_list(list,b1,b2,p)
- line_p list;
- bblock_p b1,b2;
- proc_p p;
-{
- line_p l;
- printf("block %d and %d of proc %d:\n",b1->b_id,b2->b_id,p->p_id);
- for (l = list; l != 0; l = l->l_next) {
- showinstr(l);
- }
-}
+++ /dev/null
-# CPPFLAGS=-DVERBOSE -DTRACE
-CPPFLAGS=-DVERBOSE
-CFLAGS=$(CPPFLAGS)
-LDFLAGS=-i
-LINTFLAGS=-phbac $(CPPFLAGS)
-
-EMH=../../../h
-EMLIB=../../../lib
-SHR=../share
-
-CFILES=\
-cs.c cs_alloc.c cs_aux.c cs_avail.c cs_debug.c cs_elim.c \
-cs_entity.c cs_kill.c cs_partit.c cs_profit.c cs_getent.c \
-cs_stack.c cs_vnm.c
-
-OFILES=\
-cs.o cs_alloc.o cs_aux.o cs_avail.o cs_debug.o cs_elim.o \
-cs_entity.o cs_kill.o cs_partit.o cs_profit.o cs_getent.o \
-cs_stack.o cs_vnm.o
-
-HFILES=\
-cs.h cs_alloc.h cs_aux.h cs_avail.h cs_debug.h cs_elim.h \
-cs_entity.h cs_kill.h cs_partit.h cs_profit.h cs_getent.h \
-cs_stack.h cs_vnm.h
-
-PRFILES=\
-$(CFILES) $(HFILES) Makefile
-
-SHARE_OFILES=\
-$(SHR)/get.o $(SHR)/put.o $(SHR)/alloc.o $(SHR)/global.o $(SHR)/debug.o\
-$(SHR)/files.o $(SHR)/map.o $(SHR)/lset.o $(SHR)/cset.o $(SHR)/aux.o\
-$(SHR)/go.o
-
-cs: $(OFILES)
- $(CC) -o cs $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a
-
-lint:
- lint $(LINTFLAGS) $(CFILES)
-
-pr: $(PRFILES)
- @pr $?
- @touch pr
-
-depend:
- $(SHR)/makedepend
-
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-cs.o: ../share/debug.h
-cs.o: ../share/go.h
-cs.o: ../share/types.h
-cs.o: cs.h
-cs.o: cs_aux.h
-cs.o: cs_avail.h
-cs.o: cs_debug.h
-cs.o: cs_elim.h
-cs.o: cs_entity.h
-cs.o: cs_profit.h
-cs.o: cs_stack.h
-cs.o: cs_vnm.h
-cs_alloc.o: ../share/alloc.h
-cs_alloc.o: ../share/types.h
-cs_alloc.o: cs.h
-cs_aux.o: ../share/aux.h
-cs_aux.o: ../share/debug.h
-cs_aux.o: ../share/global.h
-cs_aux.o: ../share/lset.h
-cs_aux.o: ../share/types.h
-cs_aux.o: cs.h
-cs_aux.o: cs_entity.h
-cs_avail.o: ../../../h/em_mnem.h
-cs_avail.o: ../share/aux.h
-cs_avail.o: ../share/debug.h
-cs_avail.o: ../share/global.h
-cs_avail.o: ../share/lset.h
-cs_avail.o: ../share/types.h
-cs_avail.o: cs.h
-cs_avail.o: cs_alloc.h
-cs_avail.o: cs_aux.h
-cs_avail.o: cs_getent.h
-cs_debug.o: ../../../h/em_spec.h
-cs_debug.o: ../share/debug.h
-cs_debug.o: ../share/lset.h
-cs_debug.o: ../share/types.h
-cs_debug.o: cs.h
-cs_debug.o: cs_aux.h
-cs_debug.o: cs_avail.h
-cs_debug.o: cs_entity.h
-cs_elim.o: ../../../h/em_mnem.h
-cs_elim.o: ../../../h/em_reg.h
-cs_elim.o: ../share/alloc.h
-cs_elim.o: ../share/aux.h
-cs_elim.o: ../share/debug.h
-cs_elim.o: ../share/global.h
-cs_elim.o: ../share/lset.h
-cs_elim.o: ../share/types.h
-cs_elim.o: cs.h
-cs_elim.o: cs_alloc.h
-cs_elim.o: cs_aux.h
-cs_elim.o: cs_avail.h
-cs_elim.o: cs_debug.h
-cs_elim.o: cs_partit.h
-cs_elim.o: cs_profit.h
-cs_entity.o: ../share/debug.h
-cs_entity.o: ../share/global.h
-cs_entity.o: ../share/lset.h
-cs_entity.o: ../share/types.h
-cs_entity.o: cs.h
-cs_entity.o: cs_aux.h
-cs_getent.o: ../../../h/em_mnem.h
-cs_getent.o: ../share/aux.h
-cs_getent.o: ../share/debug.h
-cs_getent.o: ../share/global.h
-cs_getent.o: ../share/types.h
-cs_getent.o: cs.h
-cs_getent.o: cs_aux.h
-cs_getent.o: cs_entity.h
-cs_getent.o: cs_stack.h
-cs_kill.o: ../../../h/em_mnem.h
-cs_kill.o: ../share/aux.h
-cs_kill.o: ../share/cset.h
-cs_kill.o: ../share/debug.h
-cs_kill.o: ../share/global.h
-cs_kill.o: ../share/lset.h
-cs_kill.o: ../share/types.h
-cs_kill.o: cs.h
-cs_kill.o: cs_aux.h
-cs_kill.o: cs_avail.h
-cs_kill.o: cs_debug.h
-cs_kill.o: cs_entity.h
-cs_partit.o: ../../../h/em_mnem.h
-cs_partit.o: ../../../h/em_pseu.h
-cs_partit.o: ../../../h/em_reg.h
-cs_partit.o: ../../../h/em_spec.h
-cs_partit.o: ../share/aux.h
-cs_partit.o: ../share/debug.h
-cs_partit.o: ../share/global.h
-cs_partit.o: ../share/types.h
-cs_partit.o: cs.h
-cs_partit.o: cs_stack.h
-cs_profit.o: ../../../h/em_mnem.h
-cs_profit.o: ../../../h/em_spec.h
-cs_profit.o: ../share/aux.h
-cs_profit.o: ../share/cset.h
-cs_profit.o: ../share/debug.h
-cs_profit.o: ../share/global.h
-cs_profit.o: ../share/lset.h
-cs_profit.o: ../share/types.h
-cs_profit.o: cs.h
-cs_profit.o: cs_aux.h
-cs_profit.o: cs_avail.h
-cs_profit.o: cs_partit.h
-cs_stack.o: ../share/aux.h
-cs_stack.o: ../share/debug.h
-cs_stack.o: ../share/global.h
-cs_stack.o: ../share/types.h
-cs_stack.o: cs.h
-cs_stack.o: cs_aux.h
-cs_valno.o: ../share/debug.h
-cs_valno.o: ../share/types.h
-cs_valno.o: cs.h
-cs_vnm.o: ../../../h/em_mnem.h
-cs_vnm.o: ../share/aux.h
-cs_vnm.o: ../share/debug.h
-cs_vnm.o: ../share/global.h
-cs_vnm.o: ../share/types.h
-cs_vnm.o: cs.h
-cs_vnm.o: cs_alloc.h
-cs_vnm.o: cs_aux.h
-cs_vnm.o: cs_avail.h
-cs_vnm.o: cs_entity.h
-cs_vnm.o: cs_getent.h
-cs_vnm.o: cs_kill.h
-cs_vnm.o: cs_partit.h
-cs_vnm.o: cs_stack.h
+++ /dev/null
-/* C O M M O N S U B E X P R E S S I O N E L I M I N A T I O N */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/lset.h"
-#include "../share/debug.h"
-#include "../share/go.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_avail.h"
-#include "cs_debug.h"
-#include "cs_elim.h"
-#include "cs_entity.h"
-#include "cs_profit.h"
-#include "cs_stack.h"
-#include "cs_vnm.h"
-
-int Scs; /* Number of optimizations found. */
-
-STATIC cs_clear()
-{
- clr_avails();
- clr_entities();
- clr_stack();
-
- start_valnum();
-}
-
-STATIC cs_optimize(p)
- proc_p p;
-{
- /* Optimize all basic blocks of one procedure. */
-
- register bblock_p rbp, bdone;
-
- avails = (avail_p) 0;
- entities = Lempty_set();
- cs_clear();
-
- rbp = p->p_start;
-
- while (rbp != (bblock_p) 0) {
- bdone = rbp->b_idom;
- /* First we build a list of common expressions with the
- * value numbering algorithm. We take blocks in textual order
- * as long as the next block can only be reached through the
- * block we have just done.
- */
- while (rbp != (bblock_p) 0 && rbp->b_idom == bdone) {
- vnm(rbp); bdone = rbp;
- OUTTRACE("basic block %d processed", bdone->b_id);
- rbp = rbp->b_next;
- }
- OUTTRACE("value numbering completed", 0);
- OUTAVAILS(); OUTENTITIES();
-
- /* Now we put out the instructions without common
- * subexpressions but with the use of temporaries,
- * which will be local variables of procedure p.
- */
- eliminate(p);
- cs_clear();
- }
-}
-
-main(argc, argv)
- int argc;
- char *argv[];
-{
- Scs = 0;
- go(argc, argv, no_action, cs_optimize, cs_machinit, no_action);
- report("Duplicate expressions eliminated", Scs);
- exit(0);
-}
+++ /dev/null
-typedef short valnum;
-typedef struct entity *entity_p;
-typedef struct avail *avail_p;
-typedef struct token *token_p;
-typedef struct occur *occur_p;
-
-struct token {
- valnum tk_vn;
- offset tk_size;
- line_p tk_lfirst; /* Textually first instruction, involved
- * in pushing this token.
- */
-};
-
- /* We distinguish these entities. */
-#define ENCONST 0
-#define ENLOCAL 1
-#define ENEXTERNAL 2
-#define ENINDIR 3
-#define ENOFFSETTED 4
-#define ENALOCAL 5
-#define ENAEXTERNAL 6
-#define ENAOFFSETTED 7
-#define ENALOCBASE 8
-#define ENAARGBASE 9
-#define ENPROC 10
-#define ENFZER 11
-#define ENARRELEM 12
-#define ENLOCBASE 13
-#define ENHEAPPTR 14
-#define ENIGNMASK 15
-
-struct entity {
- valnum en_vn;
- bool en_static;
- byte en_kind; /* ENLOCAL, ENEXTERNAL, etc. */
- offset en_size;
- union {
- offset en__val; /* ENCONST. */
- offset en__loc; /* ENLOCAL, ENALOCAL. */
- obj_p en__ext; /* ENEXTERNAL, ENAEXTERNAL. */
- valnum en__ind; /* ENINDIR. */
- struct {
- valnum en__base;
- offset en__off;
- } en_offs; /* ENOFFSETTED, ENAOFFSETTED. */
- offset en__levels; /* ENALOCBASE, ENAARGBASE. */
- proc_p en__pro; /* ENPROC. */
- struct {
- valnum en__arbase;
- valnum en__index;
- valnum en__adesc;
- } en_arr; /* ENARRELEM. */
- } en_inf;
-};
-
- /* Macros to increase ease of use. */
-#define en_val en_inf.en__val
-#define en_loc en_inf.en__loc
-#define en_ext en_inf.en__ext
-#define en_ind en_inf.en__ind
-#define en_base en_inf.en_offs.en__base
-#define en_off en_inf.en_offs.en__off
-#define en_levels en_inf.en__levels
-#define en_pro en_inf.en__pro
-#define en_arbase en_inf.en_arr.en__arbase
-#define en_index en_inf.en_arr.en__index
-#define en_adesc en_inf.en_arr.en__adesc
-
-struct occur {
- line_p oc_lfirst; /* First instruction of expression. */
- line_p oc_llast; /* Last one. */
- bblock_p oc_belongs; /* Basic block it belongs to. */
-};
-
- /* We distinguish these groups of instructions. */
-#define SIMPLE_LOAD 0
-#define EXPENSIVE_LOAD 1
-#define LOAD_ARRAY 2
-#define STORE_DIRECT 3
-#define STORE_INDIR 4
-#define STORE_ARRAY 5
-#define UNAIR_OP 6
-#define BINAIR_OP 7
-#define TERNAIR_OP 8
-#define KILL_ENTITY 9
-#define SIDE_EFFECTS 10
-#define FIDDLE_STACK 11
-#define IGNORE 12
-#define HOPELESS 13
-#define BBLOCK_END 14
-
-struct avail {
- avail_p av_before; /* Ptr to earlier discovered expressions. */
- byte av_instr; /* Operator instruction. */
- offset av_size;
- line_p av_found; /* Line where expression is first found. */
- lset av_occurs; /* Set of recurrences of expression. */
- entity_p av_saveloc; /* Local where result is put in. */
- valnum av_result;
- union {
- valnum av__operand; /* EXPENSIVE_LOAD, UNAIR_OP. */
- struct {
- valnum av__oleft;
- valnum av__oright;
- } av_2; /* BINAIR_OP. */
- struct {
- valnum av__ofirst;
- valnum av__osecond;
- valnum av__othird;
- } av_3; /* TERNAIR_OP. */
- } av_o;
-};
-
- /* Macros to increase ease of use. */
-#define av_operand av_o.av__operand
-#define av_oleft av_o.av_2.av__oleft
-#define av_oright av_o.av_2.av__oright
-#define av_ofirst av_o.av_3.av__ofirst
-#define av_osecond av_o.av_3.av__osecond
-#define av_othird av_o.av_3.av__othird
-
-extern int Scs; /* Number of optimizations found. */
+++ /dev/null
-#include "../share/types.h"
-#include "../share/alloc.h"
-#include "cs.h"
-
-occur_p newoccur(l1, l2, b)
- line_p l1, l2;
- bblock_p b;
-{
- /* Allocate a new struct occur and initialize it. */
-
- register occur_p rop;
-
- rop = (occur_p) newcore(sizeof(struct occur));
- rop->oc_lfirst = l1; rop->oc_llast = l2; rop->oc_belongs = b;
- return rop;
-}
-
-oldoccur(ocp)
- occur_p ocp;
-{
- oldcore((short *) ocp, sizeof(struct occur));
-}
-
-avail_p newavail()
-{
- return (avail_p) newcore(sizeof(struct avail));
-}
-
-oldavail(avp)
- avail_p avp;
-{
- oldcore((short *) avp, sizeof(struct avail));
-}
-
-entity_p newentity()
-{
- return (entity_p) newcore(sizeof(struct entity));
-}
-
-oldentity(enp)
- entity_p enp;
-{
- oldcore((short *) enp, sizeof(struct entity));
-}
+++ /dev/null
-extern occur_p newoccur(); /* (line_p l1, l2; bblock_p b)
- * Returns a pointer to a new struct occur
- * and initializes it.
- */
-
-extern oldoccur(); /* (occur_p ocp)
- * Release the struct occur ocp points to.
- */
-
-extern avail_p newavail(); /* ()
- * Return a pointer to a new struct avail.
- */
-
-extern oldavail(); /* (avail_p avp)
- * Release the struct avail avp points to.
- */
-
-extern entity_p newentity(); /* ()
- * Return a pointer to a new struct entity.
- */
-
-extern oldentity(); /* (entity_p enp)
- * Release the struct entity enp points to.
- */
+++ /dev/null
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/aux.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "cs.h"
-#include "cs_entity.h"
-
-offset array_elemsize(vn)
- valnum vn;
-{
- /* Vn is the valuenumber of an entity that points to
- * an array-descriptor. The third element of this descriptor holds
- * the size of the array-elements.
- * IF we can find this entity, AND IF we can find the descriptor AND IF
- * this descriptor is located in ROM, then we return the size.
- */
- entity_p enp;
-
- enp = find_entity(vn);
-
- if (enp == (entity_p) 0)
- return UNKNOWN_SIZE;
-
- if (enp->en_kind != ENAEXTERNAL)
- return UNKNOWN_SIZE;
-
- if (enp->en_ext->o_dblock->d_pseudo != DROM)
- return UNKNOWN_SIZE;
-
- return aoff(enp->en_ext->o_dblock->d_values, 2);
-}
-
-occur_p occ_elem(i)
- Lindex i;
-{
- return (occur_p) Lelem(i);
-}
-
-entity_p en_elem(i)
- Lindex i;
-{
- return (entity_p) Lelem(i);
-}
-
-/* The value numbers associated with each distinct value
- * start at 1.
- */
-
-STATIC valnum val_no;
-
-valnum newvalnum()
-{
- /* Return a completely new value number. */
-
- return ++val_no;
-}
-
-start_valnum()
-{
- /* Restart value numbering. */
-
- val_no = 0;
-}
+++ /dev/null
-extern offset array_elemsize(); /* (valnum vm)
- * Returns the size of array-elements,
- * if vn is the valuenumber of the
- * address of an array-descriptor.
- */
-
-extern occur_p occ_elem(); /* (Lindex i)
- * Returns a pointer to the occurrence
- * of which i is an index in a set.
- */
-
-extern entity_p en_elem(); /* (Lindex i)
- * Returns a pointer to the entity
- * of which i is an index in a set.
- */
-
-extern valnum newvalnum(); /* ()
- * Returns a completely new
- * value number.
- */
-
-extern start_valnum(); /* ()
- * Restart value numbering.
- */
-
+++ /dev/null
-/* M O D U L E F O R A C C E S S S I N G T H E L I S T
- *
- * O F A V A I L A B L E E X P R E S S I O N S
- */
-
-#include "../../../h/em_mnem.h"
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/aux.h"
-#include "../share/lset.h"
-#include "../share/global.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_debug.h"
-#include "cs_alloc.h"
-#include "cs_getent.h"
-
-avail_p avails; /* The list of available expressions. */
-
-STATIC bool commutative(instr)
- int instr;
-{
- /* Is instr a commutative operator? */
-
- switch (instr) {
- case op_adf: case op_adi: case op_adu: case op_and:
- case op_cms: case op_ior: case op_mlf: case op_mli:
- case op_mlu:
- return TRUE;
- default:
- return FALSE;
- }
-}
-
-STATIC bool same_avail(kind, avp1, avp2)
- byte kind;
- avail_p avp1, avp2;
-{
- /* Two expressions are the same if they have the same operator,
- * the same size, and their operand(s) have the same value.
- * Only if the operator is commutative, the order of the operands
- * does not matter.
- */
- if (avp1->av_instr != avp2->av_instr) return FALSE;
- if (avp1->av_size != avp2->av_size) return FALSE;
-
- switch (kind) {
- default:
- assert(FALSE);
- break;
- case EXPENSIVE_LOAD:
- case UNAIR_OP:
- return avp1->av_operand == avp2->av_operand;
- case BINAIR_OP:
- if (commutative(avp1->av_instr & BMASK))
- return avp1->av_oleft == avp2->av_oleft &&
- avp1->av_oright == avp2->av_oright
- ||
- avp1->av_oleft == avp2->av_oright &&
- avp1->av_oright == avp2->av_oleft
- ;
- else
- return avp1->av_oleft == avp2->av_oleft &&
- avp1->av_oright == avp2->av_oright;
- case TERNAIR_OP:
- return avp1->av_ofirst == avp2->av_ofirst &&
- avp1->av_osecond == avp2->av_osecond &&
- avp1->av_othird == avp2->av_othird;
- }
- /* NOTREACHED */
-}
-
-STATIC check_local(avp)
- avail_p avp;
-{
- /* Check if the local in which the result of avp was stored,
- * still holds this result. Update if not.
- */
- if (avp->av_saveloc == (entity_p) 0) return; /* Nothing to check. */
-
- if (avp->av_saveloc->en_vn != avp->av_result) {
- OUTTRACE("save local changed value", 0);
- avp->av_saveloc = (entity_p) 0;
- }
-}
-
-STATIC entity_p result_local(size, l)
- offset size;
- line_p l;
-{
- /* If the result of an expression of size bytes is stored into a
- * local for which a registermessage was generated, return a pointer
- * to this local.
- */
- line_p dummy;
- entity_p enp;
-
- if (l == (line_p) 0)
- return (entity_p) 0;
-
- if (INSTR(l)==op_stl && size==ws || INSTR(l)==op_sdl && size==2*ws) {
- enp = getentity(l, &dummy);
- if (is_regvar(enp->en_loc)) {
- OUTTRACE("save local found, %D(LB)", enp->en_loc);
- return enp;
- }
- }
-
- return (entity_p) 0;
-}
-
-STATIC copy_avail(kind, src, dst)
- int kind;
- avail_p src, dst;
-{
- /* Copy some attributes from src to dst. */
-
- dst->av_instr = src->av_instr;
- dst->av_size = src->av_size;
-
- switch (kind) {
- default:
- assert(FALSE);
- break;
- case EXPENSIVE_LOAD:
- case UNAIR_OP:
- dst->av_operand = src->av_operand;
- break;
- case BINAIR_OP:
- dst->av_oleft = src->av_oleft;
- dst->av_oright = src->av_oright;
- break;
- case TERNAIR_OP:
- dst->av_ofirst = src->av_ofirst;
- dst->av_osecond = src->av_osecond;
- dst->av_othird = src->av_othird;
- break;
- }
-}
-
-avail_p av_enter(avp, ocp, kind)
- avail_p avp;
- occur_p ocp;
- int kind;
-{
- /* Put the available expression avp in the list,
- * if it is not already there.
- * Add ocp to the set of occurrences of this expression.
- */
- register avail_p ravp;
- line_p last = ocp->oc_llast;
-
- for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
- if (same_avail(kind, ravp, avp)) { /* It was there. */
- Ladd(ocp, &ravp->av_occurs);
- /* Can we still use the local in which
- * the result was stored?
- */
- check_local(ravp);
- return ravp;
- }
- }
- /* A new available axpression. */
- ravp = newavail();
-
- /* Remember local, if any, that holds result. */
- if (avp->av_instr != (byte) INSTR(last)) {
- /* Only possible when instr is the implicit AAR in
- * a LAR or SAR.
- */
- ravp->av_saveloc = (entity_p) 0;
- } else {
- ravp->av_saveloc = result_local(avp->av_size, last->l_next);
- }
- ravp->av_found = last;
- ravp->av_result = kind == EXPENSIVE_LOAD? avp->av_operand: newvalnum();
- copy_avail(kind, avp, ravp);
- oldoccur(ocp);
- ravp->av_before = avails;
- avails = ravp;
- return ravp;
-}
-
-clr_avails()
-{
- /* Throw away the information about the available expressions. */
-
- register avail_p ravp, next;
- register Lindex i;
- register lset s;
-
- for (ravp = avails; ravp != (avail_p) 0; ravp = next) {
- next = ravp->av_before;
-
- s = ravp->av_occurs;
- for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i, s)) {
- oldoccur(occ_elem(i));
- }
- Ldeleteset(s);
- oldavail(ravp);
- }
- avails = (avail_p) 0;
-}
+++ /dev/null
-extern avail_p avails; /* The set of available expressions. */
-
-extern avail_p av_enter(); /* (avail_p avp, occur_p ocp, byte kind)
- * Puts the available expression in avp
- * in the list of available expressions,
- * if it is not already there. Add ocp to set of
- * occurrences of this expression.
- * If we have a new expression, we test whether
- * the result is saved. When this expression
- * recurs,we test if we can still use the
- * variable into which it was saved.
- * (Kind is the kind of the expression.)
- * Returns a pointer into the list.
- */
-
-extern clr_avails(); /* Release all space occupied by the old list
- * of available expressions.
- */
+++ /dev/null
-#include <stdio.h>
-#include "../../../h/em_spec.h"
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/lset.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_avail.h"
-#include "cs_entity.h"
-
-#ifdef VERBOSE
-
-extern char em_mnem[]; /* The mnemonics of the EM instructions. */
-
-STATIC showinstr(lnp)
- line_p lnp;
-{
- /* Makes the instruction in `lnp' human readable. Only lines that
- * can occur in expressions that are going to be eliminated are
- * properly handled.
- */
- if (INSTR(lnp) < sp_fmnem && INSTR(lnp) > sp_lmnem) {
- fprintf(stderr,"*** ?\n");
- return;
- }
-
- fprintf(stderr,"%s", &em_mnem[4 * (INSTR(lnp)-sp_fmnem)]);
- switch (TYPE(lnp)) {
- case OPNO:
- break;
- case OPSHORT:
- fprintf(stderr," %d", SHORT(lnp));
- break;
- case OPOBJECT:
- fprintf(stderr," %d", OBJ(lnp)->o_id);
- break;
- case OPOFFSET:
- fprintf(stderr," %D", OFFSET(lnp));
- break;
- default:
- fprintf(stderr," ?");
- break;
- }
- fprintf(stderr,"\n");
-}
-
-SHOWOCCUR(ocp)
- occur_p ocp;
-{
- /* Shows all instructions in an occurrence. */
-
- register line_p lnp, next;
-
- if (verbose_flag) {
- for (lnp = ocp->oc_lfirst; lnp != (line_p) 0; lnp = next) {
- next = lnp == ocp->oc_llast ? (line_p) 0 : lnp->l_next;
-
- showinstr(lnp);
- }
- }
-}
-
-#endif
-
-#ifdef TRACE
-
-SHOWAVAIL(avp)
- avail_p avp;
-{
- /* Shows an available expression. */
- showinstr(avp->av_found);
- fprintf(stderr,"result %d,", avp->av_result);
- fprintf(stderr,"occurred %d times\n", Lnrelems(avp->av_occurs) + 1);
-
-}
-
-OUTAVAILS()
-{
- register avail_p ravp;
-
- fprintf(stderr,"AVAILABLE EXPRESSIONS\n");
-
- for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
- SHOWAVAIL(ravp);
- fprintf(stderr,"\n");
- }
-}
-
-STATIC char *enkinds[] = {
- "constant",
- "local",
- "external",
- "indirect",
- "offsetted",
- "address of local",
- "address of external",
- "address of offsetted",
- "address of local base",
- "address of argument base",
- "procedure",
- "floating zero",
- "array element",
- "local base",
- "heap pointer",
- "ignore mask"
-};
-
-OUTENTITIES()
-{
- register Lindex i;
-
- fprintf(stderr,"ENTITIES\n");
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- register entity_p rep = en_elem(i);
-
- fprintf(stderr,"%s,", enkinds[rep->en_kind]);
- fprintf(stderr,"size %D,", rep->en_size);
- fprintf(stderr,"valno %d,", rep->en_vn);
- switch (rep->en_kind) {
- case ENCONST:
- fprintf(stderr,"$%D\n", rep->en_val);
- break;
- case ENLOCAL:
- case ENALOCAL:
- fprintf(stderr,"%D(LB)\n", rep->en_loc);
- break;
- case ENINDIR:
- fprintf(stderr,"*%d\n", rep->en_ind);
- break;
- case ENOFFSETTED:
- case ENAOFFSETTED:
- fprintf(stderr,"%D(%d)\n", rep->en_off, rep->en_base);
- break;
- case ENALOCBASE:
- case ENAARGBASE:
- fprintf(stderr,"%D levels\n", rep->en_levels);
- break;
- case ENARRELEM:
- fprintf(stderr,"%d[%d], ",rep->en_arbase,rep->en_index);
- fprintf(stderr,"rom at %d\n", rep->en_adesc);
- break;
- }
- fprintf(stderr,"\n");
- }
-}
-
-/* XXX */
-OUTTRACE(s, n)
- char *s;
-{
- fprintf(stderr,"trace: ");
- fprintf(stderr,s, n);
- fprintf(stderr,"\n");
-}
-
-#endif TRACE
+++ /dev/null
-#ifdef VERBOSE
-
-extern SHOWOCCUR(); /* (occur_p ocp)
- * Shows all lines in an occurrence.
- */
-
-#else
-
-#define SHOWOCCUR(x)
-
-#endif
-
-#ifdef TRACE
-
-extern OUTAVAILS(); /* ()
- * Prints all available expressions.
- */
-
-extern OUTENTITIES(); /* ()
- * Prints all entities.
- */
-
-extern SHOWAVAIL(); /* (avail_p avp)
- * Shows an available expression.
- */
-
-#else TRACE
-
-#define OUTAVAILS()
-#define OUTENTITIES()
-#define SHOWAVAIL(x)
-
-#endif TRACE
+++ /dev/null
-#include "../../../h/em_reg.h"
-#include "../../../h/em_mnem.h"
-#include "../share/types.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../share/global.h"
-#include "../share/debug.h"
-#include "cs.h"
-#include "cs_avail.h"
-#include "cs_alloc.h"
-#include "cs_aux.h"
-#include "cs_debug.h"
-#include "cs_profit.h"
-#include "cs_partit.h"
-#include "cs_debug.h"
-
-STATIC dlink(l1, l2)
- line_p l1, l2;
-{
- /* Doubly link the lines in l1 and l2. */
-
- if (l1 != (line_p) 0)
- l1->l_next = l2;
- if (l2 != (line_p) 0)
- l2->l_prev = l1;
-}
-
-STATIC remove_lines(first, last)
- line_p first, last;
-{
- /* Throw away the lines between and including first and last.
- * Don't worry about any pointers; the (must) have been taken care of.
- */
- register line_p lnp, next;
-
- last->l_next = (line_p) 0; /* Delimit the list. */
- for (lnp = first; lnp != (line_p) 0; lnp = next) {
- next = lnp->l_next;
- oldline(lnp);
- }
-}
-
-STATIC bool contained(ocp1, ocp2)
- occur_p ocp1, ocp2;
-{
- /* Determine whether ocp1 is contained within ocp2. */
-
- register line_p lnp, next;
-
- for (lnp = ocp2->oc_lfirst; lnp != (line_p) 0; lnp = next) {
- next = lnp != ocp2->oc_llast ? lnp->l_next : (line_p) 0;
-
- if (lnp == ocp1->oc_llast) return TRUE;
- }
- return FALSE;
-}
-
-STATIC delete(ocp, start)
- occur_p ocp;
- avail_p start;
-{
- /* Delete all occurrences that are contained within ocp.
- * They must have been entered in the list before start:
- * if an expression is contained with an other, its operator line
- * appears before the operator line of the other because EM-expressions
- * are postfix.
- */
- register avail_p ravp;
- register Lindex i, next;
-
- for (ravp = start; ravp != (avail_p) 0; ravp = ravp->av_before) {
- for (i = Lfirst(ravp->av_occurs); i != (Lindex) 0; i = next) {
- next = Lnext(i, ravp->av_occurs);
-
- if (contained(occ_elem(i), ocp)) {
- OUTTRACE("delete contained occurrence", 0);
-# ifdef TRACE
- SHOWOCCUR(occ_elem(i));
-# endif
- oldoccur(occ_elem(i));
- Lremove(Lelem(i), &ravp->av_occurs);
- }
- }
- }
-}
-
-STATIC complete_aar(lnp, instr, descr_vn)
- line_p lnp;
- int instr;
- valnum descr_vn;
-{
- /* Lnp is an instruction that loads the address of an array-element.
- * Instr tells us what effect we should achieve; load (instr is op_lar)
- * or store (instr is op_sar) this array-element. Descr_vn is the
- * valuenumber of the address of the descriptor of this array.
- * We append a loi or sti of the correct number of bytes.
- */
- register line_p lindir;
-
- lindir = int_line(array_elemsize(descr_vn));
- lindir->l_instr = instr == op_lar ? op_loi : op_sti;
- dlink(lindir, lnp->l_next);
- dlink(lnp, lindir);
-}
-
-STATIC replace(ocp, tmp, avp)
- occur_p ocp;
- offset tmp;
- avail_p avp;
-{
- /* Replace the lines in the occurrence in ocp by a load of the
- * temporary with offset tmp.
- */
- register line_p lol, first, last;
-
- assert(avp->av_size == ws || avp->av_size == 2*ws);
-
- first = ocp->oc_lfirst; last = ocp->oc_llast;
-
- lol = int_line(tmp);
- lol->l_instr = avp->av_size == ws ? op_lol : op_ldl;
- dlink(lol, last->l_next);
-
- if (first->l_prev == (line_p) 0) ocp->oc_belongs->b_start = lol;
- dlink(first->l_prev, lol);
-
- if (avp->av_instr == (byte) op_aar) {
- /* There may actually be a LAR or a SAR instruction; in that
- * case we have to complete the array-instruction.
- */
- register int instr = INSTR(last);
-
- if (instr != op_aar) complete_aar(lol, instr, avp->av_othird);
- }
-
- /* Throw away the by now useless lines. */
- remove_lines(first, last);
-}
-
-STATIC append(avp, tmp)
- avail_p avp;
- offset tmp;
-{
- /* Avp->av_found points to a line with an operator in it. This
- * routine emits a sequence of instructions that saves the result
- * in a local with offset tmp. In most cases we just append
- * avp->av_found with stl/sdl tmp and lol/ldl tmp depending on
- * avp->av_size. If however the operator is an aar contained
- * within a lar or sar, we must first generate the aar.
- */
- register line_p stl, lol;
-
- assert(avp->av_size == ws || avp->av_size == 2*ws);
-
- stl = int_line(tmp);
- stl->l_instr = avp->av_size == ws ? op_stl : op_sdl;
- lol = int_line(tmp);
- lol->l_instr = avp->av_size == ws ? op_lol : op_ldl;
-
- dlink(lol, avp->av_found->l_next);
- dlink(stl, lol);
- dlink(avp->av_found, stl);
-
- if (avp->av_instr == (byte) op_aar) {
- register int instr = INSTR(avp->av_found);
-
- if (instr != op_aar) {
- complete_aar(lol, instr, avp->av_othird);
- avp->av_found->l_instr = op_aar;
- }
- }
-}
-
-STATIC set_replace(avp, tmp)
- avail_p avp;
- offset tmp;
-{
- /* Avp->av_occurs is now a set of occurrences, each of which will be
- * replaced by a reference to a local.
- * Each time we eliminate an expression, we delete from our
- * list those expressions that are physically contained in them,
- * because we cannot eliminate them again.
- */
- register Lindex i;
- register lset s = avp->av_occurs;
-
- for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i, s)) {
- OUTVERBOSE("eliminate duplicate", 0);
- SHOWOCCUR(occ_elem(i));
- Scs++;
- delete(occ_elem(i), avp->av_before);
- replace(occ_elem(i), tmp, avp);
- }
-}
-
-STATIC int reg_score(enp)
- entity_p enp;
-{
- /* Enp is a local that will go into a register.
- * We return its score upto now.
- */
- assert(is_regvar(enp->en_loc));
- return regv_arg(enp->en_loc, 4);
-}
-
-STATIC line_p gen_mesreg(off, avp, pp)
- offset off;
- avail_p avp;
- proc_p pp;
-{
- /* Generate a register message for the local that will hold the
- * result of the expression in avp, at the appropriate place in
- * the procedure in pp.
- */
- register line_p reg;
-
- reg = reg_mes(off, (short) avp->av_size, regtype(avp->av_instr), 0);
- appnd_line(reg, pp->p_start->b_start);
-
- return reg;
-}
-
-STATIC change_score(mes, score)
- line_p mes;
- int score;
-{
- /* Change the score in the register message in mes to score. */
-
- register arg_p ap = ARG(mes);
-
- ap = ap->a_next; /* Offset. */
- ap = ap->a_next; /* Size. */
- ap = ap->a_next; /* Type. */
- ap = ap->a_next; /* Score. */
-
- ap->a_a.a_offset = score;
-}
-
-eliminate(pp)
- proc_p pp;
-{
- /* Eliminate costly common subexpressions within procedure pp.
- * We scan the available expressions in - with respect to time found -
- * reverse order, to find largest first, e.g. `A + B + C' before
- * `A + B'.
- * We do not eliminate an expression when the size
- * is not one of ws or 2*ws, because then we cannot use lol or ldl.
- * Code is appended to the first occurrence of the expression
- * to store the result into a local.
- */
- register avail_p ravp;
- register int score;
- register offset tmp;
- register line_p mes;
-
- for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
-
- if (ravp->av_size != ws && ravp->av_size != 2*ws) continue;
-
- if (ravp->av_saveloc == (entity_p) 0) {
- /* We save it ourselves. */
- score = 2; /* Stl and lol. */
- } else {
- score = reg_score(ravp->av_saveloc);
- }
- if (desirable(ravp)) {
- score += Lnrelems(ravp->av_occurs);
- OUTTRACE("temporary local score %d", score);
- if (ravp->av_saveloc != (entity_p) 0) {
- tmp = ravp->av_saveloc->en_loc;
- mes = find_mesreg(tmp);
- OUTVERBOSE("re-using %D(LB)", tmp);
- } else {
- tmp = tmplocal(pp, (int) ravp->av_size);
- mes = gen_mesreg(tmp, ravp, pp);
- append(ravp, tmp);
- }
- change_score(mes, score);
- set_replace(ravp, tmp);
- }
- }
-}
+++ /dev/null
-extern eliminate(); /* (proc_p pp)
- * Eliminate some of the recurrences of expressions
- * that were found by the valuenumbering
- * algorithm.
- */
+++ /dev/null
-/* F U N C T I O N S F O R A C C E S S I N G T H E S E T
- *
- * O F E N T I T I E S
- */
-
-#include "../share/types.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/debug.h"
-#include "cs.h"
-#include "cs_alloc.h"
-#include "cs_aux.h"
-
-lset entities; /* Our pseudo symbol-table. */
-
-entity_p find_entity(vn)
- valnum vn;
-{
- /* Try to find the entity with valuenumber vn. */
-
- register Lindex i;
-
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- if (en_elem(i)->en_vn == vn)
- return en_elem(i);
- }
-
- return (entity_p) 0;
-}
-
-STATIC bool same_entity(enp1, enp2)
- entity_p enp1, enp2;
-{
- if (enp1->en_kind != enp2->en_kind) return FALSE;
- if (enp1->en_size != enp2->en_size) return FALSE;
- if (enp1->en_size == UNKNOWN_SIZE) return FALSE;
-
- switch (enp1->en_kind) {
- case ENCONST:
- return enp1->en_val == enp2->en_val;
- case ENLOCAL:
- case ENALOCAL:
- return enp1->en_loc == enp2->en_loc;
- case ENEXTERNAL:
- case ENAEXTERNAL:
- return enp1->en_ext == enp2->en_ext;
- case ENINDIR:
- return enp1->en_ind == enp2->en_ind;
- case ENOFFSETTED:
- case ENAOFFSETTED:
- return enp1->en_base == enp2->en_base &&
- enp1->en_off == enp2->en_off;
- case ENALOCBASE:
- case ENAARGBASE:
- return enp1->en_levels == enp2->en_levels;
- case ENPROC:
- return enp1->en_pro == enp2->en_pro;
- case ENARRELEM:
- return enp1->en_arbase == enp2->en_arbase &&
- enp1->en_index == enp2->en_index &&
- enp1->en_adesc == enp2->en_adesc;
- default:
- return TRUE;
- }
-}
-
-STATIC copy_entity(src, dst)
- entity_p src, dst;
-{
- dst->en_static = src->en_static;
- dst->en_kind = src->en_kind;
- dst->en_size = src->en_size;
-
- switch (src->en_kind) {
- case ENCONST:
- dst->en_val = src->en_val;
- break;
- case ENLOCAL:
- case ENALOCAL:
- dst->en_loc = src->en_loc;
- break;
- case ENEXTERNAL:
- case ENAEXTERNAL:
- dst->en_ext = src->en_ext;
- break;
- case ENINDIR:
- dst->en_ind = src->en_ind;
- break;
- case ENOFFSETTED:
- case ENAOFFSETTED:
- dst->en_base = src->en_base;
- dst->en_off = src->en_off;
- break;
- case ENALOCBASE:
- case ENAARGBASE:
- dst->en_levels = src->en_levels;
- break;
- case ENPROC:
- dst->en_pro = src->en_pro;
- break;
- case ENARRELEM:
- dst->en_arbase = src->en_arbase;
- dst->en_index = src->en_index;
- dst->en_adesc = src->en_adesc;
- break;
- }
-}
-
-entity_p en_enter(enp)
- register entity_p enp;
-{
- /* Put the entity in enp in the entity set, if it is not already there.
- * Return pointer to stored entity.
- */
- register Lindex i;
- register entity_p new;
-
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- if (same_entity(en_elem(i), enp))
- return en_elem(i);
- }
- /* A new entity. */
- new = newentity();
- new->en_vn = newvalnum();
- copy_entity(enp, new);
- Ladd(new, &entities);
-
- return new;
-}
-
-clr_entities()
-{
- /* Throw away all pseudo-symboltable information. */
-
- register Lindex i;
-
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- oldentity(en_elem(i));
- }
- Ldeleteset(entities);
- entities = Lempty_set();
-}
+++ /dev/null
-extern lset entities; /* The pseudo-symboltable. */
-
-extern entity_p find_entity(); /* (valnum vn)
- * Tries to find an entity with value number vn.
- */
-
-extern entity_p en_enter(); /* (entity_p enp)
- * Enter the entity in enp in the set of
- * entities if it was not already there.
- */
-
-extern clr_entities(); /* ()
- * Release all space occupied by our
- * pseudo-symboltable.
- */
+++ /dev/null
-#include "../../../h/em_mnem.h"
-#include "../share/types.h"
-#include "../share/aux.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_entity.h"
-#include "cs_stack.h"
-
-#define WS1 0
-#define WS2 1
-#define PS 2
-#define ARGW 3
-#define ARDESC3 4
-
-STATIC struct inf_entity {
- byte inf_instr; /* Key. */
- byte inf_used; /* Kind of entity used by key. */
- byte inf_size; /* Indication of the size. */
-} inf_table[] = {
- op_adp, ENAOFFSETTED, PS,
- op_dee, ENEXTERNAL, WS1,
- op_del, ENLOCAL, WS1,
- op_ine, ENEXTERNAL, WS1,
- op_inl, ENLOCAL, WS1,
- op_lae, ENAEXTERNAL, PS,
- op_lal, ENALOCAL, PS,
- op_lar, ENARRELEM, ARDESC3,
- op_ldc, ENCONST, WS2,
- op_lde, ENEXTERNAL, WS2,
- op_ldf, ENOFFSETTED, WS2,
- op_ldl, ENLOCAL, WS2,
- op_lil, ENINDIR, WS1,
- op_lim, ENIGNMASK, WS1,
- op_loc, ENCONST, WS1,
- op_loe, ENEXTERNAL, WS1,
- op_lof, ENOFFSETTED, WS1,
- op_loi, ENINDIR, ARGW,
- op_lol, ENLOCAL, WS1,
- op_lpi, ENPROC, PS,
- op_lxa, ENAARGBASE, PS,
- op_lxl, ENALOCBASE, PS,
- op_sar, ENARRELEM, ARDESC3,
- op_sde, ENEXTERNAL, WS2,
- op_sdf, ENOFFSETTED, WS2,
- op_sdl, ENLOCAL, WS2,
- op_sil, ENINDIR, WS1,
- op_ste, ENEXTERNAL, WS1,
- op_stf, ENOFFSETTED, WS1,
- op_sti, ENINDIR, ARGW,
- op_stl, ENLOCAL, WS1,
- op_zer, ENCONST, ARGW,
- op_zre, ENEXTERNAL, WS1,
- op_zrf, ENFZER, ARGW,
- op_zrl, ENLOCAL, WS1,
- op_nop /* Delimitor. */
-};
-
-#define INFKEY(ip) (ip->inf_instr & BMASK)
-#define ENKIND(ip) ip->inf_used
-#define SIZEINF(ip) ip->inf_size
-
-STATIC struct inf_entity *getinf(n)
- int n;
-{
- struct inf_entity *ip;
-
- for (ip = &inf_table[0]; INFKEY(ip) != op_nop; ip++) {
- if (INFKEY(ip) == n) return ip;
- }
- return (struct inf_entity *) 0;
-}
-
-entity_p getentity(lnp, l_out)
- line_p lnp, *l_out;
-{
- /* Build the entities where lnp refers to, and enter them.
- * If a token needs to be popped, the first line that pushed
- * it is stored in *l_out.
- * The main entity lnp refers to, is returned.
- */
- struct entity en;
- struct token tk;
- struct inf_entity *ip;
- valnum vn;
- offset indexsize;
- struct token adesc, index, arbase;
-
- *l_out = lnp;
-
- /* Lor is a special case. */
- if (INSTR(lnp) == op_lor) {
- en.en_static = FALSE;
- en.en_size = ps;
- switch (off_set(lnp)) {
- default:
- assert(FALSE);
- break;
- case 0:
- en.en_kind = ENLOCBASE;
- break;
- case 1:
- return (entity_p) 0;
- case 2:
- en.en_kind = ENHEAPPTR;
- break;
- }
- return en_enter(&en);
- }
-
- if ( (ip = getinf(INSTR(lnp))) == (struct inf_entity *) 0)
- return (entity_p) 0; /* It does not refer to any entity. */
-
- /* Lil and sil refer to two entities. */
- if (INSTR(lnp) == op_lil || INSTR(lnp) == op_sil) {
- en.en_static = FALSE;
- en.en_kind = ENLOCAL;
- en.en_size = ps; /* Local must be a pointer. */
- en.en_loc = off_set(lnp);
- vn = en_enter(&en)->en_vn;
- }
-
- en.en_static = FALSE;
- en.en_kind = ENKIND(ip);
-
- /* Fill in the size of the entity. */
- switch (SIZEINF(ip)) {
- default:
- assert(FALSE);
- break;
- case WS1:
- en.en_size = ws;
- break;
- case WS2:
- en.en_size = 2*ws;
- break;
- case PS:
- en.en_size = ps;
- break;
- case ARGW:
- if (TYPE(lnp) != OPNO) {
- en.en_size = off_set(lnp);
- } else {
- Pop(&tk, (offset) ws);
- *l_out = tk.tk_lfirst;
- en.en_size = UNKNOWN_SIZE;
- }
- break;
- case ARDESC3:
- assert(en.en_kind == ENARRELEM);
- if (TYPE(lnp) != OPNO) {
- indexsize = off_set(lnp);
- } else {
- Pop(&tk, (offset) ws);
- indexsize = UNKNOWN_SIZE;
- }
- Pop(&adesc, (offset) ps);
- en.en_adesc = adesc.tk_vn;
- Pop(&index, indexsize);
- en.en_index = index.tk_vn;
- Pop(&arbase, (offset) ps);
- en.en_arbase = arbase.tk_vn;
- *l_out = arbase.tk_lfirst;
- en.en_size = array_elemsize(adesc.tk_vn);
- break;
- }
-
- /* Fill in additional information. */
- switch (en.en_kind) {
- case ENFZER:
- en.en_static = TRUE;
- break;
- case ENCONST:
- en.en_static = TRUE;
- en.en_val = off_set(lnp);
- break;
- case ENALOCAL:
- en.en_static = TRUE;
- case ENLOCAL:
- en.en_loc = off_set(lnp);
- break;
- case ENAEXTERNAL:
- en.en_static = TRUE;
- case ENEXTERNAL:
- en.en_ext = OBJ(lnp);
- break;
- case ENINDIR:
- if (INSTR(lnp) == op_loi || INSTR(lnp) == op_sti) {
- Pop(&tk, (offset) ps);
- *l_out = tk.tk_lfirst;
- vn = tk.tk_vn;
- }
- en.en_ind = vn;
- break;
- case ENAOFFSETTED:
- en.en_static = TRUE;
- case ENOFFSETTED:
- Pop(&tk, (offset) ps);
- *l_out = tk.tk_lfirst;
- en.en_base = tk.tk_vn;
- en.en_off = off_set(lnp);
- break;
- case ENALOCBASE:
- case ENAARGBASE:
- en.en_static = TRUE;
- en.en_levels = off_set(lnp);
- break;
- case ENPROC:
- en.en_pro = PROC(lnp);
- break;
- case ENARRELEM:
- /* We gathered the information in the previous switch.
- */
- break;
- }
-
- return en_enter(&en);
-}
+++ /dev/null
-extern entity_p getentity(); /* (line_p lnp, *l_out)
- * Extract the entity lnp refers and enter it
- * in the table of entities. The main entity
- * lnp refers to is returned; sometimes there
- * is more than one entity. The first line that
- * was involved in pushing it is returned
- * through l_out.
- */
+++ /dev/null
-#include "../../../h/em_mnem.h"
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/aux.h"
-#include "../share/map.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_debug.h"
-#include "cs_avail.h"
-#include "cs_entity.h"
-
-STATIC base_valno(enp)
- entity_p enp;
-{
- /* Return the value number of the (base) address of an indirectly
- * accessed entity.
- */
- switch (enp->en_kind) {
- default:
- assert(FALSE);
- break;
- case ENINDIR:
- return enp->en_ind;
- case ENOFFSETTED:
- return enp->en_base;
- case ENARRELEM:
- return enp->en_arbase;
- }
- /* NOTREACHED */
-}
-
-STATIC entity_p find_base(vn)
- valnum vn;
-{
- /* Vn is the valuenumber of the (base) address of an indirectly
- * accessed entity. Return the entity that holds this address
- * recursively.
- */
- register Lindex i;
- register avail_p ravp;
-
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- register entity_p renp = en_elem(i);
-
- if (renp->en_vn == vn) {
- switch (renp->en_kind) {
- case ENAEXTERNAL:
- case ENALOCAL:
- case ENALOCBASE:
- case ENAARGBASE:
- return renp;
- case ENAOFFSETTED:
- return find_base(renp->en_base);
- }
- }
- }
-
- /* We couldn't find it among the entities.
- * Let's try the available expressions.
- */
- for (ravp = avails; ravp != (avail_p) 0; ravp = ravp->av_before) {
- if (ravp->av_result == vn) {
- if (ravp->av_instr == (byte) op_aar)
- return find_base(ravp->av_ofirst);
- if (ravp->av_instr == (byte) op_ads)
- return find_base(ravp->av_oleft);
- }
- }
-
- /* Bad luck. */
- return (entity_p) 0;
-}
-
-STATIC bool obj_overlap(op1, op2)
- obj_p op1, op2;
-{
- /* Op1 and op2 point to two objects in the same datablock.
- * Obj_overlap returns whether these objects might overlap.
- */
- obj_p tmp;
-
- if (op1->o_off > op2->o_off) {
- /* Exchange them. */
- tmp = op1; op1 = op2; op2 = tmp;
- }
- return op1->o_size == UNKNOWN_SIZE ||
- op1->o_off + op1->o_size > op2->o_off;
-}
-
-#define same_datablock(o1, o2) ((o1)->o_dblock == (o2)->o_dblock)
-
-STATIC bool addr_local(enp)
- entity_p enp;
-{
- /* Is enp the address of a stack item. */
-
- if (enp == (entity_p) 0) return FALSE;
-
- return enp->en_kind == ENALOCAL || enp->en_kind == ENALOCBASE ||
- enp->en_kind == ENAARGBASE;
-}
-
-STATIC bool addr_external(enp)
- entity_p enp;
-{
- /* Is enp the address of an external. */
-
- return enp != (entity_p) 0 && enp->en_kind == ENAEXTERNAL;
-}
-
-STATIC kill_external(obp, indir)
- obj_p obp;
- int indir;
-{
- /* A store is done via the object in obp. If this store is direct
- * we kill directly accessed entities in the same data block only
- * if they overlap with obp, otherwise we kill everything in the
- * data block. Indirectly accessed entities of which it can not be
- * proven taht they are not in the same data block, are killed in
- * both cases.
- */
- register Lindex i;
-
- OUTTRACE("kill external", 0);
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- entity_p enp = en_elem(i);
- entity_p base;
-
- switch (enp->en_kind) {
- case ENEXTERNAL:
- if (!same_datablock(enp->en_ext, obp))
- break;
- if (!indir && !obj_overlap(enp->en_ext, obp))
- break;
- OUTTRACE("kill %d", enp->en_vn);
- enp->en_vn = newvalnum();
- break;
- case ENINDIR:
- case ENOFFSETTED:
- case ENARRELEM:
- /* We spare its value number if we are sure
- * that its (base) address points into the
- * stack or into another data block.
- */
- base = find_base(base_valno(enp));
- if (addr_local(base))
- break;
- if (addr_external(base) &&
- !same_datablock(base->en_ext, obp)
- )
- break;
- OUTTRACE("kill %d", enp->en_vn);
- enp->en_vn = newvalnum();
- break;
- }
- }
-}
-
-STATIC bool loc_overlap(enp1, enp2)
- entity_p enp1, enp2;
-{
- /* Enp1 and enp2 point to two locals. Loc_overlap returns whether
- * they overlap.
- */
- entity_p tmp;
-
- assert(enp1->en_kind == ENLOCAL && enp2->en_kind == ENLOCAL);
-
- if (enp1->en_loc > enp2->en_loc) {
- /* Exchange them. */
- tmp = enp1; enp1 = enp2; enp2 = tmp;
- }
- if (enp1->en_loc < 0 && enp2->en_loc >= 0)
- return FALSE; /* Locals and parameters do not overlap. */
- else return enp1->en_size == UNKNOWN_SIZE ||
- enp1->en_loc + enp1->en_size > enp2->en_loc;
-}
-
-STATIC kill_local(enp, indir)
- entity_p enp;
- bool indir;
-{
- /* This time a store is done into an ENLOCAL. */
-
- register Lindex i;
-
- OUTTRACE("kill local", 0);
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- entity_p rep = en_elem(i);
- entity_p base;
-
- switch (rep->en_kind) {
- case ENLOCAL:
- if (indir) {
- /* Kill locals that might be stored into
- * via a pointer. Note: enp not used.
- */
- if (!is_regvar(rep->en_loc)) {
- OUTTRACE("kill %d", rep->en_vn);
- rep->en_vn = newvalnum();
- }
- } else if (loc_overlap(rep, enp)) {
- /* Only kill overlapping locals. */
- OUTTRACE("kill %d", rep->en_vn);
- rep->en_vn = newvalnum();
- }
- break;
- case ENINDIR:
- case ENOFFSETTED:
- case ENARRELEM:
- if (!is_regvar(enp->en_loc)) {
- base = find_base(base_valno(rep));
- if (!addr_external(base)) {
- OUTTRACE("kill %d", rep->en_vn);
- rep->en_vn = newvalnum();
- }
- }
- break;
- }
- }
-}
-
-STATIC kill_sim()
-{
- /* A store is done into the ENIGNMASK. */
-
- register Lindex i;
-
- OUTTRACE("kill sim", 0);
- for (i = Lfirst(entities); i != (Lindex) 0; i = Lnext(i, entities)) {
- register entity_p rep = en_elem(i);
-
- if (rep->en_kind == ENIGNMASK) {
- OUTTRACE("kill %d", rep->en_vn);
- rep->en_vn = newvalnum();
- return; /* There is only one ignoremask. */
- }
- }
-}
-
-kill_direct(enp)
- entity_p enp;
-{
- /* A store will be done into enp. We must forget the values of all the
- * entities this one may overlap with.
- */
- switch (enp->en_kind) {
- default:
- assert(FALSE);
- break;
- case ENEXTERNAL:
- kill_external(enp->en_ext, FALSE);
- break;
- case ENLOCAL:
- kill_local(enp, FALSE);
- break;
- case ENIGNMASK:
- kill_sim();
- break;
- }
-}
-
-kill_indir(enp)
- entity_p enp;
-{
- /* An indirect store is done, in an ENINDIR,
- * an ENOFFSETTED or an ENARRELEM.
- */
- entity_p p;
-
- /* If we can find the (base) address of this entity, then we can spare
- * the entities that are provably not pointed to by the address.
- * We will also make use of the MES 3 pseudo's, generated by
- * the front-end. When a MES 3 is generated for a local, this local
- * will not be referenced indirectly.
- */
- if ((p = find_base(base_valno(enp))) == (entity_p) 0) {
- kill_much(); /* Kill all entities without registermessage. */
- } else {
- switch (p->en_kind) {
- case ENAEXTERNAL:
- /* An indirect store into global data. */
- kill_external(p->en_ext, TRUE);
- break;
- case ENALOCAL:
- case ENALOCBASE:
- case ENAARGBASE:
- /* An indirect store into stack data. */
- kill_local(p, TRUE);
- break;
- }
- }
-}
-
-kill_much()
-{
- /* Kills all killable entities,
- * except the locals for which a registermessage was generated.
- */
- register Lindex i;
-
- OUTTRACE("kill much", 0);
- for (i = Lfirst(entities); i != (Lindex) i; i = Lnext(i, entities)) {
- register entity_p rep = en_elem(i);
-
- if (rep->en_static) continue;
- if (rep->en_kind == ENLOCAL && is_regvar(rep->en_loc)) continue;
- OUTTRACE("kill %d", rep->en_vn);
- rep->en_vn = newvalnum();
- }
-}
-
-STATIC bool bad_procflags(pp)
- proc_p pp;
-{
- /* Return whether the flags about the procedure in pp indicate
- * that we have little information about it. It might be that
- * we haven't seen the text of pp, or that we have seen that pp
- * calls a procedure which we haven't seen the text of.
- */
- return !(pp->p_flags1 & PF_BODYSEEN) || (pp->p_flags1 & PF_CALUNKNOWN);
-}
-
-STATIC kill_globset(s)
- cset s;
-{
- /* S is a set of global variables that might be changed.
- * We act as if a direct store is done into each of them.
- */
- register Cindex i;
-
- OUTTRACE("kill globset", 0);
- for (i = Cfirst(s); i != (Cindex) 0; i = Cnext(i,s)) {
- kill_external(omap[Celem(i)], FALSE);
- }
-}
-
-kill_call(pp)
- proc_p pp;
-{
- /* Kill everything that might be destroyed by calling
- * the procedure in pp.
- */
- if (bad_procflags(pp)) {
- /* We don't know enough about this procedure. */
- kill_much();
- } else if (pp->p_change->c_flags & CF_INDIR) {
- /* The procedure does an indirect store. */
- kill_much();
- } else {
- /* Procedure might affect global data. */
- kill_globset(pp->p_change->c_ext);
- }
-}
-
-kill_all()
-{
- /* Kills all entities. */
-
- register Lindex i;
-
- OUTTRACE("kill all entities", 0);
- for (i = Lfirst(entities); i != (Lindex) i; i = Lnext(i, entities)) {
- entity_p enp = en_elem(i);
-
- OUTTRACE("kill %d", enp->en_vn);
- enp->en_vn = newvalnum();
- }
-}
+++ /dev/null
-extern kill_call(); /* (proc_p pp)
- * Kill all entities that might have an other value
- * after execution of the procedure in pp.
- */
-
-extern kill_much(); /* ()
- * Kill all killable entities except those for which
- * a register message was generated.
- * Constants, addresses, etc are not killable.
- */
-
-extern kill_indir(); /* (entity_p enp)
- * Kill all entities that might have an other value
- * after indirect assignment to the entity in enp.
- */
-
-extern kill_direct(); /* (entity_p enp)
- * Kill all entities that might have an other value
- * after direct assignment to the entity in enp.
- */
-
-extern kill_all(); /* ()
- * Kill all entities.
- */
+++ /dev/null
-/* Functions to partition the huge set of EM-instructions. */
-
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "../../../h/em_spec.h"
-#include "../share/types.h"
-#include "../share/aux.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "cs.h"
-#include "cs_stack.h"
-
-#define XXX (-1)
-#define ARGW 0
-#define WS 1
-#define PS 2
-#define FEF 3
-#define FIF 4
-#define CVT 5
-
-#define ANY 0
-#define PTR 1
-#define FLT 2
-
-STATIC struct {
- byte i_group; /* Group of instruction. */
- byte i_op1; /* Indication of size of operand of unary operator. */
- /* Idem for 1st operand of binary operator. */
- byte i_op2; /* Idem for 2nd operand of binary operator. */
- byte i_av; /* Idem for result of operators. */
- byte i_regtype; /* ANY, PTR, FLT. */
-} info[] = {
- XXX, XXX, XXX, XXX, XXX,
-/* aar */ TERNAIR_OP, XXX, XXX, PS, PTR,
-/* adf */ BINAIR_OP, ARGW, ARGW, ARGW, FLT,
-/* adi */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* adp */ EXPENSIVE_LOAD, XXX, XXX, XXX, PTR,
-/* ads */ BINAIR_OP, PS, ARGW, PS, PTR,
-/* adu */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* and */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* asp */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* ass */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* beq */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* bge */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* bgt */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* ble */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* blm */ HOPELESS, XXX, XXX, XXX, XXX,
-/* bls */ HOPELESS, XXX, XXX, XXX, XXX,
-/* blt */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* bne */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* bra */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* cai */ SIDE_EFFECTS, XXX, XXX, XXX, XXX,
-/* cal */ SIDE_EFFECTS, XXX, XXX, XXX, XXX,
-/* cff */ TERNAIR_OP, XXX, XXX, CVT, FLT,
-/* cfi */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* cfu */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* cif */ TERNAIR_OP, XXX, XXX, CVT, FLT,
-/* cii */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* ciu */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* cmf */ BINAIR_OP, ARGW, ARGW, WS, ANY,
-/* cmi */ BINAIR_OP, ARGW, ARGW, WS, ANY,
-/* cmp */ BINAIR_OP, PS, PS, WS, ANY,
-/* cms */ BINAIR_OP, ARGW, ARGW, WS, ANY,
-/* cmu */ BINAIR_OP, ARGW, ARGW, WS, ANY,
-/* com */ UNAIR_OP, ARGW, XXX, ARGW, ANY,
-/* csa */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* csb */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* cuf */ TERNAIR_OP, XXX, XXX, CVT, FLT,
-/* cui */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* cuu */ TERNAIR_OP, XXX, XXX, CVT, ANY,
-/* dch */ UNAIR_OP, PS, XXX, PS, PTR,
-/* dec */ UNAIR_OP, WS, XXX, WS, ANY,
-/* dee */ KILL_ENTITY, XXX, XXX, XXX, XXX,
-/* del */ KILL_ENTITY, XXX, XXX, XXX, XXX,
-/* dup */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* dus */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* dvf */ BINAIR_OP, ARGW, ARGW, ARGW, FLT,
-/* dvi */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* dvu */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* exg */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* fef */ UNAIR_OP, ARGW, XXX, FEF, XXX,
-/* fif */ BINAIR_OP, ARGW, ARGW, FIF, XXX,
-/* fil */ IGNORE, XXX, XXX, XXX, XXX,
-/* gto */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* inc */ UNAIR_OP, WS, XXX, WS, ANY,
-/* ine */ KILL_ENTITY, XXX, XXX, XXX, XXX,
-/* inl */ KILL_ENTITY, XXX, XXX, XXX, XXX,
-/* inn */ BINAIR_OP, ARGW, WS, WS, ANY,
-/* ior */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* lae */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lal */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lar */ LOAD_ARRAY, XXX, XXX, XXX, ANY,
-/* ldc */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lde */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* ldf */ EXPENSIVE_LOAD, XXX, XXX, XXX, ANY,
-/* ldl */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lfr */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* lil */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lim */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lin */ IGNORE, XXX, XXX, XXX, XXX,
-/* lni */ IGNORE, XXX, XXX, XXX, XXX,
-/* loc */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* loe */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lof */ EXPENSIVE_LOAD, XXX, XXX, XXX, ANY,
-/* loi */ EXPENSIVE_LOAD, XXX, XXX, XXX, ANY,
-/* lol */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lor */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* los */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* lpb */ UNAIR_OP, PS, XXX, PS, PTR,
-/* lpi */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* lxa */ EXPENSIVE_LOAD, XXX, XXX, XXX, PTR,
-/* lxl */ EXPENSIVE_LOAD, XXX, XXX, XXX, PTR,
-/* mlf */ BINAIR_OP, ARGW, ARGW, ARGW, FLT,
-/* mli */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* mlu */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* mon */ HOPELESS, XXX, XXX, XXX, XXX,
-/* ngf */ UNAIR_OP, ARGW, XXX, ARGW, FLT,
-/* ngi */ UNAIR_OP, ARGW, XXX, ARGW, ANY,
-/* nop */ IGNORE, XXX, XXX, XXX, XXX,
-/* rck */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* ret */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* rmi */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* rmu */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* rol */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* ror */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* rtt */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* sar */ STORE_ARRAY, XXX, XXX, XXX, XXX,
-/* sbf */ BINAIR_OP, ARGW, ARGW, ARGW, FLT,
-/* sbi */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* sbs */ BINAIR_OP, PS, PS, ARGW, ANY,
-/* sbu */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* sde */ STORE_DIRECT, XXX, XXX, XXX, XXX,
-/* sdf */ STORE_INDIR, XXX, XXX, XXX, XXX,
-/* sdl */ STORE_DIRECT, XXX, XXX, XXX, XXX,
-/* set */ UNAIR_OP, WS, XXX, ARGW, ANY,
-/* sig */ FIDDLE_STACK, XXX, XXX, XXX, XXX,
-/* sil */ STORE_INDIR, XXX, XXX, XXX, XXX,
-/* sim */ STORE_DIRECT, XXX, XXX, XXX, XXX,
-/* sli */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* slu */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* sri */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* sru */ BINAIR_OP, ARGW, WS, ARGW, ANY,
-/* ste */ STORE_DIRECT, XXX, XXX, XXX, XXX,
-/* stf */ STORE_INDIR, XXX, XXX, XXX, XXX,
-/* sti */ STORE_INDIR, XXX, XXX, XXX, XXX,
-/* stl */ STORE_DIRECT, XXX, XXX, XXX, XXX,
-/* str */ HOPELESS, XXX, XXX, XXX, XXX,
-/* sts */ HOPELESS, XXX, XXX, XXX, XXX,
-/* teq */ UNAIR_OP, WS, XXX, WS, ANY,
-/* tge */ UNAIR_OP, WS, XXX, WS, ANY,
-/* tgt */ UNAIR_OP, WS, XXX, WS, ANY,
-/* tle */ UNAIR_OP, WS, XXX, WS, ANY,
-/* tlt */ UNAIR_OP, WS, XXX, WS, ANY,
-/* tne */ UNAIR_OP, WS, XXX, WS, ANY,
-/* trp */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* xor */ BINAIR_OP, ARGW, ARGW, ARGW, ANY,
-/* zeq */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zer */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* zge */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zgt */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zle */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zlt */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zne */ BBLOCK_END, XXX, XXX, XXX, XXX,
-/* zre */ KILL_ENTITY, XXX, XXX, XXX, XXX,
-/* zrf */ SIMPLE_LOAD, XXX, XXX, XXX, XXX,
-/* zrl */ KILL_ENTITY, XXX, XXX, XXX, XXX
-};
-
-#define GROUP(n) (info[n].i_group)
-#define OP1SIZE(l) (info[INSTR(l)].i_op1)
-#define OP2SIZE(l) (info[INSTR(l)].i_op2)
-#define AVSIZE(l) (info[INSTR(l)].i_av)
-#define REGTYPE(n) (info[n].i_regtype)
-
-int instrgroup(lnp)
- line_p lnp;
-{
- if (INSTR(lnp) == op_lor && SHORT(lnp) == 1) {
- /* We can't do anything with the stackpointer. */
- return FIDDLE_STACK;
- }
- if (INSTR(lnp) < sp_fmnem || INSTR(lnp) > sp_lmnem) {
- VI((short) INSTR(lnp));
- return IGNORE;
- }
- return GROUP(INSTR(lnp));
-}
-
-bool stack_group(instr)
- int instr;
-{
- /* Is this an instruction that only does something to the top of
- * the stack?
- */
- switch (GROUP(instr)) {
- case SIMPLE_LOAD:
- case EXPENSIVE_LOAD:
- case LOAD_ARRAY:
- case UNAIR_OP:
- case BINAIR_OP:
- case TERNAIR_OP:
- return TRUE;
- default:
- return FALSE;
- }
-}
-
-STATIC offset argw(lnp)
- line_p lnp;
-{
- /* Some EM-instructions have their argument either on the same line,
- * or on top of the stack. We give up when the argument is on top of
- * the stack.
- */
- struct token dummy;
-
- if (TYPE(lnp) != OPNO) {
- return off_set(lnp);
- } else {
- Pop(&dummy, (offset) ws);
- return UNKNOWN_SIZE;
- }
-}
-
-offset op11size(lnp)
- line_p lnp;
-{
- /* Returns the size of the first argument of
- * the unary operator in lnp.
- */
-
- switch (OP1SIZE(lnp)) {
- case ARGW:
- return argw(lnp);
- case WS:
- return ws;
- case PS:
- return ps;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-offset op12size(lnp)
- line_p lnp;
-{
- /* Same for first of binary. */
-
- switch (OP1SIZE(lnp)) {
- case ARGW:
- return argw(lnp);
- case PS:
- return ps;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-offset op22size(lnp)
- line_p lnp;
-{
- switch (OP2SIZE(lnp)) {
- case ARGW:
- return argw(lnp);
- case WS:
- return ws;
- case PS:
- return ps;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-/* Ternary operators are op_aar and conversions between types and/or sizes. */
-
-offset op13size(lnp)
- line_p lnp;
-{
- /* When the instruction is a conversion, the size of the first
- * operand is the value of the second operand.
- * We only handle the most likely case, namely that the second operand
- * was pushed by a loc-instruction.
- */
- if (INSTR(lnp) == op_aar) return ps;
-
- if (lnp->l_prev != (line_p) 0 &&
- lnp->l_prev->l_prev != (line_p) 0 &&
- INSTR(lnp->l_prev->l_prev) == op_loc
- )
- return off_set(lnp->l_prev->l_prev);
- else
- return UNKNOWN_SIZE;
-}
-
-offset op23size(lnp)
- line_p lnp;
-{
- if (INSTR(lnp) == op_aar)
- return argw(lnp);
- else
- return ws;
-}
-
-offset op33size(lnp)
- line_p lnp;
-{
- if (INSTR(lnp) == op_aar)
- return ps;
- else
- return ws;
-}
-
-offset avsize(lnp)
- line_p lnp;
-{
- /* Returns the size of the result of the instruction in lnp.
- * If the instruction is a conversion this size is given on the stack.
- * We only handle the case that this value was pushed by a loc.
- */
- offset size;
-
- switch (AVSIZE(lnp)) {
- case ARGW:
- return argw(lnp);
- case WS:
- return ws;
- case PS:
- return ps;
- case FEF:
- if ((size = argw(lnp)) != UNKNOWN_SIZE)
- return size + ws;
- else
- return UNKNOWN_SIZE;
- case FIF:
- if ((size = argw(lnp)) != UNKNOWN_SIZE)
- return size + size;
- else
- return UNKNOWN_SIZE;
- case CVT:
- if (lnp->l_prev != (line_p) 0 &&
- INSTR(lnp->l_prev) == op_loc
- )
- return off_set(lnp->l_prev);
- else
- return UNKNOWN_SIZE;
- default:
- assert(FALSE);
- break;
- }
- /* NOTREACHED */
-}
-
-int regtype(instr)
- byte instr;
-{
- switch (REGTYPE(instr & BMASK)) {
- case ANY:
- return reg_any;
- case PTR:
- return reg_pointer;
- case FLT:
- return reg_float;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
+++ /dev/null
-/* These routines partition the huge set of EM-instructions in
- * "manageable chunks.
- */
-
-extern int instrgroup(); /* (line_p lnp)
- * Return the group into which the instruction
- * in lnp belongs to.
- */
-
-extern bool stack_group(); /* (int instr)
- * Return whether instr is an instruction that
- * only changes the state of the stack, i.e.
- * is a "true" operator.
- */
-
-extern offset op11size(); /* (line_p lnp)
- * Return the size of the operand of the unary
- * operator in lnp.
- */
-
-extern offset op12size(); /* (line_p lnp)
- * Return the size of the first operand of the
- * binary operator in lnp.
- */
-
-extern offset op22size(); /* (line_p lnp)
- * Return the size of the second operand of the
- * binary operator in lnp.
- */
-
-extern offset op13size(); /* (line_p lnp)
- * Return the size of the first operand of the
- * ternary operator in lnp.
- */
-
-extern offset op23size(); /* (line_p lnp)
- * Return the size of the second operand of the
- * ternary operator in lnp.
- */
-
-extern offset op33size(); /* (line_p lnp)
- * Return the size of the third operand of the
- * ternary operator in lnp.
- */
-
-extern offset avsize(); /* (line_p lnp)
- * Return the size of the result of the
- * operator in lnp.
- */
-
-extern int regtype(); /* (byte instr)
- * Return in what kind of machine-register
- * the result of instr should be stored:
- * pointer, float, or any.
- */
+++ /dev/null
-#include <stdio.h>
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/aux.h"
-#include "../share/cset.h"
-#include "../share/lset.h"
-#include "cs.h"
-#include "cs_aux.h"
-#include "cs_debug.h"
-#include "cs_avail.h"
-#include "cs_partit.h"
-
-STATIC cset addr_modes;
-STATIC cset cheaps;
-STATIC cset forbidden;
-STATIC short LX_threshold;
-STATIC short AR_limit;
-STATIC bool DO_sli;
-
-STATIC get_instrs(f, s_p)
- FILE *f;
- cset *s_p;
-{
- /* Read a set of instructions from inputfile f into *s_p.
- * Such a set must be delimited by a number lower than
- * the number of the first EM mnemonic.
- */
- Celem_t instr;
-
- fscanf(f, "%d", &instr);
- while (instr >= sp_fmnem) {
- Cadd(instr, s_p);
- fscanf(f, "%d", &instr);
- }
-}
-
-STATIC choose_cset(f, s_p)
- FILE *f;
- cset *s_p;
-{
- /* Read two compact sets of EM instructions from inputfile f.
- * Choose the first if we optimize with respect to time,
- * the second if we optimize with respect to space, as
- * indicated by time_space_ratio.
- */
- cset cs1, cs2; /* Two dummy sets. */
-
- *s_p = Cempty_set((short) sp_lmnem);
-
- cs1 = Cempty_set((short) sp_lmnem);
- get_instrs(f, &cs1);
- cs2 = Cempty_set((short) sp_lmnem);
- get_instrs(f, &cs2);
-
- Ccopy_set(time_space_ratio >= 50 ? cs1 : cs2, s_p);
-
- Cdeleteset(cs1); Cdeleteset(cs2);
- }
-
-cs_machinit(f)
- FILE *f;
-{
- char s[100];
- int time, space;
-
- /* Find piece that is relevant for this phase. */
- do {
- while (getc(f) != '\n');
- fscanf(f, "%s", s);
- } while (strcmp(s, "%%CS"));
-
- /* Choose a set of instructions which must only be eliminated
- * if they are at the root of another expression.
- */
- choose_cset(f, &addr_modes);
-
- /* Choose a set of cheap instructions; i.e. instructions that
- * are cheaper than a move to save the result of such an
- * instruction.
- */
- choose_cset(f, &cheaps);
-
- /* Read how many lexical levels back an LXL/LXA instruction
- * must at least look before it will be eliminated.
- */
- fscanf(f, "%d %d", &time, &space);
- LX_threshold = time_space_ratio >= 50 ? time : space;
-
- /* Read what the size of an array-element may be,
- * before we think that it is to big to replace
- * a LAR/SAR of it by AAR LOI/STI <size>.
- */
- fscanf(f, "%d", &space);
- AR_limit = space;
-
- /* Read whether we must eliminate an SLI instruction
- * when it is part of an array-index computation.
- */
- fscanf(f, "%d %d", &time, &space);
- DO_sli = time_space_ratio >= 50 ? time : space;
-
- /* Read a set of instructions which we do not want to eliminate.
- * Note: only instructions need be given that may in principle
- * be eliminated, but for which better code can be generated
- * when they stay, and with which is not dealt in the common
- * decision routines.
- */
- choose_cset(f, &forbidden);
-}
-
-STATIC bool is_index(lnp)
- line_p lnp;
-{
- /* Return whether the SLI-instruction in lnp is part of
- * an array-index computation.
- */
- return lnp->l_prev != (line_p) 0 && INSTR(lnp->l_prev) == op_loc &&
- lnp->l_next != (line_p) 0 && INSTR(lnp->l_next) == op_ads;
-}
-
-STATIC bool gains(avp)
- avail_p avp;
-{
- /* Return whether we can gain something, when we eliminate
- * an expression such as in avp. We just glue together some
- * heuristics with some user-supplied stuff.
- */
- if (Cis_elem(avp->av_instr & BMASK, forbidden))
- return FALSE;
-
- if (avp->av_instr == (byte) op_lxa || avp->av_instr == (byte) op_lxl)
- return off_set(avp->av_found) >= LX_threshold;
-
- if (avp->av_instr == (byte) op_sli)
- return !is_index(avp->av_found) || DO_sli;
-
- if (Cis_elem(avp->av_instr & BMASK, addr_modes))
- return instrgroup(avp->av_found->l_prev) != SIMPLE_LOAD;
-
- if (Cis_elem(avp->av_instr & BMASK, cheaps))
- return avp->av_saveloc != (entity_p) 0;
-
- return TRUE;
-}
-
-STATIC bool okay_lines(avp, ocp)
- avail_p avp;
- occur_p ocp;
-{
- register line_p lnp, next;
-
- for (lnp = ocp->oc_lfirst; lnp != (line_p) 0; lnp = next) {
- next = lnp != ocp->oc_llast ? lnp->l_next : (line_p) 0;
-
- if (INSTR(lnp) < sp_fmnem || INSTR(lnp) > sp_lmnem)
- return FALSE;
- if (!stack_group(INSTR(lnp))) {
- /* Check for SAR-instruction. */
- if (INSTR(lnp) != op_sar || next != (line_p) 0)
- return FALSE;
- }
- }
- /* All lines in this occurrence can in principle be eliminated;
- * no stores, messages, calls etc.
- * We now check whether it is desirable to treat a LAR or a SAR
- * as an AAR LOI/STI. This depends on the size of the array-elements.
- */
- if (INSTR(ocp->oc_llast) == op_lar || INSTR(ocp->oc_llast) == op_sar) {
- if (avp->av_instr == (byte) op_aar && time_space_ratio < 50) {
- return array_elemsize(avp->av_othird) <= AR_limit;
- }
- }
- return TRUE;
-}
-
-bool desirable(avp)
- avail_p avp;
-{
- register Lindex i, next;
-
- if (!gains(avp)) {
- OUTTRACE("no gain", 0);
- SHOWAVAIL(avp);
- return FALSE;
- }
-
- /* Walk through the occurrences to see whether it is okay to
- * eliminate them. If not, remove them from the set.
- */
- for (i = Lfirst(avp->av_occurs); i != (Lindex) 0; i = next) {
- next = Lnext(i, avp->av_occurs);
-
- if (!okay_lines(avp, occ_elem(i))) {
- OUTTRACE("may not eliminate", 0);
-# ifdef TRACE
- SHOWOCCUR(occ_elem(i));
-# endif
- oldoccur(occ_elem(i));
- Lremove(Lelem(i), &avp->av_occurs);
- }
- }
-
- return Lnrelems(avp->av_occurs) > 0;
-}
+++ /dev/null
-extern cs_machinit(); /* (FILE *f)
- * Read phase-specific information from f.
- */
-
-extern bool desirable(); /* (avail_p avp)
- * Return whether it is desirable to eliminate
- * the recurrences of the expression in avp.
- * At the same time delete the recurrences
- * for which it is not allowed.
- */
+++ /dev/null
-/*
- * S T A C K M O D U L E
- */
-#include "../share/types.h"
-#include "../share/global.h"
-#include "../share/debug.h"
-#include "../share/aux.h"
-#include "cs.h"
-#include "cs_aux.h"
-
-#define STACK_DEPTH 50
-
-STATIC struct token Stack[STACK_DEPTH];
-STATIC token_p free_token;
-
-#define Delete_top() {--free_token; }
-#define Empty_stack() {free_token = &Stack[0]; }
-#define Stack_empty() (free_token == &Stack[0])
-#define Top (free_token - 1)
-
-Push(tkp)
- token_p tkp;
-{
- if (tkp->tk_size == UNKNOWN_SIZE) {
- Empty_stack(); /* The contents of the Stack is useless. */
- } else {
- assert(free_token < &Stack[STACK_DEPTH]);
-
- free_token->tk_vn = tkp->tk_vn;
- free_token->tk_size = tkp->tk_size;
- free_token++->tk_lfirst = tkp->tk_lfirst;
- }
-}
-
-#define WORD_MULTIPLE(n) ((n / ws) * ws + ( n % ws ? ws : 0 ))
-
-Pop(tkp, size)
- token_p tkp;
- offset size;
-{
- /* Pop a token with given size from the valuenumber stack into tkp. */
-
- /* First simple case. */
- if (size != UNKNOWN_SIZE && !Stack_empty() && size == Top->tk_size) {
- tkp->tk_vn = Top->tk_vn;
- tkp->tk_size = size;
- tkp->tk_lfirst = Top->tk_lfirst;
- Delete_top();
- return;
- }
- /* Now we're in trouble: we must pop something that is not there!
- * We just put a dummy into tkp and pop tokens until we've
- * popped size bytes.
- */
- /* Create dummy. */
- tkp->tk_vn = newvalnum();
- tkp->tk_lfirst = (line_p) 0;
-
- /* Now fiddle with the Stack. */
- if (Stack_empty()) return;
- if (size == UNKNOWN_SIZE) {
- Empty_stack();
- return;
- }
- if (size > Top->tk_size) {
- while (!Stack_empty() && size >= Top->tk_size) {
- size -= Top->tk_size;
- Delete_top();
- }
- }
- /* Now Stack_empty OR size < Top->tk_size. */
- if (!Stack_empty()) {
- if (Top->tk_size - size < ws) {
- Delete_top();
- } else {
- Top->tk_vn = newvalnum();
- Top->tk_size -= WORD_MULTIPLE(size);
- }
- }
-}
-
-Dup(lnp)
- line_p lnp;
-{
- /* Duplicate top bytes on the Stack. */
-
- register token_p bottom = Top;
- register token_p oldtop = Top;
- register offset nbytes = off_set(lnp);
- struct token dummy;
-
- /* Find the bottom of the bytes to be duplicated.
- * It is possible that we cannot find it.
- */
- while (bottom > &Stack[0] && bottom->tk_size < nbytes) {
- nbytes -= bottom->tk_size;
- bottom--;
- }
-
- if (bottom < &Stack[0]) {
- /* There was nothing. */
- dummy.tk_vn = newvalnum();
- dummy.tk_size = nbytes;
- dummy.tk_lfirst = lnp;
- Push(&dummy);
- } else {
- if (bottom->tk_size < nbytes) {
- /* Not enough, bottom == &Stack[0]. */
- dummy.tk_vn = newvalnum();
- dummy.tk_size = nbytes - bottom->tk_size;
- dummy.tk_lfirst = lnp;
- Push(&dummy);
- } else if (bottom->tk_size > nbytes) {
- /* Not integral # tokens. */
- dummy.tk_vn = newvalnum();
- dummy.tk_size = nbytes;
- dummy.tk_lfirst = lnp;
- Push(&dummy);
- bottom++;
- }
- /* Bottom points to lowest token to be dupped. */
- while (bottom <= oldtop) {
- Push(bottom++);
- Top->tk_lfirst = lnp;
- }
- }
-}
-
-clr_stack()
-{
- free_token = &Stack[0];
-}
+++ /dev/null
-extern Push(); /* (token_p tkp)
- * Push the token in tkp on the fake-stack.
- */
-
-extern Pop(); /* (token_p tkp; offset size)
- * Pop a token of size bytes from the fake-stack
- * into tkp. If such a token is not there
- * we put a dummy in tkp and adjust the fake-stack.
- */
-
-extern Dup(); /* (line_p lnp)
- * Reflect the changes made by the dup-instruction
- * in lnp to the EM-stack into the fake-stack.
- */
-
-extern clr_stack(); /* ()
- * Clear the fake-stack.
- */
+++ /dev/null
-
-/* V A L U E N U M B E R I N G M E T H O D */
-
-#include "../../../h/em_mnem.h"
-#include "../share/types.h"
-#include "../share/global.h"
-#include "../share/debug.h"
-#include "../share/aux.h"
-#include "cs.h"
-#include "cs_alloc.h"
-#include "cs_aux.h"
-#include "cs_entity.h"
-#include "cs_avail.h"
-#include "cs_stack.h"
-#include "cs_kill.h"
-#include "cs_partit.h"
-#include "cs_getent.h"
-
-STATIC push_entity(enp, lfirst)
- entity_p enp;
- line_p lfirst;
-{
- /* Build token and Push it. */
-
- struct token tk;
-
- tk.tk_vn = enp->en_vn;
- tk.tk_size = enp->en_size;
- tk.tk_lfirst = lfirst;
- Push(&tk);
-}
-
-STATIC put_expensive_load(bp, lnp, lfirst, enp)
- bblock_p bp;
- line_p lnp, lfirst;
- entity_p enp;
-{
- struct avail av;
- occur_p ocp;
-
- av.av_instr = INSTR(lnp);
- av.av_size = enp->en_size;
- av.av_operand = enp->en_vn;
-
- ocp = newoccur(lfirst, lnp, bp);
-
- av_enter(&av, ocp, EXPENSIVE_LOAD);
-}
-
-STATIC put_aar(bp, lnp, lfirst, enp)
- bblock_p bp;
- line_p lnp, lfirst;
- entity_p enp;
-{
- /* Enp points to an ENARRELEM. We do as if its address was computed. */
-
- struct avail av;
- occur_p ocp;
-
- assert(enp->en_kind == ENARRELEM);
- av.av_instr = op_aar;
- av.av_size = ps;
- av.av_ofirst = enp->en_arbase;
- av.av_osecond = enp->en_index;
- av.av_othird = enp->en_adesc;
-
- ocp = newoccur(lfirst, lnp, bp);
-
- av_enter(&av, ocp, TERNAIR_OP);
-}
-
-STATIC push_avail(avp, lfirst)
- avail_p avp;
- line_p lfirst;
-{
- struct token tk;
-
- tk.tk_vn = avp->av_result;
- tk.tk_size = avp->av_size;
- tk.tk_lfirst = lfirst;
- Push(&tk);
-}
-
-STATIC push_unair_op(bp, lnp, tkp1)
- bblock_p bp;
- line_p lnp;
- token_p tkp1;
-{
- struct avail av;
- occur_p ocp;
-
- av.av_instr = INSTR(lnp);
- av.av_size = avsize(lnp);
- av.av_operand = tkp1->tk_vn;
-
- ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
-
- push_avail(av_enter(&av, ocp, UNAIR_OP), tkp1->tk_lfirst);
-}
-
-STATIC push_binair_op(bp, lnp, tkp1, tkp2)
- bblock_p bp;
- line_p lnp;
- token_p tkp1, tkp2;
-{
- struct avail av;
- occur_p ocp;
-
- av.av_instr = INSTR(lnp);
- av.av_size = avsize(lnp);
- av.av_oleft = tkp1->tk_vn;
- av.av_oright = tkp2->tk_vn;
-
- ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
-
- push_avail(av_enter(&av, ocp, BINAIR_OP), tkp1->tk_lfirst);
-}
-
-STATIC push_ternair_op(bp, lnp, tkp1, tkp2, tkp3)
- bblock_p bp;
- line_p lnp;
- token_p tkp1, tkp2, tkp3;
-{
- struct avail av;
- occur_p ocp;
-
- av.av_instr = INSTR(lnp);
- av.av_size = avsize(lnp);
- av.av_ofirst = tkp1->tk_vn;
- av.av_osecond = tkp2->tk_vn;
- av.av_othird = tkp3->tk_vn;
-
- ocp = newoccur(tkp1->tk_lfirst, lnp, bp);
-
- push_avail(av_enter(&av, ocp, TERNAIR_OP), tkp1->tk_lfirst);
-}
-
-STATIC fiddle_stack(lnp)
- line_p lnp;
-{
- /* The instruction in lnp does something to the valuenumber-stack. */
-
- struct token dummy;
- offset size;
-
- /* Partly initialize dummy. */
- dummy.tk_lfirst = lnp;
-
- switch (INSTR(lnp)) {
- default:
- assert(FALSE);
- break;
- case op_lor:
- dummy.tk_vn = newvalnum(); dummy.tk_size = ps;
- Push(&dummy);
- break;
- case op_asp:
- if ((size = off_set(lnp)) > 0) {
- Pop(&dummy, size);
- } else {
- dummy.tk_vn = newvalnum();
- dummy.tk_size = size;
- Push(&dummy);
- }
- break;
- case op_dup:
- Dup(lnp);
- break;
- case op_ass:
- case op_dus:
- case op_exg:
- case op_los:
- /* Don't waste effort. */
- clr_stack();
- break;
- case op_sig:
- Pop(&dummy, (offset) ps);
- break;
- case op_lfr:
- dummy.tk_vn = newvalnum();
- dummy.tk_size = off_set(lnp);
- Push(&dummy);
- break;
- }
-}
-
-STATIC proc_p find_proc(vn)
- valnum vn;
-{
- /* Find the procedure-identifier with valuenumber vn. */
-
- entity_p enp;
-
- enp = find_entity(vn);
-
- if (enp != (entity_p) 0 && enp->en_kind == ENPROC)
- return enp->en_pro;
-
- return (proc_p) 0;
-}
-
-STATIC side_effects(lnp)
- line_p lnp;
-{
- /* Lnp contains a cai or cal instruction. We try to find the callee
- * and see what side-effects it has.
- */
- struct token tk;
- proc_p pp;
-
- if (INSTR(lnp) == op_cai) {
- Pop(&tk, (offset) ps);
- pp = find_proc(tk.tk_vn);
- } else {
- assert(INSTR(lnp) == op_cal);
- pp = PROC(lnp);
- }
- if (pp != (proc_p) 0) {
- kill_call(pp);
- } else {
- kill_much();
- }
-}
-
-hopeless(instr)
- int instr;
-{
- /* The effect of `instr' is too difficult to
- * compute. We assume worst case behaviour.
- */
- switch (instr) {
- default:
- assert(FALSE);
- break;
- case op_mon:
- case op_str:
- /* We can't even trust "static" entities. */
- kill_all();
- clr_stack();
- break;
- case op_blm:
- case op_bls:
- case op_sts:
- kill_much();
- clr_stack();
- break;
- }
-}
-
-vnm(bp)
- bblock_p bp;
-{
- register line_p lnp;
- register entity_p rep;
- line_p lfirst;
- struct token tk, tk1, tk2, tk3;
-
- for (lnp = bp->b_start; lnp != (line_p) 0; lnp = lnp->l_next) {
-
- rep = getentity(lnp, &lfirst);
- switch (instrgroup(lnp)) {
- case SIMPLE_LOAD:
- push_entity(rep, lfirst);
- break;
- case LOAD_ARRAY:
- put_aar(bp, lnp, lfirst, rep);
- /* Fall through ... */
- case EXPENSIVE_LOAD:
- push_entity(rep, lfirst);
- put_expensive_load(bp, lnp, lfirst, rep);
- break;
- case STORE_DIRECT:
- kill_direct(rep);
- Pop(&tk, rep->en_size);
- rep->en_vn = tk.tk_vn;
- break;
- case STORE_ARRAY:
- put_aar(bp, lnp, lfirst, rep);
- /* Fall through ... */
- case STORE_INDIR:
- kill_indir(rep);
- Pop(&tk, rep->en_size);
- rep->en_vn = tk.tk_vn;
- break;
- case UNAIR_OP:
- Pop(&tk1, op11size(lnp));
- push_unair_op(bp, lnp, &tk1);
- break;
- case BINAIR_OP:
- Pop(&tk2, op22size(lnp));
- Pop(&tk1, op12size(lnp));
- push_binair_op(bp, lnp, &tk1, &tk2);
- break;
- case TERNAIR_OP:
- Pop(&tk3, op33size(lnp));
- Pop(&tk2, op23size(lnp));
- Pop(&tk1, op13size(lnp));
- push_ternair_op(bp, lnp, &tk1, &tk2, &tk3);
- break;
- case KILL_ENTITY:
- kill_direct(rep);
- break;
- case SIDE_EFFECTS:
- side_effects(lnp);
- break;
- case FIDDLE_STACK:
- fiddle_stack(lnp);
- break;
- case IGNORE:
- break;
- case HOPELESS:
- hopeless(INSTR(lnp));
- break;
- case BBLOCK_END:
- break;
- default:
- assert(FALSE);
- break;
- }
- }
-}
+++ /dev/null
-extern vnm(); /* (bblock_p bp)
- * Performs the valuenumbering algorithm on the basic
- * block in bp.
- */
+++ /dev/null
-s/.*://
-s/(//
-s/)//
-s/,/ /
-s/cases//
-s/case//
-s/sizes//
-s/size//
-s/\-\>//
-s/pointer/2/g
-s/general/0/g
-s/fitbyte/1/
-s/default/0/
-s/in_0_63/2/
-s/in_0_8/3/
-s/no/0/g
-s/yes/1/g
-s/ //g
-s/ +/ /g
-s/^ //
-s/ $//
-/^$/d
+++ /dev/null
-
-wordsize: 2
-pointersize: 2
-%%UD
-access costs of global variables:
- (1 size)
- default -> (4,2)
-access costs of local variables:
- (1 size)
- default -> (4,2)
-%%SR
-overflow harmful?: no
-array bound harmful?: no
-%%SP
-global stack pollution allowed?: yes
+++ /dev/null
-wordsize: 2
-pointersize: 4
-%%RA
-general registers: 5
-address registers: 4
-floating point registers: 0
-
-register score parameters:
- local variable:
- (2 cases)
- pointer,pointer
- (1 size)
- default -> (6,3)
- general,general
- (1 size)
- default -> (4,2)
- address of local variable:
- (2 cases)
- pointer,pointer
- (1 size)
- default -> (0,0)
- general,pointer
- (1 size)
- default -> (2,2)
- constant:
- (2 sizes)
- in_0_8 -> (0,0)
- default -> (2,2)
- double constant:
- (1 size)
- default -> (-1,-1)
- address of global variable:
- (1 size)
- default -> (4,4)
- address of procedure:
- (1 size)
- default -> (2,4)
-
-opening cost parameters:
- local variable:
- (2 cases)
- pointer
- (1 size)
- default -> (6,4)
- general
- (1 size)
- default -> (8,4)
- address of local variable:
- (2 cases)
- pointer
- (1 size)
- default -> (4,2)
- general
- (1 size)
- general -> (4,2)
- constant:
- (1 size)
- default -> (4,4)
- double constant:
- (1 size)
- default -> (1000,1000)
- address of global variable:
- (1 size)
- default -> (6,6)
- address of procedure:
- (1 size)
- default -> (6,6)
-
-register save costs:
- (11 cases)
- 0 -> (0,0)
- 1 -> (12,4)
- 2 -> (24,8)
- 3 -> (34,8)
- 4 -> (42,8)
- 5 -> (50,8)
- 6 -> (58,8)
- 7 -> (66,8)
- 8 -> (84,8)
- 9 -> (92,8)
- 0 -> (0,0)
-%%UD
-access costs of global variables:
- (1 size)
- default -> (7,4)
-access costs of local variables:
- (1 size)
- default -> (4,2)
-%%SR
-overflow harmful?: no
-array bound harmful?: no
-%%CS
-#include "../../../h/em_mnem.h"
-first time then space:
-addressing modes: op_adp op_lof op_ldf op_loi op_dch op_lpb -1
- op_adp op_lof op_ldf op_loi op_dch op_lpb -1
-cheap operations: -1 -1
-lexical tresholds: 1 1
-indirection limit: 8
-do sli if index?: yes yes
-forbidden operators: -1 -1
-%%SP
-global stack pollution allowed?: no
+++ /dev/null
-wordsize: 2
-pointersize: 2
-%%RA
-general registers: 2
-address registers: 0
-floating point registers: 0
-
-register score parameters:
- local variable:
- (2 cases)
- pointer,general
- (1 size)
- default -> (6,3)
- general,general
- (1 size)
- default -> (4,2)
- address of local variable:
- (2 cases)
- pointer,general
- (1 size)
- default -> (0,0)
- general,general
- (1 size)
- default -> (2,2)
- constant:
- (1 sizes)
- default -> (2,2)
- double constant:
- (1 size)
- default -> (-1,-1)
- address of global variable:
- (1 size)
- default -> (4,2)
- address of procedure:
- (1 size)
- default -> (2,2)
-
-opening cost parameters:
- local variable:
- (2 cases)
- pointer
- (1 size)
- default -> (6,4)
- general
- (1 size)
- default -> (6,4)
- address of local variable:
- (2 cases)
- pointer
- (1 size)
- default -> (10,6)
- general
- (1 size)
- general -> (10,6)
- constant:
- (1 size)
- default -> (4,4)
- double constant:
- (1 size)
- default -> (1000,1000)
- address of global variable:
- (1 size)
- default -> (6,4)
- address of procedure:
- (1 size)
- default -> (6,4)
-
-register save costs:
- (4 cases)
- 0 -> (0,0)
- 1 -> (12,0)
- 2 -> (24,0)
- 0 -> (0,0)
-%%UD
-access costs of global variables:
- (1 size)
- default -> (4,2)
-access costs of local variables:
- (1 size)
- default -> (4,2)
-%%SR
-overflow harmful?: no
-array bound harmful?: no
-%%CS
-#include "../../../h/em_mnem.h"
-first time then space:
-addressing modes: op_adp op_lof op_ldf op_loi op_dch op_lpb -1
- op_adp op_lof op_ldf op_loi op_dch op_lpb -1
-cheap operations: op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
- op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
-lexical tresholds: 1 1
-indirection limit: 8
-do sli if index?: yes yes
-forbidden operators: -1 -1
-%%SP
-global stack pollution allowed?: no
+++ /dev/null
-wordsize: 2
-pointersize: 4
-%%RA
-general registers: 3
-address registers: 5
-floating point registers: 0
-
-register score parameters:
- local variable:
- (2 cases)
- pointer,pointer
- (2 sizes)
- fitbyte -> (5,2)
- default -> (4,3)
- general,general
- (2 sizes)
- fitbyte -> (3,1)
- default -> (2,2)
- address of local variable:
- (2 cases)
- pointer,pointer
- (2 sizes)
- fitbyte -> (0,1)
- default -> (0,2)
- general,pointer
- (2 sizes)
- fitbyte -> (0,1)
- default -> (0,2)
- constant:
- (3 sizes)
- in_0_63 -> (0,0)
- fitbyte -> (0,1)
- default -> (1,2)
- double constant:
- (1 size)
- default -> (-1,-1)
- address of global variable:
- (1 size)
- default -> (2,4)
- address of procedure:
- (1 size)
- default -> (2,4)
-
-opening cost parameters:
- local variable:
- (2 cases)
- pointer
- (2 sizes)
- fitbyte -> (10,4)
- default -> (9,5)
- general
- (2 sizes)
- fitbyte -> (8,4)
- default -> (7,5)
- address of local variable:
- (2 cases)
- pointer
- (2 sizes)
- fitbyte -> (0,4)
- default -> (0,5)
- general
- (2 sizes)
- fitbyte -> (0,4)
- general -> (0,5)
- constant:
- (3 sizes)
- in_0_63 -> (4,2)
- fitbyte -> (5,3)
- default -> (6,4)
- double constant:
- (1 size)
- default -> (1000,1000)
- address of global variable:
- (1 size)
- default -> (6,7)
- address of procedure:
- (1 size)
- default -> (6,7)
-
-register save costs:
- (10 cases)
- 0 -> (0,0)
- 1 -> (3,0)
- 2 -> (20,0)
- 3 -> (20,0)
- 4 -> (20,0)
- 5 -> (20,0)
- 6 -> (20,0)
- 7 -> (20,0)
- 8 -> (20,0)
- 0 -> (0,0)
-%%UD
-access costs of global variables:
- (1 size)
- default -> (7,4)
-access costs of local variables:
- (2 sizes)
- fitbyte -> (3,1)
- default -> (2,2)
-%%SR
-overflow harmful?: no
-array bound harmful?: no
-
-%%CS
-#include "../../../h/em_mnem.h"
-first time then space:
-addressing modes: op_adp op_lof op_ldf op_loi op_dch op_lpb -1
- op_adp op_lof op_ldf op_loi op_dch op_lpb -1
-cheap operations: op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
- op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
-lexical tresholds: 1 1
-indirection limit: 8
-do sli if index?: no no
-forbidden operators: -1 -1
-%%SP
-global stack pollution allowed?: yes
+++ /dev/null
-wordsize: 4
-pointersize: 4
-%%RA
-general registers: 8
-address registers: 0
-floating point registers: 0
-
-register score parameters:
- local variable:
- (2 cases)
- pointer,general
- (2 sizes)
- fitbyte -> (5,2)
- default -> (4,3)
- general,general
- (2 sizes)
- fitbyte -> (3,1)
- default -> (2,2)
- address of local variable:
- (2 cases)
- pointer,general
- (2 sizes)
- fitbyte -> (0,1)
- default -> (0,2)
- general,general
- (2 sizes)
- fitbyte -> (0,1)
- default -> (0,2)
- constant:
- (3 sizes)
- in_0_63 -> (0,0)
- fitbyte -> (0,1)
- default -> (1,2)
- double constant:
- (1 size)
- default -> (-1,-1)
- address of global variable:
- (1 size)
- default -> (2,4)
- address of procedure:
- (1 size)
- default -> (2,4)
-
-opening cost parameters:
- local variable:
- (2 cases)
- pointer
- (2 sizes)
- fitbyte -> (10,4)
- default -> (9,5)
- general
- (2 sizes)
- fitbyte -> (8,4)
- default -> (7,5)
- address of local variable:
- (2 cases)
- pointer
- (2 sizes)
- fitbyte -> (0,4)
- default -> (0,5)
- general
- (2 sizes)
- fitbyte -> (0,4)
- general -> (0,5)
- constant:
- (3 sizes)
- in_0_63 -> (4,2)
- fitbyte -> (5,3)
- default -> (6,4)
- double constant:
- (1 size)
- default -> (1000,1000)
- address of global variable:
- (1 size)
- default -> (6,7)
- address of procedure:
- (1 size)
- default -> (6,7)
-
-register save costs:
- (8 cases)
- 0 -> (0,0)
- 1 -> (3,1)
- 2 -> (7,3)
- 3 -> (20,4)
- 4 -> (20,4)
- 5 -> (20,4)
- 6 -> (20,4)
- 0 -> (0,0)
-%%UD
-access costs of global variables:
- (1 size)
- default -> (7,4)
-access costs of local variables:
- (2 sizes)
- fitbyte -> (3,1)
- default -> (2,2)
-%%SR
-overflow harmful?: no
-array bound harmful?: no
-
-%%CS
-#include "../../../h/em_mnem.h"
-first time then space:
-addressing modes: op_adp op_lof op_ldf op_loi op_dch op_lpb -1
- op_adp op_lof op_ldf op_loi op_dch op_lpb -1
-cheap operations: op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
- op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif -1
-lexical tresholds: 1 1
-indirection limit: 8
-do sli if index?: no no
-forbidden operators: -1 -1
-%%SP
-global stack pollution allowed?: no
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=
-DEBUG=../share
-SHARE=../share
-MALLOC=
-IC=.
-OBJECTS=ic.o ic_aux.o ic_lookup.o ic_io.o ic_lib.o
-SHOBJECTS=$(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o
-SRC=ic.h ic_aux.h ic_lib.h ic_lookup.h ic_io.h ic.c ic_aux.c ic_lib.c ic_lookup.c ic_io.c
-all: $(OBJECTS)
-ic: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -i -o ic $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a $(MALLOC)
-
-lpr:
- pr $(SRC) | lpr
-
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-ic.o: ../../../h/em_flag.h
-ic.o: ../../../h/em_mes.h
-ic.o: ../../../h/em_pseu.h
-ic.o: ../../../h/em_spec.h
-ic.o: ../share/alloc.h
-ic.o: ../share/aux.h
-ic.o: ../share/debug.h
-ic.o: ../share/def.h
-ic.o: ../share/files.h
-ic.o: ../share/global.h
-ic.o: ../share/map.h
-ic.o: ../share/put.h
-ic.o: ../share/types.h
-ic.o: ic.h
-ic.o: ic_aux.h
-ic.o: ic_io.h
-ic.o: ic_lib.h
-ic.o: ic_lookup.h
-ic_aux.o: ../../../h/em_mnem.h
-ic_aux.o: ../../../h/em_pseu.h
-ic_aux.o: ../../../h/em_spec.h
-ic_aux.o: ../share/alloc.h
-ic_aux.o: ../share/aux.h
-ic_aux.o: ../share/debug.h
-ic_aux.o: ../share/def.h
-ic_aux.o: ../share/global.h
-ic_aux.o: ../share/types.h
-ic_aux.o: ic.h
-ic_aux.o: ic_aux.h
-ic_aux.o: ic_io.h
-ic_aux.o: ic_lookup.h
-ic_io.o: ../../../h/em_pseu.h
-ic_io.o: ../../../h/em_spec.h
-ic_io.o: ../share/alloc.h
-ic_io.o: ../share/debug.h
-ic_io.o: ../share/types.h
-ic_io.o: ic.h
-ic_io.o: ic_io.h
-ic_io.o: ic_lookup.h
-ic_lib.o: ../../../h/em_mes.h
-ic_lib.o: ../../../h/em_pseu.h
-ic_lib.o: ../../../h/em_spec.h
-ic_lib.o: ../share/debug.h
-ic_lib.o: ../share/files.h
-ic_lib.o: ../share/global.h
-ic_lib.o: ../share/types.h
-ic_lib.o: ic.h
-ic_lib.o: ic_io.h
-ic_lib.o: ic_lib.h
-ic_lib.o: ic_lookup.h
-ic_lookup.o: ../../../h/em_spec.h
-ic_lookup.o: ../share/alloc.h
-ic_lookup.o: ../share/debug.h
-ic_lookup.o: ../share/map.h
-ic_lookup.o: ../share/types.h
-ic_lookup.o: ic.h
-ic_lookup.o: ic_lookup.h
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * I C . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/map.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_flag.h"
-#include "../../../h/em_mes.h"
-#include "ic.h"
-#include "ic_lookup.h"
-#include "ic_aux.h"
-#include "ic_io.h"
-#include "ic_lib.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/put.h"
-#include "../share/aux.h"
-
-
-/* Global variables */
-
-
-dblock_p db;
-dblock_p curhol = (dblock_p) 0; /* hol block in current scope */
-dblock_p ldblock; /* last dblock */
-proc_p lproc; /* last proc */
-short tabval; /* used by table1, table2 and table3 */
-offset tabval2;
-char string[IDL+1];
-line_p firstline; /* first line of current procedure */
-line_p lastline; /* last line read */
-int labelcount; /* # labels in current procedure */
-short fragm_type = DUNKNOWN; /* fragm. type: DCON, DROM or DUNKNOWN */
-short fragm_nr = 0; /* fragment number */
-obj_id lastoid = 0;
-proc_id lastpid = 0;
-dblock_id lastdid = 0;
-lab_id lastlid = 0;
-
-offset mespar = UNKNOWN_SIZE;
- /* argumument of ps_par message of current procedure */
-
-
-extern process_lines();
-extern int readline();
-extern line_p readoperand();
-extern line_p inpseudo();
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- /* The input files must be legal EM Compact
- * Assembly Language files, as produced by the EM Peephole
- * Optimizer.
- * Their file names are passed as arguments.
- * The output consists of the files:
- * - lfile: the EM code in Intermediate Code format
- * - dfile: the data block table file
- * - pfile: the proc table file
- * - pdump: the names of all procedures
- * - ddump: the names of all data blocks
- */
-
- FILE *lfile, *dfile, *pfile, *pdump, *ddump;
-
- lfile = openfile(lname2,"w");
- pdump = openfile(argv[1],"w");
- ddump = openfile(argv[2],"w");
- while (next_file(argc,argv) != NULL) {
- /* Read all EM input files, process the code
- * and concatenate all output.
- */
- process_lines(lfile);
- dump_procnames(prochash,NPROCHASH,pdump);
- dump_dblocknames(symhash,NSYMHASH,ddump);
- /* Save the names of all procedures that were
- * first come accross in this file.
- */
- cleanprocs(prochash,NPROCHASH,PF_EXTERNAL);
- cleandblocks(symhash,NSYMHASH,DF_EXTERNAL);
- /* Make all procedure names that were internal
- * in this input file invisible.
- */
- }
- fclose(lfile);
- fclose(pdump);
- fclose(ddump);
-
-
- /* remove the remainder of the hashing tables */
- cleanprocs(prochash,NPROCHASH,0);
- cleandblocks(symhash,NSYMHASH,0);
- /* Now write the datablock table and the proctable */
- dfile = openfile(dname2,"w");
- putdtable(fdblock, dfile);
- pfile = openfile(pname2,"w");
- putptable(fproc, pfile,FALSE);
-}
-
-
-
-/* Value returned by readline */
-
-#define NORMAL 0
-#define WITH_OPERAND 1
-#define EOFILE 2
-#define PRO_INSTR 3
-#define END_INSTR 4
-#define DELETED_INSTR 5
-
-
-STATIC add_end()
-{
- /* Add an end-pseudo to the current instruction list */
-
- lastline->l_next = newline(OPNO);
- lastline = lastline->l_next;
- lastline->l_instr = ps_end;
-}
-
-
-process_lines(fout)
- FILE *fout;
-{
- line_p lnp;
- short instr;
- bool eof;
-
- /* Read and process the code contained in the current file,
- * on a per procedure basis.
- * On the fly, fragments are formed. Recall that two
- * successive CON pseudos are allocated consecutively
- * in a single fragment, unless these CON pseudos are
- * separated in the assembly language program by one
- * of: ROM, BSS, HOL and END (and of course EndOfFile).
- * The same is true for ROM pseudos.
- * We keep track of a fragment type (DROM after a ROM
- * pseudo, DCON after a CON and DUNKNOWN after a HOL,
- * BSS, END or EndOfFile) and a fragment number (which
- * is incremented every time we enter a new fragment).
- * Every data block is assigned such a number
- * when we come accross its defining occurrence.
- */
-
- eof = FALSE;
- firstline = (line_p) 0;
- lastline = (line_p) 0;
- while (!eof) {
- linecount++; /* for error messages */
- switch(readline(&instr, &lnp)) {
- /* read one line, see what kind it is */
- case WITH_OPERAND:
- /* instruction with operand, e.g. LOL 10 */
- lnp = readoperand(instr);
- lnp->l_instr = instr;
- /* Fall through! */
- case NORMAL:
- VL(lnp);
- if (lastline != (line_p) 0) {
- lastline->l_next = lnp;
- }
- lastline = lnp;
- break;
- case EOFILE:
- eof = TRUE;
- fragm_type = DUNKNOWN;
- if (firstline != (line_p) 0) {
- add_end();
- putlines(firstline,fout);
- firstline = (line_p) 0;
- }
- break;
- case PRO_INSTR:
- VL(lnp);
- labelcount = 0;
- if (firstline != lnp) {
- /* If PRO is not the first
- * instruction:
- */
- add_end();
- putlines(firstline,fout);
- firstline = lnp;
- }
- lastline = lnp;
- break;
- case END_INSTR:
- curproc->p_nrformals = mespar;
- mespar = UNKNOWN_SIZE;
- assert(lastline != (line_p) 0);
- lastline->l_next = lnp;
- putlines(firstline,fout);
- /* write and delete code */
- firstline = (line_p) 0;
- lastline = (line_p) 0;
- cleaninstrlabs();
- /* scope of instruction labels ends here,
- * so forget about them.
- */
- fragm_type = DUNKNOWN;
- break;
- case DELETED_INSTR:
- /* EXP, INA etc. are deleted */
- break;
- default:
- error("illegal readline");
- }
- }
-}
-
-
-
-int readline(instr_out, lnp_out)
- short *instr_out;
- line_p *lnp_out;
-{
- register line_p lnp;
- short n;
-
- /* Read one line. If it is a normal EM instruction without
- * operand, we can allocate a line struct for it here.
- * If so, return a pointer to it via lnp_out, else just
- * return the instruction code via instr_out.
- */
-
- VA((short *) instr_out);
- VA((short *) lnp_out);
- switch(table1()) {
- /* table1 sets string, tabval or tabval2 and
- * returns an indication of what was read.
- */
- case ATEOF:
- return EOFILE;
- case INST:
- *instr_out = tabval; /* instruction code */
- return WITH_OPERAND;
- case DLBX:
- /* data label defining occurrence, precedes
- * a data block.
- */
- db = block_of_lab(string);
- /* global variable, used by inpseudo */
- lnp = newline(OPSHORT);
- SHORT(lnp) = (short) db->d_id;
- lnp->l_instr = ps_sym;
- *lnp_out = lnp;
- if (firstline == (line_p) 0) {
- firstline = lnp;
- /* only a pseudo (e.g. PRO) or data label
- * can be the first instruction.
- */
- }
- return NORMAL;
- case ILBX:
- /* instruction label defining occurrence */
- labelcount++;
- lnp = newline(OPINSTRLAB);
- lnp->l_instr = op_lab;
- INSTRLAB(lnp) = instr_lab(tabval);
- *lnp_out = lnp;
- return NORMAL;
- case PSEU:
- n = tabval;
- lnp = inpseudo(n); /* read a pseudo */
- if (lnp == (line_p) 0) return DELETED_INSTR;
- *lnp_out = lnp;
- lnp->l_instr = n;
- if (firstline == (line_p) 0) {
- firstline = lnp;
- /* only a pseudo (e.g. PRO) or data label
- * can be the first instruction.
- */
- }
- if (n == ps_end) return END_INSTR;
- if (n == ps_pro) return PRO_INSTR;
- return NORMAL;
- }
- /* NOTREACHED */
-}
-
-
-line_p readoperand(instr)
- short instr;
-{
- /* Read the operand of the given instruction.
- * Create a line struct and return a pointer to it.
- */
-
-
- register line_p lnp;
- short flag;
-
- VI(instr);
- flag = em_flag[ instr - sp_fmnem] & EM_PAR;
- if (flag == PAR_NO) {
- return (newline(OPNO));
- }
- switch(table2()) {
- case sp_cend:
- return(newline(OPNO));
- case CSTX1:
- /* constant */
- /* If the instruction has the address
- * of an external variable as argument,
- * the constant must be regarded as an
- * offset in the current hol block,
- * so an object must be created.
- * Similarly, the instruction may have
- * an instruction label as argument.
- */
- switch(flag) {
- case PAR_G:
- lnp = newline(OPOBJECT);
- OBJ(lnp) =
- object((char *) 0,(offset) tabval,
- opr_size(instr));
- break;
- case PAR_B:
- lnp = newline(OPINSTRLAB);
- INSTRLAB(lnp) = instr_lab(tabval);
- break;
- default:
- lnp = newline(OPSHORT);
- SHORT(lnp) = tabval;
- break;
- }
- break;
-#ifdef LONGOFF
- case CSTX2:
- /* double constant */
- lnp = newline(OPOFFSET);
- OFFSET(lnp) = tabval2;
- break;
-#endif
- case ILBX:
- /* applied occurrence instruction label */
- lnp = newline(OPINSTRLAB);
- INSTRLAB(lnp) = instr_lab(tabval);
- break;
- case DLBX:
- /* applied occurrence data label */
- lnp = newline(OPOBJECT);
- OBJ(lnp) = object(string, (offset) 0,
- opr_size(instr) );
- break;
- case VALX1:
- lnp = newline(OPOBJECT);
- OBJ(lnp) = object(string, (offset) tabval,
- opr_size(instr) );
- break;
-#ifdef LONGOFF
- case VALX2:
- lnp = newline(OPOBJECT);
- OBJ(lnp) = object(string,tabval2,
- opr_size(instr) );
- break;
-#endif
- case sp_pnam:
- lnp = newline(OPPROC);
- PROC(lnp) = proclookup(string,OCCURRING);
- VP(PROC(lnp));
- break;
- default:
- assert(FALSE);
- }
- return lnp;
-}
-
-
-
-line_p inpseudo(n)
- short n;
-{
- int m;
- line_p lnp;
- byte pseu;
- short nlast;
-
- /* Read the (remainder of) a pseudo instruction, the instruction
- * code of which is n. The END pseudo may be deleted (return 0).
- * The pseudos INA, EXA, INP and EXP (visibility pseudos) must
- * also be deleted, although the effects they have on the
- * visibility of global names and procedure names must first
- * be recorded in the datablock or procedure table.
- */
-
-
- switch(n) {
- case ps_hol:
- case ps_bss:
- case ps_rom:
- case ps_con:
- if (lastline == (line_p) 0 || !is_datalabel(lastline)) {
- if (n == ps_hol) {
- /* A HOL need not be preceded
- * by a label.
- */
- curhol = db = block_of_lab((char *) 0);
- } else {
- assert(lastline != (line_p) 0);
- nlast = INSTR(lastline);
- if (n == nlast &&
- (n == ps_rom || n == ps_con)) {
- /* Two successive roms/cons are
- * combined into one data block
- * if the second is not preceded by
- * a data label.
- */
- lnp = arglist(0);
- pseu = (byte) (n == ps_rom?DROM:DCON);
- combine(db,lastline,lnp,pseu);
- oldline(lnp);
- return (line_p) 0;
- } else {
- error("datablock without label");
- }
- }
- }
- VD(db);
- m = (n == ps_hol || n == ps_bss ? 3 : 0);
- lnp = arglist(m);
- /* Read the arguments, 3 for hol or bss and a list
- * of undetermined length for rom and con.
- */
- dblockdef(db,n,lnp);
- /* Fill in d_pseudo, d_size and d_values fields of db */
- if (fragm_type != db->d_pseudo & BMASK) {
- /* Keep track of fragment numbers,
- * enter a new fragment.
- */
- fragm_nr++;
- switch(db->d_pseudo) {
- case DCON:
- case DROM:
- fragm_type = db->d_pseudo;
- break;
- default:
- fragm_type = DUNKNOWN;
- break;
- }
- }
- db->d_fragmnr = fragm_nr;
- return lnp;
- case ps_ina:
- getsym(DEFINING);
- /* Read and lookup a symbol. As this must be
- * the first occurrence of the symbol and we
- * say it's a defining occurrence, getsym will
- * automatically make it internal (according to
- * the EM visibility rules).
- * The result (a dblock pointer) is voided.
- */
- return (line_p) 0;
- case ps_inp:
- getproc(DEFINING); /* same idea */
- return (line_p) 0;
- case ps_exa:
- getsym(OCCURRING);
- return (line_p) 0;
- case ps_exp:
- getproc(OCCURRING);
- return (line_p) 0;
- case ps_pro:
- curproc = getproc(DEFINING);
- /* This is a real defining occurrence of a proc */
- curproc->p_localbytes = get_off();
- curproc->p_flags1 |= PF_BODYSEEN;
- /* Record the fact that we came accross
- * the body of this procedure.
- */
- lnp = newline(OPPROC);
- PROC(lnp) = curproc;
- lnp->l_instr = (byte) ps_pro;
- return lnp;
- case ps_end:
- curproc->p_nrlabels = labelcount;
- lnp = newline(OPNO);
- get_off();
- /* Void # localbytes, which we already know
- * from the PRO instruction.
- */
- return lnp;
- case ps_mes:
- lnp = arglist(0);
- switch((int) aoff(ARG(lnp),0)) {
- case ms_err:
- error("ms_err encountered");
- case ms_opt:
- error("ms_opt encountered");
- case ms_emx:
- ws = aoff(ARG(lnp),1);
- ps = aoff(ARG(lnp),2);
- break;
- case ms_ext:
- /* this message was already processed
- * by the lib package
- */
- case ms_src:
- /* Don't bother about linecounts */
- oldline(lnp);
- return (line_p) 0;
- case ms_par:
- mespar = aoff(ARG(lnp),1);
- /* #bytes of parameters of current proc */
- break;
- }
- return lnp;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * G L O B A L C O N S T A N T S & V A R I A B L E S
- */
-
-
-/* Data structures for Intermediate Code generation */
-
-typedef struct sym *sym_p;
-typedef struct prc *prc_p;
-typedef struct num *num_p;
-
-
-struct sym {
- sym_p sy_next; /* link */
- char sy_name[IDL]; /* name of the symbol */
- dblock_p sy_dblock; /* pointer to dblock struct */
-};
-struct prc {
- prc_p pr_next; /* link */
- char pr_name[IDL]; /* name of the procedure */
- proc_p pr_proc; /* pointer tto proc struct */
-};
-
-
-struct num {
- num_p n_next; /* link */
- unsigned n_number; /* EM repr. e.g. 120 in 'BRA *120' */
- lab_id n_labid; /* sequential integer repr. of IC */
-};
-
-
-
-/* macros used by ic_lib.c and ic_io.c: */
-
-#define ARCHIVE 0
-#define NO_ARCHIVE 1
-
-
-/*
- * 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 */
-
-/* Global variables */
-
-extern dblock_p db;
-extern dblock_p curhol; /* hol block in current scope */
-extern dblock_p ldblock; /* last dblock processed so far */
-extern proc_p lproc; /* last proc processed so far */
-extern short tabval; /* used by table1, table2 and table3 */
-extern offset tabval2;
-extern char string[];
-extern line_p lastline; /* last line read */
-extern int labelcount; /* # labels in current procedure */
-extern obj_id lastoid; /* last object identifier used */
-extern proc_id lastpid; /* last proc identifier used */
-extern lab_id lastlid; /* last label identifier used */
-extern dblock_id lastdid; /* last dblock identifier used */
-
-extern byte em_flag[];
-
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * I C _ A U X . C
- */
-
-
-
-#include "../share/types.h"
-#include "../share/global.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/aux.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-#include "ic.h"
-#include "ic_io.h"
-#include "ic_lookup.h"
-#include "../share/alloc.h"
-#include "ic_aux.h"
-
-
-
-/* opr_size */
-
-offset opr_size(instr)
- short instr;
-{
- switch(instr) {
- case op_loe:
- case op_ste:
- case op_ine:
- case op_dee:
- case op_zre:
- return (offset) ws;
- case op_lde:
- case op_sde:
- return (offset) 2*ws;
- case op_lae:
- case op_fil:
- return (offset) UNKNOWN_SIZE;
- default:
- error("illegal operand of opr_size: %d", instr);
- }
- /* NOTREACHED */
-}
-
-
-
-/* dblockdef */
-
-STATIC offset argsize(arg)
- arg_p arg;
-{
- /* Compute the size (in bytes) that the given initializer
- * will occupy.
- */
-
- offset s;
- argb_p argb;
-
- switch(arg->a_type) {
- case ARGOFF:
- /* See if value fits in a short */
- if ((short) arg->a_a.a_offset == arg->a_a.a_offset) {
- return ws;
- } else {
- return 2*ws;
- }
- case ARGINSTRLAB:
- case ARGOBJECT:
- case ARGPROC:
- return ps; /* pointer size */
- case ARGSTRING:
- /* strings are partitioned into pieces */
- s = 0;
- for (argb = &arg->a_a.a_string; argb != (argb_p) 0;
- argb = argb->ab_next) {
- s += argb->ab_index;
- }
- return s;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- return arg->a_a.a_con.ac_length;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-STATIC offset blocksize(pseudo,args)
- byte pseudo;
- arg_p args;
-{
- /* Determine the number of bytes of a datablock */
-
- arg_p arg;
- offset sum;
-
- switch(pseudo) {
- case DHOL:
- case DBSS:
- if (args->a_type != ARGOFF) {
- error("offset expected");
- }
- return args->a_a.a_offset;
- case DCON:
- case DROM:
- sum = 0;
- for (arg = args; arg != (arg_p) 0; arg = arg->a_next) {
- /* Add the sizes of all initializers */
- sum += argsize(arg);
- }
- return sum;
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-STATIC arg_p copy_arg(arg)
- arg_p arg;
-{
- /* Copy one argument */
-
- arg_p new;
-
- assert(arg->a_type == ARGOFF);
- new = newarg(ARGOFF);
- new->a_a.a_offset = arg->a_a.a_offset;
- return new;
-}
-
-
-
-STATIC arg_p copy_rom(args)
- arg_p args;
-{
- /* Make a copy of the values of a rom,
- * provided that the rom contains only integer values,
- */
-
- arg_p arg, arg2, argh;
-
- for (arg = args; arg != (arg_p) 0; arg = arg->a_next) {
- if (arg->a_type != ARGOFF) {
- return (arg_p) 0;
- }
- }
- /* Now make the copy */
- arg2 = argh = copy_arg(args);
- for (arg = args->a_next; arg != (arg_p) 0; arg = arg->a_next) {
- arg2->a_next = copy_arg(arg);
- arg2 = arg2->a_next;
- }
- return argh;
-}
-
-
-
-dblockdef(db,n,lnp)
- dblock_p db;
- int n;
- line_p lnp;
-{
- /* Process a data block defining occurrence */
-
- byte m;
-
- switch(n) {
- case ps_hol:
- m = DHOL;
- break;
- case ps_bss:
- m = DBSS;
- break;
- case ps_con:
- m = DCON;
- break;
- case ps_rom:
- m = DROM;
- break;
- default:
- assert(FALSE);
- }
- db->d_pseudo = m;
- db->d_size = blocksize(m, ARG(lnp));
- if (m == DROM) {
- /* We keep the values of a rom block in the data block
- * table if the values consist of integers only.
- */
- db->d_values = copy_rom(ARG(lnp));
- }
-}
-
-
-
-/* combine */
-
-combine(db,l1,l2,pseu)
- dblock_p db;
- line_p l1,l2;
- byte pseu;
-{
- /* Combine two successive ROMs/CONs (without a data label
- * in between into a single ROM. E.g.:
- * xyz
- * rom 3,6,9,12
- * rom 7,0,2
- * is changed into:
- * xyz
- * rom 3,6,9,12,7,0,2
- */
-
- arg_p v;
-
- db->d_size += blocksize(pseu,ARG(l2));
- /* db is the data block that was already assigned to the
- * first rom/con. The second one is not assigned a new
- * data block of course, as the two are combined into
- * one instruction.
- */
- if (pseu == DROM && db->d_values != (arg_p) 0) {
- /* The values contained in a ROM are only copied
- * to the data block if they may be useful to us
- * (e.g. they certainly may not be strings). In our
- * case it means that both ROMs must have useful
- * arguments.
- */
- for (v = db->d_values; v->a_next != (arg_p) 0; v = v->a_next);
- /* The first rom contained useful arguments. v now points to
- * its last argument. Append the arguments of the second
- * rom to this list. If the second rom has arguments that are
- * not useful, throw away the entire list (we want to copy
- * everything or nothing).
- */
- if ((v->a_next = copy_rom(ARG(l2))) == (arg_p) 0) {
- oldargs(db->d_values);
- db->d_values = (arg_p) 0;
- }
- }
- for (v = ARG(l1); v->a_next != (arg_p) 0; v = v->a_next);
- /* combine the arguments of both instructions. */
- v->a_next = ARG(l2);
- ARG(l2) = (arg_p) 0;
-}
-
-
-
-/* arglist */
-
-STATIC arg_string(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++] = readchar();
- }
-}
-
-
-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 = &ARG(lnp);
- 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:
- *app = ap = newarg(ARGINSTRLAB);
- ap->a_a.a_instrlab = instr_lab((short) tabval);
- app = &ap->a_next;
- break;
- case DLBX:
- *app = ap = newarg(ARGOBJECT);
- ap->a_a.a_obj = object(string,(offset) 0, (offset) 0);
- /* The size of the object is unknown */
- app = &ap->a_next;
- break;
- case sp_pnam:
- *app = ap = newarg(ARGPROC);
- ap->a_a.a_proc = proclookup(string,OCCURRING);
- app = &ap->a_next;
- break;
- case VALX1:
- tabval2 = (offset) tabval;
- case VALX2:
- *app = ap = newarg(ARGOBJECT);
- ap->a_a.a_obj = object(string, tabval2, (offset) 0);
- app = &ap->a_next;
- break;
- case sp_scon:
- *app = ap = newarg(ARGSTRING);
- length = get_off();
- arg_string(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 = get_int();
- ap->a_a.a_con.ac_length = (short) length;
- arg_string(get_off(),&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);
-}
-
-
-
-/* is_datalabel */
-
-bool is_datalabel(l)
- line_p l;
-{
- VL(l);
- return (l->l_instr == (byte) ps_sym);
-}
-
-
-
-/* block_of_lab */
-
-dblock_p block_of_lab(ident)
- char *ident;
-{
- dblock_p dbl;
-
- /* Find the datablock with the given name.
- * Used for defining occurrences.
- */
-
- dbl = symlookup(ident,DEFINING);
- VD(dbl);
- if (dbl->d_pseudo != DUNKNOWN) {
- error("identifier redeclared");
- }
- return dbl;
-}
-
-
-
-/* object */
-
-STATIC obj_p make_object(dbl,off,size)
- dblock_p dbl;
- offset off;
- offset size;
-{
- /* Allocate an obj struct with the given attributes
- * (if it did not exist already).
- * Return a pointer to the found or newly created object struct.
- */
-
- obj_p obj, prev, new;
-
- /* See if the object was already present in the object list
- * of the given datablock. If it is not yet present, find
- * the right place to insert the new object. Note that
- * the objects are sorted by offset.
- */
- prev = (obj_p) 0;
- for (obj = dbl->d_objlist; obj != (obj_p) 0; obj = obj->o_next) {
- if (obj->o_off >= off) {
- break;
- }
- prev = obj;
- }
- /* Note that the data block may contain several objects
- * with the required offset; we also want the size to
- * be the right one.
- */
- while (obj != (obj_p) 0 && obj->o_off == off) {
- if (obj->o_size == UNKNOWN_SIZE) {
- obj->o_size = size;
- return obj;
- } else {
- if (size == UNKNOWN_SIZE || obj->o_size == size) {
- return obj;
- /* This is the right one */
- } else {
- prev = obj;
- obj = obj->o_next;
- }
- }
- }
- /* Allocate a new object */
- new = newobject();
- new->o_id = ++lastoid; /* create a unique object id */
- new->o_off = off;
- new->o_size = size;
- new->o_dblock = dbl;
- /* Insert the new object */
- if (prev == (obj_p) 0) {
- dbl->d_objlist = new;
- } else {
- prev->o_next = new;
- }
- new->o_next = obj;
- return new;
-}
-
-
-
-obj_p object(ident,off,size)
- char *ident;
- offset off;
- offset size;
-{
- dblock_p dbl;
-
- /* Create an object struct (if it did not yet exist)
- * for the object with the given size and offset
- * within the datablock of the given name.
- */
-
- dbl = (ident == (char *) 0 ? curhol : symlookup(ident, OCCURRING));
- VD(dbl);
- return(make_object(dbl,off,size));
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * A U X I L I A R Y R O U T I N E S
- */
-
-
-
-extern offset opr_size(); /* ( short instr )
- * size of operand of given instruction.
- * The operand is an object , so the
- * instruction can be loe, zre etc..
- */
-extern dblockdef(); /* (dblock_p db, int n, line_p lnp)
- * Fill in d_pseudo, d_size and
- * d_values fields of db.
- */
-extern combine(); /* (dblock_p db;line_p l1,l2;byte pseu)
- * Combine two successive ROMs or CONs
- * (with no data label in between)
- * into one ROM or CON.
- */
-extern line_p arglist(); /* ( int m)
- * Read a list of m arguments. If m
- * is 0, then the list is of
- * undetermined length; it is
- * then terminated by a cend symbol.
- */
-extern bool is_datalabel(); /* ( line_p l)
- * TRUE if l is a data label defining
- * occurrence (i.e. its l_instr
- * field is ps_sym).
- */
-extern dblock_p block_of_lab(); /* (char *ident)
- * Find the datablock with
- * the given name.
- */
-extern obj_p object(); /* (char *ident,offset off,short size)
- * Create an object struct.
- */
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * I C _ I O . C
- */
-
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/arch.h"
-#include "ic.h"
-#include "ic_lookup.h"
-#include "../share/alloc.h"
-#include "ic_io.h"
-
-
-STATIC short libstate;
-STATIC long bytecnt;
-
-STATIC FILE *infile; /* The current EM input file */
-
-STATIC int readbyte()
-{
- if (libstate == ARCHIVE && bytecnt-- == 0L) {
- /* If we're reading from an archive file, we'll
- * have to count the number of characters read,
- * to know where the current module ends.
- */
- return EOF;
- }
- return getc(infile);
-}
-
-
-
-
-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
-
-
-short get_int() {
-
- switch(table2()) {
- default: error("int expected");
- case CSTX1:
- return(tabval);
- }
-}
-
-char readchar()
-{
- return(readbyte());
-}
-
-
-
-offset get_off() {
-
- switch (table2()) {
- default: error("offset expected");
- case CSTX1:
- return((offset) tabval);
-#ifdef LONGOFF
- case CSTX2:
- return(tabval2);
-#endif
- }
-}
-
-STATIC make_string(n) int n; {
- register char *s;
- extern char *sprintf();
-
- s=sprintf(string,".%u",n);
- assert(s == string);
-}
-
-STATIC inident() {
- register n;
- register char *p = string;
- register c;
-
- n = get_int();
- 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));
-}
-
-
-
-
-file_init(f,state,length)
- FILE *f;
- short state;
- long length;
-{
- short n;
-
- infile = f;
- libstate = state;
- bytecnt = length;
- linecount = 0;
- n = readshort();
- if (n != (short) sp_magic) {
- error("wrong magic number: %d", n);
- }
-}
-
-
-
-arch_init(arch)
- FILE *arch;
-{
- short n;
-
- infile = arch;
- n = readshort();
- if (n != ARMAG) {
- error("wrong archive magic number: %d",n);
- }
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * L O W L E V E L I / O R O U T I N E S
- */
-
-
-extern int table1(); /* ( )
- * Read an instruction from the
- * Compact Assembly Language input
- * file (in 'neutral state').
- */
-extern int table2(); /* ( )
- * Read an instruction argument.
- */
-extern int table3(); /* ( int )
- * Read 'Common Table' item.
- */
-extern short get_int(); /* ( ) */
-extern offset get_off(); /* ( ) */
-extern char readchar(); /* ( ) */
-extern file_init(); /* (FILE *f, short state, long length)
- * Input file initialization. All
- * following read operations will read
- * from the given file f. Also checks
- * the magic number and sets global
- * variable 'linecount' to 0.
- * If the state is ARCHIVE, length
- * specifies the length of the module.
- */
-extern arch_init(); /* (FILE *arch)
- * Same as file_init,but opens an
- * archive file. So it checks the
- * magic number for archives.
- */
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * I C _ L I B . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mes.h"
-#include "../../../h/arch.h"
-#include "ic.h"
-#include "ic_lookup.h"
-#include "ic_io.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "ic_lib.h"
-
-
-STATIC skip_string(n)
- offset n;
-{
- /* Read a string of length n and void it */
-
- while (n--) {
- readchar();
- }
-}
-
-
-STATIC skip_arguments()
-{
- /* Skip the arguments of a MES pseudo. The argument
- * list is terminated by a sp_cend byte.
- */
-
- for (;;) {
- switch(table2()) {
- case sp_scon:
- get_off(); /* void */
- /* fall through !!! */
- case sp_icon:
- case sp_ucon:
- case sp_fcon:
- get_int(); /* void */
- skip_string(get_off());
- break;
- case sp_cend:
- return;
- default:
- break;
- }
- }
-}
-
-
-
-STATIC bool proc_wanted(name)
- char *name;
-{
- /* See if 'name' is the name of an external procedure
- * that has been used before, but for which no body
- * has been given so far.
- */
-
- proc_p p;
-
- if (( p = proclookup(name,IMPORTING)) != (proc_p) 0 &&
- !(p->p_flags1 & PF_BODYSEEN)) {
- return TRUE;
- } else {
- return FALSE;
- }
-}
-
-
-
-STATIC bool data_wanted(name)
- char *name;
-{
- /* See if 'name' is the name of an externally visible
- * data block that has been used before, but for which
- * no defining occurrence has been given yet.
- */
-
- dblock_p db;
-
- if ((db = symlookup(name,IMPORTING)) != (dblock_p) 0 &&
- db->d_pseudo == DUNKNOWN) {
- return TRUE;
- } else {
- return FALSE;
- }
-}
-
-
-
-STATIC bool wanted_names()
-{
- /* Read the names of procedures and data labels,
- * appearing in a 'MES ms_ext' pseudo. Those are
- * the names of entities that are imported by
- * a library module.
- * If any of them is wanted, return TRUE.
- * A name is wanted if it is the name of a procedure
- * or data block for which applied occurrences but
- * no defining occurrence has been met.
- */
-
- for (;;) {
- switch(table2()) {
- case DLBX:
- if (data_wanted(string)) {
- return TRUE;
- }
- /* A data entity with the name
- * string is available.
- */
- break;
- case sp_pnam:
- if (proc_wanted(string)) {
- return TRUE;
- }
- break;
- case sp_cend:
- return FALSE;
- default:
- error("wrong argument of MES %d", ms_ext);
- }
- }
-}
-
-
-
-STATIC FILE *curfile = NULL;
-STATIC bool useful()
-{
- /* Determine if any entity imported by the current
- * compact EM assembly file (which will usually be
- * part of an archive file) is useful to us.
- * The file must contain (before any other non-MES line)
- * a 'MES ms_ext' pseudo that has as arguments the names
- * of the entities imported.
- */
-
- for (;;) {
- if (table1() != PSEU || tabval != ps_mes) {
- error("cannot find MES %d in library file",ms_ext);
- }
- if (table2() != CSTX1) {
- error("message number expected");
- }
- if (tabval == ms_ext) {
- /* This is the one we searched */
- return wanted_names();
- /* Read the names of the imported entities
- * and check if any of them is wanted.
- */
- } else {
- skip_arguments(); /* skip remainder of this MES */
- }
- }
-}
-
-
-
-STATIC bool is_archive(name)
- char *name;
-{
- /* See if 'name' is the name of an archive file, i.e. it
- * should end on ".a" and should at least be three characters
- * long (i.e. the name ".a" is not accepted as an archive name!).
- */
-
- register char *p;
-
- for (p = name; *p; p++);
- return (p > name+2) && (*--p == 'a') && (*--p == '.');
-}
-
-
-
-STATIC struct ar_hdr hdr;
-
-STATIC bool read_hdr()
-{
- /* Read the header of an archive module */
-
-
- fread(&hdr, sizeof(hdr), 1, curfile);
- return !feof(curfile);
-}
-
-
-
-STATIC int argcnt = ARGSTART - 1;
-STATIC short arstate = NO_ARCHIVE;
-
-
-FILE *next_file(argc,argv)
- int argc;
- char *argv[];
-{
- /* See if there are more EM input files. The file names
- * are given via argv. If a file is an archive file
- * it is supposed to be a library of EM compact assembly
- * files. A module (file) contained in this archive file
- * is only used if it imports at least one procedure or
- * datalabel for which we have not yet seen a defining
- * occurrence, although we have seen a used occurrence.
- */
-
- long ptr;
-
- for (;;) {
- /* This loop is only exited via a return */
- if (arstate == ARCHIVE) {
- /* We were reading an archive file */
- if (ftell(curfile) & 1) {
- /* modules in an archive file always
- * begin on a word boundary, i.e. at
- * an even address.
- */
- fseek(curfile,1L,1);
- }
- if (read_hdr()) { /* read header of next module */
- ptr = ftell(curfile); /* file position */
- file_init(curfile,ARCHIVE,hdr.ar_size);
- /* tell i/o package that we're reading
- * an archive module of given length.
- */
- if (useful()) {
- /* re-initialize file, because 'useful'
- * has read some bytes too.
- */
- fseek(curfile,ptr,0); /* start module */
- file_init(curfile,ARCHIVE,hdr.ar_size);
- return curfile;
- } else {
- /* skip this module */
- fseek(curfile,
- ptr+hdr.ar_size,0);
- }
- } else {
- /* done with this archive */
- arstate = NO_ARCHIVE;
- }
- } else {
- /* open next file, close old */
- if (curfile != NULL) {
- fclose(curfile);
- }
- argcnt++;
- if (argcnt >= argc) {
- /* done with all arguments */
- return NULL;
- }
- filename = argv[argcnt];
- if ((curfile = fopen(filename,"r")) == NULL) {
- error("cannot open %s",filename);
- }
- if (is_archive(filename)) {
- /* ends on '.a' */
- arstate = ARCHIVE;
- arch_init(curfile); /* read magic ar number */
- } else {
- file_init(curfile,NO_ARCHIVE,0L);
- return curfile;
- }
- }
- }
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * L I B R A R Y M A N A G E R
- */
-
-
-extern FILE *next_file(); /* (int argc, char *argv[])
- * See if there are any more EM input files.
- * 'argv' contains the names of the files
- * that are passed as arguments to ic.
- * If an argument is a library (archive
- * file) only those modules that are useful
- * are used.
- */
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * I C _ L O O K U P . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/map.h"
-#include "../../../h/em_spec.h"
-#include "ic.h"
-#include "ic_lookup.h"
-#include "../share/alloc.h"
-
-
-sym_p symhash[NSYMHASH];
-prc_p prochash[NPROCHASH];
-num_p numhash[NNUMHASH];
-
-
-
-#define newsym() (sym_p) newstruct(sym)
-#define newprc() (prc_p) newstruct(prc)
-#define newnum() (num_p) newstruct(num)
-
-#define oldsym(x) oldstruct(sym,x)
-#define oldprc(x) oldstruct(prc,x)
-#define oldnum(x) oldstruct(num,x)
-
-
-/* instr_lab */
-
-
-
-
-
-lab_id instr_lab(number)
- short number;
-{
- register num_p *npp, np;
-
- /* In EM assembly language, a label is an unsigned number,
- * e.g. 120 in 'BRA *120'. In IC the labels of a procedure
- * are represented by consecutive integer numbers, called
- * lab_id. The mapping takes place here.
- */
-
-
- npp = &numhash[number%NNUMHASH];
- while (*npp != (num_p) 0) {
- if ((*npp)->n_number == number) {
- return(*npp)->n_labid;
- } else {
- npp = &(*npp)->n_next;
- }
- }
-
- /* The label was not found in the hashtable, so
- * create a new entry for it.
- */
-
- *npp = np = newnum();
- np->n_number = number;
- np->n_labid = ++lastlid;
- /* Assign a new label identifier to the num struct.
- * lastlid is reset to 0 at the beginning of
- * every new EM procedure (by cleaninstrlabs).
- */
- return (np->n_labid);
-}
-
-
-
-/* symlookup */
-
-STATIC 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);
-}
-
-dblock_p symlookup(name, status)
- char *name;
- int status;
-{
- /* Look up the name of a data block. The name can appear
- * in either a defining or applied occurrence (status is
- * DEFINING, OCCURRING resp.), or in a MES ms_ext instruction
- * as the name of a data block imported by a library module
- * (status is IMPORTING). Things get complicated,
- * because a HOL pseudo need not be preceded by a
- * data label, i.e. a hol block need not have a name.
- */
-
-
- register sym_p *spp, sp;
- register dblock_p dp;
-
- if (name == (char *) 0) {
- assert(status == DEFINING);
- dp = newdblock();
- } else {
- spp = &symhash[hash(name)%NSYMHASH];
- while (*spp != (sym_p) 0) {
- /* Every hashtable entry points to a list
- * of synonyms (i.e. names with the same
- * hash values). Try to find 'name' in its
- * list.
- */
- if (strncmp((*spp)->sy_name, name, IDL) == 0) {
- /* found */
- return ((*spp)->sy_dblock);
- } else {
- spp = &(*spp)->sy_next;
- }
- }
- /* The name is not found, so create a new entry for it.
- * However, if the status is IMPORTING, we just return 0,
- * indicating that we don't need this name.
- */
- if (status == IMPORTING) return (dblock_p) 0;
- *spp = sp = newsym();
- strncpy(sp->sy_name, name, IDL);
- dp = sp->sy_dblock = newdblock();
- }
- if (fdblock == (dblock_p) 0) {
- fdblock = dp;
- /* first data block */
- } else {
- ldblock->d_next = dp; /* link to last dblock */
- }
- ldblock = dp;
- dp->d_pseudo = DUNKNOWN; /* clear all fields */
- dp->d_id = ++lastdid;
- dp->d_size = 0;
- dp->d_objlist = (obj_p) 0;
- dp->d_values = (arg_p) 0;
- dp->d_next = (dblock_p) 0;
- dp->d_flags1 = 0;
- dp->d_flags2 = 0;
- if (status == OCCURRING) {
- /* This is the first occurrence of the identifier,
- * so if it is a used occurrence make the
- * identifier externally visible, else make it
- * internal.
- */
- dp->d_flags1 |= DF_EXTERNAL;
- }
- return dp;
-}
-
-
-
-/* getsym */
-
-dblock_p getsym(status)
- int status;
-{
- if (table2() != DLBX) {
- error("symbol expected");
- }
- return(symlookup(string,status));
-}
-
-
-
-/* getproc */
-
-proc_p getproc(status)
- int status;
-{
- if (table2() != sp_pnam) {
- error("proc name expected");
- }
- return(proclookup(string,status));
-}
-
-
-
-/* proclookup */
-
-proc_p proclookup(name, status)
- char *name;
- int status;
-{
- register prc_p *ppp, pp;
- register proc_p dp;
-
- ppp = &prochash[hash(name)%NPROCHASH];
- while (*ppp != (prc_p) 0) {
- /* Every hashtable entry points to a list
- * of synonyms (i.e. names with the same
- * hash values). Try to find 'name' in its
- * list.
- */
- if (strncmp((*ppp)->pr_name, name, IDL) == 0) {
- /* found */
- return ((*ppp)->pr_proc);
- } else {
- ppp = &(*ppp)->pr_next;
- }
- }
- /* The name is not found, so create a new entry for it,
- * unless the status is IMPORTING, in which case we
- * return 0, indicating we don't want this proc.
- */
- if (status == IMPORTING) return (proc_p) 0;
- *ppp = pp = newprc();
- strncpy(pp->pr_name, name, IDL);
- dp = pp->pr_proc = newproc();
- if (fproc == (proc_p) 0) {
- fproc = dp; /* first proc */
- } else {
- lproc->p_next = dp;
- }
- lproc = dp;
- dp->p_id = ++lastpid; /* create a unique proc_id */
- dp->p_next = (proc_p) 0;
- dp->p_flags1 = 0;
- dp->p_flags2 = 0;
- if (status == OCCURRING) {
- /* This is the first occurrence of the identifier,
- * so if it is a used occurrence the make the
- * identifier externally visible, else make it
- * internal.
- */
- dp->p_flags1 |= PF_EXTERNAL;
- }
- return dp;
-}
-
-
-
-/* cleaninstrlabs */
-
-cleaninstrlabs()
-{
- register num_p *npp, np, next;
-
- for (npp = numhash; npp < &numhash[NNUMHASH]; npp++) {
- for (np = *npp; np != (num_p) 0; np = next) {
- next = np->n_next;
- oldnum(np);
- }
- *npp = (num_p) 0;
- }
- /* Reset last label id (used by instr_lab). */
- lastlid = (lab_id) 0;
-}
-
-
-
-/* dump_procnames */
-
-dump_procnames(hash,n,f)
- prc_p hash[];
- int n;
- FILE *f;
-{
- /* Save the names of the EM procedures in file f.
- * Note that the Optimizer Intermediate Code does not
- * use identifiers but proc_ids, object_ids etc.
- * The names, however, can be used after optimization
- * is completed, to reconstruct Compact Assembly Language.
- * The output consists of tuples (proc_id, name).
- * This routine is called once for every input file.
- * To prevent names of external procedures being written
- * more than once, the PF_WRITTEN flag is used.
- */
-
- register prc_p *pp, ph;
- proc_p p;
- char str[IDL+1];
- register int i;
-
-#define PF_WRITTEN 01
-
-
- for (pp = &hash[0]; pp < &hash[n]; pp++) {
- /* Traverse the entire hash table */
- for (ph = *pp; ph != (prc_p) 0; ph = ph->pr_next) {
- /* Traverse the list of synonyms */
- p = ph->pr_proc;
- if ((p->p_flags2 & PF_WRITTEN) == 0) {
- /* not been written yet */
- for(i = 0; i < IDL; i++) {
- str[i] = ph->pr_name[i];
- }
- str[IDL] = '\0';
- fprintf(f,"%d %s\n",p->p_id, str);
- p->p_flags2 |= PF_WRITTEN;
- }
- }
- }
-}
-
-
-
-/* cleanprocs */
-
-cleanprocs(hash,n,mask)
- prc_p hash[];
- int n,mask;
-{
- /* After an EM input file has been processed, the names
- * of those procedures that are internal (i.e. not visible
- * outside the file they are defined in) must be removed
- * from the procedure hash table. This is accomplished
- * by removing the 'prc struct' from its synonym list.
- * After the final input file has been processed, all
- * remaining prc structs are also removed.
- */
-
- register prc_p *pp, ph, x, next;
-
- for (pp = &hash[0]; pp < &hash[n]; pp++) {
- /* Traverse the hash table */
- x = (prc_p) 0;
- for (ph = *pp; ph != (prc_p) 0; ph = next) {
- /* Traverse the synonym list.
- * x points to the prc struct just before ph,
- * or is 0 if ph is the first struct of
- * the list.
- */
- next = ph->pr_next;
- if ((ph->pr_proc->p_flags1 & mask) == 0) {
- if (x == (prc_p) 0) {
- *pp = next;
- } else {
- x->pr_next = next;
- }
- oldprc(ph); /* delete the struct */
- } else {
- x = ph;
- }
- }
- }
-}
-
-
-
-/* dump_dblocknames */
-
-dump_dblocknames(hash,n,f)
- sym_p hash[];
- int n;
- FILE *f;
-{
- /* Save the names of the EM data blocks in file f.
- * The output consists of tuples (dblock_id, name).
- * This routine is called once for every input file.
- */
-
- register sym_p *sp, sh;
- dblock_p d;
- char str[IDL+1];
- register int i;
-
-#define DF_WRITTEN 01
-
-
- for (sp = &hash[0]; sp < &hash[n]; sp++) {
- /* Traverse the entire hash table */
- for (sh = *sp; sh != (sym_p) 0; sh = sh->sy_next) {
- /* Traverse the list of synonyms */
- d = sh->sy_dblock;
- if ((d->d_flags2 & DF_WRITTEN) == 0) {
- /* not been written yet */
- for (i = 0; i < IDL; i++) {
- str[i] = sh->sy_name[i];
- str[IDL] = '\0';
- }
- fprintf(f,"%d %s\n",d->d_id, str);
- d->d_flags2 |= DF_WRITTEN;
- }
- }
- }
-}
-
-
-
-/* cleandblocks */
-
-cleandblocks(hash,n,mask)
- sym_p hash[];
- int n,mask;
-{
- /* After an EM input file has been processed, the names
- * of those data blocks that are internal must be removed.
- */
-
- register sym_p *sp, sh, x, next;
-
- for (sp = &hash[0]; sp < &hash[n]; sp++) {
- x = (sym_p) 0;
- for (sh = *sp; sh != (sym_p) 0; sh = next) {
- next = sh->sy_next;
- if ((sh->sy_dblock->d_flags1 & mask) == 0) {
- if (x == (sym_p) 0) {
- *sp = next;
- } else {
- x->sy_next = next;
- }
- oldsym(sh); /* delete the struct */
- } else {
- x = sh;
- }
- }
- }
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * L O O K - U P R O U T I N E S
- */
-
-/* During Intermediate Code generation data label names ('symbols'),
- * procedure names and instruction labels (numbers) are translated
- * to resp. a data block pointer, a proc pointer and a label identifier.
- * We use three hash tables for this purpose (symhash, prochash, numhash).
- * Every name/number is hashed to an index in a specific table. A table
- * entry contains a list of structs (sym, prc, num), each one representing
- * a 'synonym'. (Synonyms are names/numbers having the same hash value).
- */
-
-
-/* status passed as argument to look_up routines:
- * resp. used occurrence, defining occurrence, occurrence in
- * a MES ms_ext pseudo.
- */
-
-#define OCCURRING 0
-#define DEFINING 1
-#define IMPORTING 2
-
-#define NSYMHASH 127
-#define NPROCHASH 127
-#define NNUMHASH 37
-
-extern sym_p symhash[];
-extern prc_p prochash[];
-extern num_p numhash[];
-
-extern lab_id instr_lab(); /* ( short number)
- * Maps EM labels to sequential
- * integers.
- */
-extern dblock_p symlookup(); /* (char *ident, int status)
- * Look up the data block with
- * the given name.
- */
-extern dblock_p getsym(); /* ( int status)
- * Read and look up a symbol.
- * If this is the first occurrence
- * of it, then make it external
- * (if status=OCCURRING) or
- * internal (if DEFINING).
- */
-extern proc_p getproc(); /* (int status)
- * Same as getsym, but for procedure
- * names.
- */
-extern proc_p proclookup(); /* ( char *ident, int status)
- * Find (in the hashtable) the
- * procedure with the given name.
- */
-extern cleaninstrlabs(); /* ( )
- * Forget about all instruction labels.
- */
-extern dump_procnames(); /* (prc_p hash[], int n, FILE *f)
- * Save the names of the procedures
- * in file f; hash is the hashtable
- * used and n is its length.
- */
-extern cleanprocs(); /* (prc_p hash[], int n,mask)
- * Make the names of all procedures
- * for which p_flags1&mask = 0 invisible
- */
-extern cleandblocks(); /* (sym_p hash[], int n)
- * Make the names of all data blocks
- * for which d_flags1&mask = 0 invisible
- */
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=-DVERBOSE
-SHARE=../share
-IL=.
-OBJECTS=il.o il1_anal.o il1_cal.o il1_formal.o il1_aux.o il2_aux.o \
-il3_change.o il3_subst.o il3_aux.o il_aux.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/parser.o $(SHARE)/aux.o $(SHARE)/go.o
-SRC=il.h il1_anal.h il1_cal.h il1_formal.h il1_aux.h il2_aux.h il3_subst.h il3_change.h il3_aux.h il_aux.h \
-il.c il1_anal.c il1_cal.c il1_formal.c il1_aux.c il2_aux.c il3_subst.c il3_change.c il3_aux.c il_aux.c
-all: $(OBJECTS)
-il: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o il -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-il.o: ../../../h/em_mnem.h
-il.o: ../../../h/em_pseu.h
-il.o: ../share/alloc.h
-il.o: ../share/debug.h
-il.o: ../share/files.h
-il.o: ../share/get.h
-il.o: ../share/global.h
-il.o: ../share/lset.h
-il.o: ../share/map.h
-il.o: ../share/put.h
-il.o: ../share/types.h
-il.o: il.h
-il.o: il1_anal.h
-il.o: il2_aux.h
-il.o: il3_subst.h
-il1_anal.o: ../../../h/em_mnem.h
-il1_anal.o: ../../../h/em_pseu.h
-il1_anal.o: ../share/alloc.h
-il1_anal.o: ../share/debug.h
-il1_anal.o: ../share/global.h
-il1_anal.o: ../share/lset.h
-il1_anal.o: ../share/put.h
-il1_anal.o: ../share/types.h
-il1_anal.o: il.h
-il1_anal.o: il1_anal.h
-il1_anal.o: il1_aux.h
-il1_anal.o: il1_cal.h
-il1_anal.o: il1_formal.h
-il1_anal.o: il_aux.h
-il1_aux.o: ../../../h/em_spec.h
-il1_aux.o: ../share/alloc.h
-il1_aux.o: ../share/debug.h
-il1_aux.o: ../share/global.h
-il1_aux.o: ../share/lset.h
-il1_aux.o: ../share/types.h
-il1_aux.o: il.h
-il1_aux.o: il1_aux.h
-il1_aux.o: il_aux.h
-il1_cal.o: ../../../h/em_mnem.h
-il1_cal.o: ../../../h/em_spec.h
-il1_cal.o: ../share/alloc.h
-il1_cal.o: ../share/debug.h
-il1_cal.o: ../share/global.h
-il1_cal.o: ../share/lset.h
-il1_cal.o: ../share/parser.h
-il1_cal.o: ../share/types.h
-il1_cal.o: il.h
-il1_cal.o: il1_aux.h
-il1_cal.o: il1_cal.h
-il1_formal.o: ../share/alloc.h
-il1_formal.o: ../share/debug.h
-il1_formal.o: ../share/global.h
-il1_formal.o: ../share/lset.h
-il1_formal.o: ../share/types.h
-il1_formal.o: il.h
-il1_formal.o: il1_aux.h
-il1_formal.o: il1_formal.h
-il2_aux.o: ../../../h/em_mnem.h
-il2_aux.o: ../../../h/em_spec.h
-il2_aux.o: ../share/alloc.h
-il2_aux.o: ../share/debug.h
-il2_aux.o: ../share/get.h
-il2_aux.o: ../share/global.h
-il2_aux.o: ../share/lset.h
-il2_aux.o: ../share/types.h
-il2_aux.o: il.h
-il2_aux.o: il2_aux.h
-il2_aux.o: il_aux.h
-il3_aux.o: ../share/alloc.h
-il3_aux.o: ../share/debug.h
-il3_aux.o: ../share/global.h
-il3_aux.o: ../share/types.h
-il3_aux.o: il.h
-il3_aux.o: il3_aux.h
-il3_aux.o: il_aux.h
-il3_change.o: ../../../h/em_mes.h
-il3_change.o: ../../../h/em_mnem.h
-il3_change.o: ../../../h/em_pseu.h
-il3_change.o: ../../../h/em_spec.h
-il3_change.o: ../share/alloc.h
-il3_change.o: ../share/debug.h
-il3_change.o: ../share/def.h
-il3_change.o: ../share/get.h
-il3_change.o: ../share/global.h
-il3_change.o: ../share/lset.h
-il3_change.o: ../share/put.h
-il3_change.o: ../share/types.h
-il3_change.o: il.h
-il3_change.o: il3_aux.h
-il3_change.o: il3_change.h
-il3_change.o: il_aux.h
-il3_subst.o: ../../../h/em_mnem.h
-il3_subst.o: ../share/alloc.h
-il3_subst.o: ../share/debug.h
-il3_subst.o: ../share/get.h
-il3_subst.o: ../share/global.h
-il3_subst.o: ../share/lset.h
-il3_subst.o: ../share/types.h
-il3_subst.o: il.h
-il3_subst.o: il3_aux.h
-il3_subst.o: il3_change.h
-il3_subst.o: il3_subst.h
-il_aux.o: ../../../h/em_spec.h
-il_aux.o: ../share/alloc.h
-il_aux.o: ../share/debug.h
-il_aux.o: ../share/global.h
-il_aux.o: ../share/lset.h
-il_aux.o: ../share/map.h
-il_aux.o: ../share/types.h
-il_aux.o: il.h
-il_aux.o: il_aux.h
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N */
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/files.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../share/map.h"
-#include "il_aux.h"
-#include "il1_anal.h"
-#include "il2_aux.h"
-#include "il3_subst.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/go.h"
-
-int calnr;
-calcnt_p cchead; /* call-count info of current proc */
-STATIC short space = 0;
-
-STATIC char cname[] = "/usr/tmp/ego.i1.XXXXXX";
-STATIC char ccname[] = "/usr/tmp/ego.i2.XXXXXX";
-
-/* For debugging only */
-STATIC char sname[] = "/usr/tmp/ego.i3.XXXXXX";
-
-int Ssubst;
-#ifdef VERBOSE
-int Senv,Srecursive,Slocals,Sinstrlab,Sparsefails,Spremoved,Scals;
-int Sbig_caller,Sdispensable,Schangedcallee,Sbigcallee,Sspace,Szeroratio;
-#endif
-
-/* P A S S 1
- *
- * Pass 1 reads and analyses the EM text and the CFG.
- * It determines for every procedure if it may be expanded
- * in line and how it uses its formal parameters.
- * It also collects all calls appearing in the program and
- * recognizes the actual parameters of every call.
- * The call descriptors are put in a file (calfile).
- */
-
-pass1(lnam,bnam,cnam)
- char *lnam, *bnam, *cnam;
-{
- FILE *f, *gf, *cf, *ccf; /* The EM input, the basic block graph,
- * the call-list file and the calcnt file.
- */
- long laddr;
- bblock_p g;
- short kind;
- line_p l;
-
- f = openfile(lnam,"r");
- gf = openfile(bnam,"r");
- cf = openfile(cnam,"w");
- ccf = openfile(ccname,"w");
- mesregs = Lempty_set();
- apriori(fproc);
- /* use information from the procedure table to
- * see which calls certainly cannot be expanded.
- */
- while(TRUE) {
- laddr = ftell(f);
- if (!getunit(gf,f,&kind,&g,&l,&curproc,TRUE)) break;
- /* Read the control flow graph and EM text of
- * one procedure and analyze it.
- */
- if (kind == LDATA) {
- remunit(LDATA,(proc_p) 0,l);
- continue;
- }
- /* OUTTRACE("flow graph of proc %d read",curproc->p_id); */
- assert(INSTR(g->b_start) == ps_pro);
- curproc->p_start = g;
- curproc->P_LADDR = laddr;
- /* address of em text in em-file */
- /* address of graph in basic block file */
- curproc->P_SIZE = proclength(curproc); /* #instructions */
- if (BIG_PROC(curproc)) {
- /* curproc is too large to be expanded in line */
- UNSUITABLE(curproc);
- }
- calnr = 0;
- anal_proc(curproc,cf,ccf);
- /* OUTTRACE("proc %d processed",curproc->p_id); */
- remunit(LTEXT,curproc,(line_p) 0);
- /* remove control flow graph + text */
- /* OUTTRACE("graph of proc %d removed",curproc->p_id); */
- Ldeleteset(mesregs);
- mesregs = Lempty_set();
- }
- fclose(f);
- fclose(gf);
- fclose(cf);
- fclose(ccf);
-}
-
-
-
-/* P A S S 2
- *
- * Pass 2 reads the calfile and determines which calls should
- * be expanded in line. It does not use the EM text.
- */
-
-
-
-STATIC char cname2[] = "/usr/tmp/ego.i4.XXXXXX";
-
-pass2(cnam,space)
- char *cnam;
- short space;
-{
- FILE *cf, *cf2, *ccf;
- call_p c,a;
-
- cf = openfile(cnam,"r");
- cf2 = openfile(cname2,"w");
- ccf = openfile(ccname,"r");
- while ((c = getcall(cf)) != (call_p) 0) {
- /* process all calls */
- if (SUITABLE(c->cl_proc)) {
- /* called proc. may be put in line */
- anal_params(c);
- /* see which parameters may be put in line */
- assign_ratio(c); /* assign a rank */
- a = abstract(c); /* abstract essential info */
- append_abstract(a,a->cl_caller);
- /* put it in call-list of calling proc. */
- putcall(c,cf2,(short) 0);
- } else {
- rem_call(c);
- }
- }
- select_calls(fproc,ccf,space);
- fclose(cf); unlink(cnam);
- fclose(cf2);
- fclose(ccf); unlink(ccname);
- cf2 = openfile(cname2,"r");
- add_actuals(fproc,cf2);
- cleancals(fproc); /* remove calls that were not selected */
- /* add actual parameters to each selected call */
- fclose(cf2); unlink(cname2);
-}
-
-
-
-/* P A S S 3
- *
- * pass 3 reads the substitution file and performs all
- * substitutions described in that file. It reads the
- * original EM text and produced a new (optimized)
- * EM textfile.
- */
-
-
-pass3(lnam,lnam2)
- char *lnam,*lnam2;
-{
- bool verbose = TRUE;
- FILE *lfile, *lfilerand, *lfile2, *sfile;
- call_p c,next;
- line_p l,startscan,cal;
- short lastcid; /* last call-id seen */
-
- lfile = openfile(lnam, "r");
- lfilerand = openfile(lnam, "r");
- lfile2 = openfile(lnam2,"w");
- if (verbose) {
- sfile = openfile(sname,"w");
- }
- mesregs = Lempty_set();
- while ((l = get_text(lfile,&curproc)) != (line_p) 0) {
- if (curproc == (proc_p) 0) {
- /* Just a data-unit; no real instructions */
- putlines(l->l_next,lfile2);
- oldline(l);
- continue;
- }
- if (IS_DISPENSABLE(curproc)) {
- liquidate(curproc,l->l_next);
- } else {
- startscan = l->l_next;
- lastcid = 0;
- for (c = curproc->P_CALS; c != (call_p) 0; c = next) {
- next = c->cl_cdr;
- cal = scan_to_cal(startscan,c->cl_id - lastcid);
- assert (cal != (line_p) 0);
- startscan = scan_to_cal(cal->l_next,1);
- /* next CAL */
- lastcid = c->cl_id;
- /* next CAL after current one */
- substitute(lfilerand,c,cal,l->l_next);
- if (verbose) {
- putcall(c,sfile,0);
- } else {
- rem_call(c);
- }
- }
- }
- putlines(l->l_next,lfile2);
- Ldeleteset(mesregs);
- mesregs = Lempty_set();
- oldline(l);
- }
- fclose(lfile);
- fclose(lfile2);
- if (verbose) {
- fclose(sfile);
- unlink(sname);
- }
-}
-
-
-STATIC il_extptab(ptab)
- proc_p ptab;
-{
- /* Allocate space for extension of proctable entries.
- * Also, initialise some of the fields just allocated.
- */
-
- register proc_p p;
-
- for (p = ptab; p != (proc_p) 0; p = p->p_next) {
- p->p_extend = newilpx();
- p->P_ORGLABELS = p->p_nrlabels;
- p->P_ORGLOCALS = p->p_localbytes;
- }
-}
-
-STATIC il_cleanptab(ptab)
- proc_p ptab;
-{
- /* De-allocate space for extensions */
-
- register proc_p p;
-
- for (p = ptab; p != (proc_p) 0; p = p->p_next) {
- oldilpx(p->p_extend);
- }
-}
-
-#ifdef VERBOSE
-Sdiagnostics()
-{
- /* print statictical information */
-
- fprintf(stderr,"STATISTICS:\n");
- fprintf(stderr,"Info about procedures:\n");
- fprintf(stderr,"environment accessed: %d\n",Senv);
- fprintf(stderr,"recursive: %d\n",Srecursive);
- fprintf(stderr,"too many locals: %d\n",Slocals);
- fprintf(stderr,"instr. lab in data block: %d\n",Sinstrlab);
- fprintf(stderr,"procedures removed: %d\n",Spremoved);
- fprintf(stderr,"\nInfo about calls:\n");
- fprintf(stderr,"total number of calls: %d\n",Scals);
- fprintf(stderr,"total number of calls substituted: %d\n",Ssubst);
- fprintf(stderr,"parser failed: %d\n",Sparsefails);
- fprintf(stderr,"caller too big: %d\n",Sbig_caller);
- fprintf(stderr,"caller dispensable: %d\n",Sdispensable);
- fprintf(stderr,"callee is changed: %d\n",Schangedcallee);
- fprintf(stderr,"callee too big: %d\n",Sbigcallee);
- fprintf(stderr,"no space available: %d\n",Sspace);
- fprintf(stderr,"zero ratio: %d\n",Szeroratio);
-}
-#endif
-
-il_flags(p)
- char *p;
-{
- if (*p++ == 's') {
- while (*p != '\0') {
- space = 10*space +*p++ -'0';
- }
- }
-}
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- FILE *f;
-
- go(argc,argv,no_action,no_action,no_action,il_flags);
- il_extptab(fproc); /* add extended data structures */
- mktemp(cname);
- mktemp(ccname);
- mktemp(sname);
- mktemp(cname2);
- pass1(lname,bname,cname); /* grep calls, analyse procedures */
- pass2(cname,space); /* select calls to be expanded */
- pass3(lname,lname2); /* do substitutions */
- f = openfile(dname2,"w");
- il_cleanptab(fproc); /* remove extended data structures */
- putdtable(fdblock,f);
- f = openfile(pname2,"w");
- putptable(fproc,f,FALSE);
- report("inline substitutions",Ssubst);
-#ifdef VERBOSE
- if (verbose_flag) {
- Sdiagnostics();
- }
-#endif
-#ifdef DEBUG
- core_usage();
-#endif
- exit(0);
-}
+++ /dev/null
-/* I N T E R N A L D A T A S T R U C T U R E S O F
- *
- * I N L I N E S U B S T I T U T I O N
- *
- */
-
-
-typedef struct actual *actual_p;
-typedef struct calcnt *calcnt_p;
-typedef short call_id;
-
-struct call {
- proc_p cl_caller; /* calling procedure */
- call_id cl_id; /* uniquely denotes a CAL instruction */
- proc_p cl_proc; /* the called procedure */
- byte cl_looplevel; /* loop nesting level of the CAL */
- bool cl_flags; /* flag bits */
- short cl_ratio; /* indicates 'speed gain / size lost' */
- call_p cl_cdr; /* link to next call */
- call_p cl_car; /* link to nested calls */
- actual_p cl_actuals; /* actual parameter expr. trees */
-};
-
-#define CLF_INLPARS 017 /* min(15,nr. of inline parameters) */
-#define CLF_SELECTED 020 /* is call selected for expansion? */
-#define CLF_EVER_EXPANDED 040 /* ever expanded? e.g. in a nested call. */
-#define CLF_FIRM 0100 /* indicates if the call takes place in a
- * firm block of a loop (i.e. one that
- * is always executed, except
- * -perhaps- at the last iteration).
- * Used for heuristics only.
- */
-
-struct actual {
- line_p ac_exp; /* copy of EM text */
- /* 0 for actuals that are not inline */
- offset ac_size; /* number of bytes of parameter */
- bool ac_inl; /* TRUE if it may be expanded in line */
- actual_p ac_next; /* link */
-};
-
-
-struct formal {
- offset f_offset; /* offsetin bytes */
- byte f_flags; /* flags FF_BAD etc. */
- byte f_type; /* SINGLE, DOUBLE,POINTER,UNKNOWN */
- formal_p f_next; /* link */
-};
-
-
-/* flags of formal: */
-
-#define FF_BAD 01
-#define FF_REG 02
-#define FF_ONCEUSED 04
-#define FF_OFTENUSED 06
-#define USEMASK 014
-
-/* types of formals: */
-
-#define SINGLE 1
-#define DOUBLE 2
-#define POINTER 3
-#define UNKNOWN 4
-
-/* 'call-count' information keeps track of the number
- * of times one procedure calls another. Conceptually,
- * it may be regarded as a two dimensional array, where
- * calcnt[p,q] is the number of times p calls q. As this
- * matrix would be very dense, we use a more efficient
- * list representation. Every procedure has a list
- * of calcnt structs.
- */
-
-struct calcnt {
- proc_p cc_proc; /* the called procedure */
- short cc_count; /* # times proc. is called in the
- * original text of the caller.
- */
- calcnt_p cc_next; /* link */
-};
-
-
-
-
-extern int calnr;
-extern calcnt_p cchead; /* calcnt info of current proc */
-
-/* Macro's for extended data structures */
-
-#define P_CALS p_extend->px_il.p_cals
-#define P_SIZE p_extend->px_il.p_size
-#define P_FORMALS p_extend->px_il.p_formals
-#define P_NRCALLED p_extend->px_il.p_nrcalled
-#define P_CCADDR p_extend->px_il.p_ccaddr
-#define P_LADDR p_extend->px_il.p_laddr
-#define P_ORGLABELS p_extend->px_il.p_orglabels
-#define P_ORGLOCALS p_extend->px_il.p_orglocals
-
-/* flags2: */
-
-#define PF_UNSUITABLE 01
-#define PF_NO_INLPARS 02
-#define PF_FALLTHROUGH 04
-#define PF_DISPENSABLE 010
-#define PF_CHANGED 020
-
-
-/* kinds of usages: */
-
-#define USE 0
-#define CHANGE 1
-#define ADDRESS 2
-
-
-
-
-/* We do not expand calls if:
- * - the called procedure has to many local variables
- * - the calling procedure is already very large
- * - the called procedure is to large.
- */
-
-#define MANY_LOCALS(p) (p->p_localbytes > LOCAL_THRESHOLD)
-#define LOCAL_THRESHOLD 200
-#define BIG_CALLER(p) (p->P_SIZE > CALLER_THRESHOLD)
-#define CALLER_THRESHOLD 500
-#define BIG_PROC(p) (p->P_SIZE > CALLEE_THRESHOLD)
-#define CALLEE_THRESHOLD 100
-
-#define FALLTHROUGH(p) (p->p_flags2 & PF_FALLTHROUGH)
-#define DISPENSABLE(p) p->p_flags2 |= PF_DISPENSABLE
-#define IS_DISPENSABLE(p) (p->p_flags2 & PF_DISPENSABLE)
-#define SELECTED(c) c->cl_flags |= CLF_SELECTED
-#define IS_SELECTED(c) (c->cl_flags & CLF_SELECTED)
-#define EVER_EXPANDED(c) c->cl_flags |= CLF_EVER_EXPANDED
-#define IS_EVER_EXPANDED(c) (c->cl_flags & CLF_EVER_EXPANDED)
-#define UNSUITABLE(p) p->p_flags2 |= PF_UNSUITABLE
-#define SUITABLE(p) (!(p->p_flags2&PF_UNSUITABLE))
-#define INLINE_PARS(p) (!(p->p_flags2&PF_NO_INLPARS))
-#define PARAMS_UNKNOWN(p) (p->p_nrformals == UNKNOWN_SIZE)
-
-extern int Ssubst;
-#ifdef VERBOSE
-extern int Senv,Srecursive,Slocals,Sinstrlab,Sparsefails,Spremoved,Scals;
-extern int Sbig_caller,Sdispensable,Schangedcallee,Sbigcallee,Sspace,Szeroratio;
-#endif
-
-/* extra core-allocation macros */
-
-#define newcall() (call_p) newstruct(call)
-#define newactual() (actual_p) newstruct(actual)
-#define newformal() (formal_p) newstruct(formal)
-#define newcalcnt() (calcnt_p) newstruct(calcnt)
-#define newilpx() (pext_p) newstruct(pext_il)
-
-#define oldcall(x) oldstruct(call,x)
-#define oldactual(x) oldstruct(actual,x)
-#define oldformal(x) oldstruct(formal,x)
-#define oldcalcnt(x) oldstruct(calcnt,x)
-#define oldilpx(x) oldstruct(pext_il,x)
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ A N A L . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "il1_aux.h"
-#include "il1_formal.h"
-#include "il1_cal.h"
-#include "il1_anal.h"
-#include "il_aux.h"
-#include "../share/put.h"
-
-#define BODY_KNOWN(p) (p->p_flags1 & (byte) PF_BODYSEEN)
-#define ENVIRON(p) (p->p_flags1 & (byte) PF_ENVIRON)
-#define RETURN_BLOCK(b) (Lnrelems(b->b_succ) == 0)
-#define LAST_BLOCK(b) (b->b_next == (bblock_p) 0)
-
-/* Daisy chain recursion not yet accounted for: */
-#define RECURSIVE(p) (Cis_elem(p->p_id,p->p_calling))
-/*
-#define CALLS_UNKNOWN(p) (p->p_flags1 & (byte) PF_CALUNKNOWN)
-*/
-#define CALLS_UNKNOWN(p) (FALSE)
-
-
-
-apriori(proctab)
- proc_p proctab;
-{
- /* For every procedure, see if we can determine
- * from the information provided by the previous
- * phases of the optimizer that it cannot or should not
- * be expanded in line. This will reduce the length
- * of the call list.
- */
-
- register proc_p p;
-
- for (p = proctab; p != (proc_p) 0; p = p->p_next) {
- if (!BODY_KNOWN(p) ||
- ENVIRON(p) || RECURSIVE(p) ||
- PARAMS_UNKNOWN(p) || MANY_LOCALS(p)) {
- UNSUITABLE(p);
-#ifdef VERBOSE
- if (BODY_KNOWN(p)) {
- if (ENVIRON(p)) Senv++;
- if (RECURSIVE(p)) Srecursive++;
- if (MANY_LOCALS(p)) Slocals++;
- }
-#endif
- }
- }
-}
-
-
-STATIC check_labels(p,arglist)
- proc_p p;
- arg_p arglist;
-{
- /* Check if any of the arguments contains an instruction
- * label; if so, make p unsuitable.
- */
-
- arg_p arg;
-
- for (arg = arglist; arg != (arg_p) 0; arg = arg->a_next) {
- if (arg->a_type == ARGINSTRLAB) {
- UNSUITABLE(p);
-#ifdef VERBOSE
- Sinstrlab++;
-#endif
- break;
- }
- }
-}
-
-
-
-STATIC anal_instr(p,b,cf)
- proc_p p;
- bblock_p b;
- FILE *cf;
-{
- /* Analyze the instructions of block b
- * within procedure p.
- * See which parameters are used, changed
- * or have their address taken. Recognize
- * the actual parameter expressions of
- * the CAL instructions.
- */
-
- register line_p l;
-
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- switch(INSTR(l)) {
- case op_cal:
- anal_cal(p,l,b,cf);
- break;
- case op_stl:
- case op_inl:
- case op_del:
- case op_zrl:
- formal(p,b,off_set(l),SINGLE,CHANGE);
- /* see if the local is a parameter.
- * If so, it is a one-word parameter
- * that is stored into.
- */
- break;
- case op_sdl:
- formal(p,b,off_set(l),DOUBLE,CHANGE);
- break;
- case op_lol:
- formal(p,b,off_set(l),SINGLE,USE);
- break;
- case op_ldl:
- formal(p,b,off_set(l),DOUBLE,USE);
- break;
- case op_sil:
- case op_lil:
- formal(p,b,off_set(l),POINTER,USE);
- break;
- case op_lal:
- formal(p,b,off_set(l),UNKNOWN,ADDRESS);
- break;
- case ps_rom:
- case ps_con:
- case ps_bss:
- case ps_hol:
- check_labels(p,ARG(l));
- break;
- }
- }
-}
-
-
-
-anal_proc(p,cf,ccf)
- proc_p p;
- FILE *cf,*ccf;
-{
- /* Analyze a procedure; use information
- * stored in its basic blocks or in
- * its instructions.
- */
-
- register bblock_p b;
- bool fallthrough = TRUE;
-
- cchead = (calcnt_p) 0;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- if (RETURN_BLOCK(b) && !LAST_BLOCK(b)) {
- fallthrough = FALSE;
- /* p contains a RET instruction somewhere
- * in the middle of its code.
- */
- }
- anal_instr(p,b,cf); /* analyze instructions */
- }
- if (fallthrough) {
- p->p_flags2 |= PF_FALLTHROUGH;
- }
- rem_indir_acc(p);
- /* don't expand formal that may be accessed indirectly */
- p->P_CCADDR = putcc(cchead,ccf);
- /* write calcnt info and remember disk address */
- remcc(cchead);
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ A N A L . H
- */
-
-extern apriori(); /* (proc_p proctab)
- * For every procedure, see if we can determine
- * from the information provided by the previous
- * phases of the optimizer that it cannot or should not
- * be expanded in line. This will reduce the length
- * of the call list.
- */
-extern anal_proc(); /* (proc_p p, FILE *cf, *cff)
- * Analyse a procedure. See which formal parameters
- * it uses and which procedures it calls.
- * cf and ccf are the call-file and the call-count file.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ A U X . C
- */
-
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../../../h/em_spec.h"
-#include "il_aux.h"
-#include "il1_aux.h"
-
-#define CHANGE_INDIR(p) (p->p_change->c_flags & CF_INDIR)
-#define USE_INDIR(p) (p->p_use->u_flags & UF_INDIR)
-
-#define IS_INSTR(c) (c >= sp_fmnem && c <= sp_lmnem)
-
-
-bool same_size(t1,t2)
- int t1, t2;
-{
- /* See if the two types have the same size */
-
- return tsize(t1) == tsize(t2);
-}
-
-
-
-STATIC bool is_reg(off,s)
- offset off;
- int s;
-{
- /* See if there is a register message
- * for the local or parameter at offset off
- * and size s.
- */
-
- Lindex i;
- arg_p arg;
-
- for (i = Lfirst(mesregs); i != (Lindex) 0; i = Lnext(i,mesregs)) {
- arg = ((line_p) Lelem(i))->l_a.la_arg->a_next;
- if (arg->a_a.a_offset == off &&
- arg->a_next->a_a.a_offset == s) {
- return TRUE;
- }
- }
- return FALSE;
-}
-
-
-rem_actuals(acts)
- actual_p acts;
-{
- /* remove the actual-list */
-
- actual_p a,next;
-
- for (a = acts; a != (actual_p) 0; a = next) {
- next = a->ac_next;
- /* REMOVE CODE OF a->ac_exp HERE */
- oldactual(a);
- }
-}
-
-
-
-remov_formals(p)
- proc_p p;
-{
- /* Remove the list of formals of p */
-
- formal_p f, next;
-
- for (f = p->P_FORMALS; f != (formal_p) 0; f = next) {
- next = f->f_next;
- oldformal(f);
- }
- p->P_FORMALS = (formal_p) 0;
-}
-
-
-
-rem_indir_acc(p)
- proc_p p;
-{
- /* Formals that may be accessed indirectly
- * cannot be expanded in line, so they are
- * removed from the formals list.
- */
-
- formal_p prev, f, next;
-
- if (!USE_INDIR(p) && !CHANGE_INDIR(p)) return;
- /* Any formal for which we don't have
- * a register message is now doomed.
- */
- prev = (formal_p) 0;
- for (f = p->P_FORMALS; f != (formal_p) 0; f = next) {
- next = f->f_next;
- if (!is_reg(f->f_offset,tsize(f->f_type))) {
- if (prev == (formal_p) 0) {
- p->P_FORMALS = next;
- } else {
- prev->f_next = next;
- }
- oldformal(f);
- }
- }
-}
-
-
-
-bool par_overlap(off1,t1,off2,t2)
- offset off1,off2;
- int t1,t2;
-{
- /* See if the parameter at offset off1 and type t1
- * overlaps the paramete at offset off2 and type t2.
- */
-
- if (off1 > off2) {
- return off2 + tsize(t2) > off1;
- } else {
- if (off2 > off1) {
- return off1 + tsize(t1) > off2;
- } else {
- return TRUE;
- }
- }
-}
-
-
-
-short looplevel(b)
- bblock_p b;
-{
- /* determine the loop nesting level of basic block b;
- * this is the highest nesting level of all blocks
- * that b is part of.
- * Note that the level of a loop is 0 for outer loops,
- * so a block inside a loop with nesting level N has
- * looplevel N+1.
- */
-
- Lindex i;
- short max = 0;
-
- for (i = Lfirst(b->b_loops); i != (Lindex)0; i = Lnext(i,b->b_loops)) {
- if (((loop_p) Lelem(i))->lp_level >= max) {
- max = ((loop_p) Lelem(i))->lp_level + 1;
- }
- }
- return max;
-}
-
-
-
-short proclength(p)
- proc_p p;
-{
- /* count the number of EM instructions of p */
-
- register short cnt;
- register bblock_p b;
- register line_p l;
-
- cnt = 0;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (IS_INSTR(INSTR(l))) {
- /* skip pseudo instructions */
- cnt++;
- }
- }
- }
- return cnt;
-}
-
-
-
-
-
-line_p copy_code(l1,l2)
- line_p l1,l2;
-{
- /* copy the code between l1 and l2 */
-
- line_p head, tail, l, lnp;
-
- head = (line_p) 0;
- for (lnp = l1; ; lnp = lnp->l_next) {
- l = duplicate(lnp);
- if (head == (line_p) 0) {
- head = tail = l;
- PREV(l) = (line_p) 0;
- } else {
- tail->l_next = l;
- PREV(l) = tail;
- tail = l;
- }
- if (lnp == l2) break;
- }
- return head;
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ A U X . H
- */
-
-extern bool same_size(); /* (int t1,t2)
- * See if the two types t1 and t2 have
- * the same size.
- */
-extern rem_actuals(); /* (actual_p atcs)
- * remove an actual-list from core.
- */
-extern remov_formals(); /* (proc_p p)
- * Remove the formals-list of p from core.
- */
-extern rem_indir_acc(); /* (proc_p p)
- * Remove formal that may be accessed
- * indirectly from formal lists of p
- */
-extern bool par_overlap(); /* (offset off1, int t1, offset off2, int t2)
- * See if the formal at offset off1 and type t1
- * overlaps the formal at offset off2
- * and type t2.
- */
-extern short looplevel(); /* (bblock_p b)
- * Determine the loop nesting level of b.
- */
-extern short proclength(); /* (proc_p p)
- * Determine the number of EM instructions
- * in p. Do not count pseudos.
- */
-
-extern line_p copy_code(); /* (line_p l1,l2)
- * copy the code between l1 and l2.
- * Pseudos may not be contained in
- * the list of instructions. If l1==l2
- * the result is only one instruction.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ C A L . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "il1_cal.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-#include "il1_aux.h"
-#include "../share/parser.h"
-
-STATIC actual_p acts, *app;
-
-#define INIT_ACTS() {acts = (actual_p) 0; app = &acts;}
-#define APPEND_ACTUAL(a) {*app = a; app = &a->ac_next;}
-
-STATIC make_actual(l1,l2,size)
- line_p l1,l2;
- offset size;
-{
- /* Allocate a struct for a new actual parameter
- * expression, the code of which extends from
- * l1 to l2.
- */
-
- actual_p a;
-
- a = newactual();
- a->ac_exp = copy_code(l1,l2);
- a->ac_size = size;
- APPEND_ACTUAL(a); /* append it to actual-list */
-}
-
-
-
-STATIC bool chck_asp(p,l)
- proc_p p;
- line_p l;
-{
- /* We require a call to a procedure p that has n formal
- * parameters to be followed by an 'asp n' instruction
- * (i.e. the caller should remove the actual parameters).
- */
-
- return (p->p_nrformals == 0 || (l != (line_p) 0 &&INSTR(l) == op_asp &&
- TYPE(l) == OPSHORT && SHORT(l) == p->p_nrformals));
-}
-
-
-
-STATIC inc_count(caller,callee)
- proc_p caller, callee;
-{
- /* Update the call-count information.
- * Record the fact that there is one more call
- * to 'callee', appearing in 'caller'.
- */
-
- calcnt_p cc;
-
- if (!SUITABLE(caller)) return;
- /* if the calling routine is never expanded in line
- * we do not need call-count information.
- */
- for (cc = cchead; cc != (calcnt_p) 0; cc = cc->cc_next) {
- if (cc->cc_proc == callee) {
- cc->cc_count++;
- /* #calls to callee from caller */
- return;
- }
- }
- /* This is the first call from caller to callee.
- * Allocate a new calcnt struct.
- */
- cc = newcalcnt();
- cc->cc_proc = callee;
- cc->cc_count = 1;
- cc->cc_next = cchead; /* insert it at front of list */
- cchead = cc;
-}
-
-
-
-anal_cal(p,call,b,cf)
- proc_p p;
- line_p call;
- bblock_p b;
- FILE *cf;
-{
- /* Analyze a call instruction. If the called
- * routine may be expanded in line, try to
- * recognize the actual parameter expressions of
- * the call and extend the call list.
- */
-
- call_p c;
- line_p lnp;
- proc_p callee;
-
-#ifdef VERBOSE
- Scals++;
-#endif
- calnr++;
- callee = PROC(call);
- if (SUITABLE(callee)) {
- /* The called procedure may be expanded */
- callee->P_NRCALLED++; /* #calls to callee from anywhere */
- INIT_ACTS();
- if (parse(PREV(call),callee->p_nrformals,&lnp,0,make_actual) &&
- chck_asp(callee,call->l_next)) {
- /* succeeded in recognizing the actuals */
- c = newcall();
- c->cl_caller = p;
- c->cl_id = calnr;
- c->cl_proc = callee;
- c->cl_looplevel = (byte) looplevel(b);
- if (c->cl_looplevel > 0 && IS_FIRM(b)) {
- c->cl_flags |= CLF_FIRM;
- }
- c->cl_actuals = acts;
- inc_count(p,callee);
- /* update call-count info */
- putcall(c,cf,(short) 0); /* write the call to the calfile */
- } else {
-#ifdef VERBOSE
- Sparsefails++;
-#endif
- rem_actuals(acts);
- }
- }
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ C A L . C
- */
-
-struct class {
- byte src_class;
- byte res_class;
-};
-
-typedef struct class *class_p;
-
-extern struct class classtab[];
-
-#define NOCLASS 0
-#define CLASS1 1
-#define CLASS2 2
-#define CLASS3 3
-#define CLASS4 4
-#define CLASS5 5
-#define CLASS6 6
-#define CLASS7 7
-#define CLASS8 8
-#define CLASS9 9
-
-
-extern anal_cal(); /* (line_p call, bblock_p b)
- * analyze a call instruction;
- * try to recognize the actual parameter
- * expressions.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ F O R M A L . C
- */
-
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "il1_aux.h"
-#include "il1_formal.h"
-
-#define NOT_USED(f) (!(f->f_flags & USEMASK))
-#define USED_ONCE(f) f->f_flags |= FF_ONCEUSED
-#define USED_OFTEN(f) f->f_flags |= FF_OFTENUSED
-#define BADFORMAL(f) f->f_flags |= FF_BAD
-
-#define OUTSIDE_LOOP(b) (Lnrelems(b->b_loops) == 0)
-#define IS_FORMAL(x) (x >= 0)
-
-
-
-formal_p find_formal(p,type,off)
- proc_p p;
- int type;
- offset off;
-{
- /* Find a formal parameter of p
- * If the formal overlaps with an existing formal
- * or has an unknown type (i.e. its address is used)
- * 0 is returned.
- */
-
- formal_p f,prev,nf;
-
- if (type == UNKNOWN) return (formal_p) 0;
- prev = (formal_p) 0;
- for (f = p->P_FORMALS; f != (formal_p) 0; f = f->f_next) {
- if (f->f_offset >= off) break;
- prev = f;
- }
- if (f != (formal_p) 0 && f->f_offset == off) {
- return (same_size(f->f_type,type) ? f : (formal_p) 0);
- }
- if (f != (formal_p) 0 && par_overlap(off,type,f->f_offset,f->f_type)) {
- return (formal_p) 0;
- }
- if (prev != (formal_p) 0 && par_overlap(prev->f_offset,prev->f_type,
- off,type)) {
- return (formal_p) 0;
- }
- nf = newformal();
- nf->f_type = type;
- nf->f_offset = off;
- if (prev == (formal_p) 0) {
- p->P_FORMALS = nf;
- } else {
- prev->f_next = nf;
- }
- nf->f_next = f;
- return nf;
-}
-
-
-
-STATIC no_inl_pars(p)
- proc_p p;
-{
- /* p may not have any in line parameters */
-
- p->p_flags2 |= PF_NO_INLPARS;
- remov_formals(p);
-}
-
-
-
-STATIC inc_use(f,b)
- formal_p f;
- bblock_p b;
-{
- /* Increment the use count of formal f.
- * The counter has only three states: not used,
- * used once, used more than once.
- * We count the number of times the formal
- * is used dynamically (rather than statically),
- * so if it is used in a loop, the counter
- * is always set to more than once.
- */
-
- if (NOT_USED(f) && OUTSIDE_LOOP(b)) {
- USED_ONCE(f);
- } else {
- USED_OFTEN(f);
- }
-}
-
-
-
-formal(p,b,off,type,usage)
- proc_p p;
- bblock_p b;
- offset off;
- int type,
- usage;
-{
- /* Analyze a reference to a parameter of p
- * (occurring within basic block b).
- * The parameter has offset off. If this
- * offset is less than 0, it is not a
- * parameter, but a local.
- * The type can be SINGLE (1 word), DOUBLE
- * (2 words), POINTER or UNKNOWN.
- */
-
- formal_p f;
-
- if (!IS_FORMAL(off) || !SUITABLE(p) || !INLINE_PARS(p)) return;
- /* We are not interested in formal parameters of
- * proccedures that will never be expanded in line,
- * or whose parameters will not be expanded in line.
- */
- f = find_formal(p,type,off);
- /* Find the formal; if not found, create one;
- * if inconsistent with previous formals (e.g.
- * overlapping formals) then return 0;
- * also fills in its type.
- */
- if (f == (formal_p) 0) {
- no_inl_pars(p);
- /* parameters of p may not be expanded in line */
- } else {
- if (usage == CHANGE) {
- /* don't expand f in line */
- BADFORMAL(f);
- } else {
- inc_use(f,b); /* increment use count */
- }
- }
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 1 _ F O R M A L . C
- */
-
-extern formal(); /* (proc_p p; bblock_p b; offset off;
- * int type, usage)
- * Analyze a reference to a parameter of p.
- * The type denotes its size (single,double,
- * pointer).
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 2 _ A U X . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-#include "il_aux.h"
-#include "il2_aux.h"
-#include "../share/get.h"
-#include "../share/aux.h"
-
-#define CHANGE_INDIR(p) (p->p_change->c_flags & CF_INDIR)
-#define USE_INDIR(p) (p->p_use->u_flags & UF_INDIR)
-
-#define OFTEN_USED(f) ((f->f_flags&FF_OFTENUSED) == FF_OFTENUSED)
-#define CHANGE_EXT(p) (Cnrelems(p->p_change->c_ext) > 0)
-#define NOT_INLINE(a) (a->ac_inl = FALSE)
-#define INLINE(a) (a->ac_inl = TRUE)
-
-
-#define CHANGED(p) p->p_flags2 |= PF_CHANGED
-#define IS_CHANGED(p) (p->p_flags2 & PF_CHANGED)
-
-
-
-STATIC bool match_pars(fm,act)
- formal_p fm;
- actual_p act;
-{
- /* Check if every actual parameter has the same
- * size as its corresponding formal. If not, the
- * actual parameters should not be expanded in line.
- */
-
- while (act != (actual_p) 0) {
- if (fm == (formal_p) 0 || tsize(fm->f_type) != act->ac_size) {
- return FALSE;
- }
- act = act->ac_next;
- fm = fm->f_next;
- }
- return (fm == (formal_p) 0 ? TRUE : FALSE);
-}
-
-
-STATIC bool change_act(p,act)
- proc_p p;
- actual_p act;
-{
- /* See if a call to p migth change any of the
- * operands of the actual parameter expression.
- * If the parameter is to be expanded in line,
- * we must be sure its value does not depend
- * on the point in the program where it is
- * evaluated.
- */
-
- line_p l;
-
- for (l = act->ac_exp; l != (line_p) 0; l = l->l_next) {
- switch(INSTR(l)) {
- case op_lil:
- case op_lof:
- case op_loi:
- case op_los:
- case op_ldf:
- return TRUE;
- /* assume worst case */
- case op_lol:
- case op_ldl:
- if (CHANGE_INDIR(p)) {
- return TRUE;
- }
- break;
- case op_loe:
- case op_lde:
- if (CHANGE_INDIR(p) || CHANGE_EXT(p)) {
- return TRUE;
- }
- break;
- }
- }
- return FALSE;
-}
-
-
-
-STATIC bool is_simple(expr)
- line_p expr;
-{
- /* See if expr is something simple, i.e. a constant or
- * a variable. So the expression must consist of
- * only one instruction.
- */
-
-
- if (expr->l_next == (line_p) 0) {
- switch(INSTR(expr)) {
- case op_loc:
- case op_ldc:
- case op_lol:
- case op_ldl:
- case op_loe:
- case op_lde:
- return TRUE;
- }
- }
- return FALSE;
-}
-
-
-
-STATIC bool too_expensive(fm,act)
- formal_p fm;
- actual_p act;
-{
- /* If the formal parameter is used often and the
- * actual parameter is not something simple
- * (i.e. an expression, not a constant or variable)
- * it may be too expensive too expand the parameter
- * in line.
- */
-
- return (OFTEN_USED(fm) && !is_simple(act->ac_exp));
-}
-anal_params(c)
- call_p c;
-{
- /* Determine which of the actual parameters of a
- * call may be expanded in line.
- */
-
- proc_p p;
- actual_p act;
- formal_p form;
- int inlpars = 0;
-
- p = c->cl_proc; /* the called procedure */
- if (!INLINE_PARS(p) || !match_pars(p->P_FORMALS, c->cl_actuals)) {
- for (act = c->cl_actuals; act != (actual_p) 0;
- act = act->ac_next) {
- NOT_INLINE(act);
- }
- return; /* "# of inline pars." field in cl_flags remains 0 */
- }
- for (act = c->cl_actuals, form = p->P_FORMALS; act != (actual_p) 0;
- act = act->ac_next, form = form->f_next) {
- if (form->f_flags & FF_BAD ||
- change_act(p,act) || too_expensive(form,act)) {
- NOT_INLINE(act);
- } else {
- INLINE(act);
- inlpars++;
- }
- }
- if (inlpars > 15) inlpars = 15; /* We've only got 4 bits! */
- c->cl_flags |= inlpars; /* number of inline parameters */
-}
-
-
-STATIC short space_saved(c)
- call_p c;
-{
- /* When a call gets expanded in line, the total size of the
- * code usually gets incremented, because we have to
- * duplicate the text of the called routine. However, we save
- * ourselves a CAL instruction and possibly anASP instruction
- * (if the called procedure has parameters). Moreover, if we
- * can put some parameters in line, we don't have to push
- * their results on the stack before doing the call, so we
- * save some code here too. The routine estimates the amount of
- * code saved, expressed in number of EM instructions.
- */
-
- return (1 + (c->cl_flags & CLF_INLPARS) + (c->cl_proc->p_nrformals>0));
-}
-
-STATIC short param_score(c)
- call_p c;
-{
- /* If a call has an inline parameter that is a constant,
- * chances are high that other optimization techniques
- * can do further optimizations, especially if the constant
- * happens to be "0". So the call gets extra points for this.
- */
-
- register actual_p act;
- line_p l;
- short score = 0;
-
- for (act = c->cl_actuals; act != (actual_p) 0; act = act->ac_next) {
- if (act->ac_inl) {
- l = act->ac_exp;
- if (l->l_next == (line_p) 0 &&
- (INSTR(l) == op_loc || INSTR(l) == op_ldc)) {
- score += (off_set(l) == (offset) 0 ? 2 : 1);
- /* 0's count for two! */
- }
- }
- }
- return score;
-}
-
-
-
-
-
-assign_ratio(c)
- call_p c;
-{
- /* This routine is one of the most important ones
- * of the inline substitution phase. It assigns a number
- * (a 'ratio') to a call, indicating how desirable
- * it is to expand the call in line.
- * Currently, a very simplified straightforward heuristic
- * is used.
- */
-
- short ll, loopfact, ratio;
-
- ll = c->cl_proc->P_SIZE - space_saved(c);
- if (ll <= 0) ll = 1;
- ratio = 1000 / ll;
- if (ratio == 0) ratio = 1;
- /* Add points if the called procedure falls through
- * it's end (no BRA needed) or has formal parameters
- * (ASP can be deleted).
- */
- if (c->cl_proc->p_flags2 & PF_FALLTHROUGH) {
- ratio += 10;
- }
- if (c->cl_proc->p_nrformals > 0) {
- ratio += 10;
- }
- if (c->cl_caller->p_localbytes == 0) {
- ratio -= 10;
- }
- ratio += (10 *param_score(c));
- /* Extra points for constants as parameters */
- if (ratio <= 0) ratio = 1;
- ll = c->cl_looplevel+1;
- if (ll == 1 && !IS_CALLED_IN_LOOP(c->cl_caller)) ll = 0;
- /* If the call is not in a loop and the called proc. is never called
- * in a loop, ll is set to 0.
- */
- loopfact = (ll > 3 ? 10 : ll*ll);
- ratio *= loopfact;
- if (c->cl_flags & CLF_FIRM) {
- ratio = 2*ratio;
- }
- c->cl_ratio = ratio;
-}
-
-
-call_p abstract(c)
- call_p c;
-{
- /* Abstract information from the call that is essential
- * for choosing the calls that will be expanded.
- * Put the information is an 'abstracted call'.
- */
-
- call_p a;
-
- a = newcall();
- a->cl_caller = c->cl_caller;
- a->cl_id = c->cl_id;
- a->cl_proc = c->cl_proc;
- a->cl_looplevel = c->cl_looplevel;
- a->cl_ratio = c->cl_ratio;
- a->cl_flags = c->cl_flags;
- return a;
-}
-
-
-
-STATIC adjust_counts(callee,ccf)
- proc_p callee;
- FILE *ccf;
-{
- /* A call to callee is expanded in line;
- * the text of callee is not removed, so
- * every proc called by callee gets its
- * P_NRCALLED field incremented.
- */
-
- calcnt_p cc, head;
-
- head = getcc(ccf,callee); /* get calcnt info of called proc */
- for (cc = head; cc != (calcnt_p) 0; cc = cc->cc_next) {
- cc->cc_proc->P_NRCALLED += cc->cc_count;
- }
- remcc(head); /* remove calcnt info */
-}
-
-
-
-STATIC bool is_dispensable(callee,ccf)
- proc_p callee;
- FILE *ccf;
-{
- /* A call to callee is expanded in line.
- * Decrement its P_NRCALLED field and see if
- * it can now be removed because it is no
- * longer called. Procedures that ever have
- * their address taken (via LPI) will never
- * be removed, as they might be called indirectly.
- */
-
- if ((--callee->P_NRCALLED) == 0 &&
- (callee->p_flags1 & PF_LPI) == 0) {
- DISPENSABLE(callee);
- OUTTRACE("procedure %d can be removed",callee->p_id);
-#ifdef VERBOSE
- Spremoved++;
-#endif
- return TRUE;
- } else {
- adjust_counts(callee,ccf);
- return FALSE;
- }
-}
-
-
-
-
-STATIC call_p nested_calls(a)
- call_p a;
-{
- /* Get a list of all calls that will appear in the
- * EM text if the call 'a' is expanded in line.
- * These are the calls in the P_CALS list of the
- * called procedure.
- */
-
- call_p c, cp, head, *cpp;
-
- head = (call_p) 0;
- cpp = &head;
- for (c = a->cl_proc->P_CALS; c != (call_p) 0; c = c->cl_cdr) {
- cp = abstract(c);
- cp->cl_looplevel += a->cl_looplevel;
- cp->cl_flags = (byte) 0;
- if (a->cl_flags & CLF_FIRM) {
- cp->cl_flags |= CLF_FIRM;
- }
- assign_ratio(cp);
- *cpp = cp;
- cpp = &cp->cl_cdr;
- }
- return head;
-}
-
-
-
-
-STATIC call_p find_origin(c)
- call_p c;
-{
- /* c is a nested call. Find the original call.
- * This origional must be in the P_CALS list
- * of the calling procedure.
- */
-
- register call_p x;
-
- for (x = c->cl_caller->P_CALS; x != (call_p) 0; x = x->cl_cdr) {
- if (x->cl_id == c->cl_id) return x;
- }
- assert(FALSE);
- /* NOTREACHED */
-}
-
-
-
-STATIC selected(a)
- call_p a;
-{
- /* The call a is selected for in line expansion.
- * Mark the call as being selected and get the
- * calls nested in it; these will be candidates
- * too now.
- */
-
- SELECTED(a);
- EVER_EXPANDED(find_origin(a));
- a->cl_car = nested_calls(a);
-}
-
-
-
-
-STATIC compare(x,best,space)
- call_p x, *best;
- short space;
-{
- /* See if x is better than the current best choice */
-
- if (x != (call_p) 0 && !IS_CHANGED(x->cl_proc) &&
- x->cl_proc->P_SIZE - space_saved(x) <= space) {
- if ((*best == (call_p) 0 && x->cl_ratio != 0) ||
- (*best != (call_p) 0 && x->cl_ratio > (*best)->cl_ratio )) {
- *best = x;
- }
- }
-}
-
-
-
-
-STATIC call_p best_one(list,space)
- call_p list;
- short space;
-{
- /* Find the best candidate of the list
- * that has not already been selected. The
- * candidate must fit in the given space.
- * We look in the cdr as well as in the car
- * direction.
- */
-
- call_p best = (call_p) 0;
- call_p x,c;
-
- for (c = list; c != (call_p) 0; c = c->cl_cdr) {
- if (IS_SELECTED(c)) {
- compare(best_one(c->cl_car,space),&best,space);
- } else {
- compare(c,&best,space);
- }
- }
- return best;
-}
-
-
-
-STATIC singles(cals)
- call_p cals;
-{
- /* If a procedure is only called once, this call
- * will be expanded in line, because it costs
- * no extra space.
- */
-
- call_p c;
-
- for (c = cals; c != (call_p) 0; c = c->cl_cdr) {
- if (IS_SELECTED(c)) {
- singles(c->cl_car);
- } else {
- if (c->cl_proc->P_NRCALLED == 1 &&
- !IS_CHANGED(c->cl_proc) &&
- (c->cl_proc->p_flags1 & PF_LPI) == 0) {
- c->cl_proc->P_NRCALLED = 0;
- SELECTED(c);
- EVER_EXPANDED(find_origin(c));
- DISPENSABLE(c->cl_proc);
- CHANGED(c->cl_caller);
- OUTTRACE("procedure %d can be removed",
- c->cl_proc->p_id);
-#ifdef VERBOSE
- Spremoved++;
-#endif
- }
- }
- }
-}
-
-
-
-STATIC single_calls(proclist)
- proc_p proclist;
-{
- proc_p p;
-
- for (p = proclist; p != (proc_p) 0; p = p->p_next) {
- if (!BIG_CALLER(p) && !IS_DISPENSABLE(p)) {
- /* Calls appearing in a large procedure or in
- * a procedure that was already eliminated
- * are not considered.
- */
- singles(p->P_CALS);
- }
- }
-}
-
-
-
-
-select_calls(proclist,ccf,space)
- proc_p proclist;
- FILE *ccf;
- short space ;
-{
- /* Select all calls that are to be expanded in line. */
-
- proc_p p,chp;
- call_p best, x;
-
- for (;;) {
- best = (call_p) 0;
- chp = (proc_p) 0; /* the changed procedure */
- for (p = proclist; p != (proc_p) 0; p = p->p_next) {
- if (!BIG_CALLER(p) && !IS_DISPENSABLE(p)) {
- /* Calls appearing in a large procedure or in
- * a procedure that was already eliminated
- * are not considered.
- */
- x = best_one(p->P_CALS,space);
- compare(x,&best,space);
- if (x == best) chp = p;
- }
- }
- if (best == (call_p) 0) break;
- if (!is_dispensable(best->cl_proc,ccf)) {
- space -= (best->cl_proc->P_SIZE - space_saved(best));
- }
- selected(best);
- CHANGED(chp);
- }
- single_calls(proclist);
-#ifdef VERBOSE
- Sstat(proclist,space);
-#endif
-}
-
-
-
-
-STATIC nonnested_calls(cfile)
- FILE *cfile;
-{
- register call_p c,a;
-
- while((c = getcall(cfile)) != (call_p) 0) {
- /* find the call in the call list of the caller */
- for (a = c->cl_caller->P_CALS;
- a != (call_p) 0 && c->cl_id != a->cl_id; a = a->cl_cdr);
- assert(a != (call_p) 0 && a->cl_proc == c->cl_proc);
- if (IS_EVER_EXPANDED(a)) {
- a->cl_actuals = c->cl_actuals;
- c->cl_actuals = (actual_p) 0;
- }
- rem_call(c);
- }
-}
-
-
-
-STATIC copy_pars(src,dest)
- call_p src, dest;
-{
- /* Copy the actual parameters of src to dest. */
-
- actual_p as,ad, *app;
-
- app = &dest->cl_actuals;
- for (as = src->cl_actuals; as != (actual_p) 0; as = as->ac_next) {
- ad = newactual();
- ad->ac_exp = copy_expr(as->ac_exp);
- ad->ac_size = as->ac_size;
- ad->ac_inl = as->ac_inl;
- *app = ad;
- app = &ad->ac_next;
- }
-}
-
-
-
-STATIC nest_pars(cals)
- call_p cals;
-{
- /* Recursive auxiliary procedure of add_actuals. */
-
- call_p c,org;
-
- for (c = cals; c != (call_p) 0; c = c->cl_cdr) {
- if (IS_SELECTED(c)) {
- org = find_origin(c);
- copy_pars(org,c);
- nest_pars(c->cl_car);
- }
- }
-}
-
-
-
-add_actuals(proclist,cfile)
- proc_p proclist;
- FILE *cfile;
-{
- /* Fetch the actual parameters of all selected calls.
- * For all non-nested calls (i.e. those calls that
- * appeared originally in the EM text), we get the
- * parameters from the cal-file.
- * For nested calls (i.e. calls
- * that are a result of in line substitution) we
- * get the parameters from the original call.
- */
-
- proc_p p;
- call_p a;
-
- nonnested_calls(cfile);
- for (p = proclist; p != (proc_p) 0; p = p->p_next) {
- for (a = p->P_CALS; a != (call_p) 0; a = a->cl_cdr) {
- nest_pars(a->cl_car);
- }
- }
-}
-
-
-
-STATIC clean(cals)
- call_p *cals;
-{
- call_p c,next,*cpp;
-
- /* Recursive auxiliary routine of cleancals */
-
- cpp = cals;
- for (c = *cpp; c != (call_p) 0; c = next) {
- next = c->cl_cdr;
- if (IS_SELECTED(c)) {
- clean(&c->cl_car);
- cpp = &c->cl_cdr;
- } else {
- assert(c->cl_car == (call_p) 0);
- oldcall(c);
- *cpp = next;
- }
- }
-}
-
-
-cleancals(proclist)
- proc_p proclist;
-{
- /* Remove all calls in the P_CALS list of p
- * that were not selected for in line expansion.
- */
-
- register proc_p p;
-
- for (p = proclist; p != (proc_p) 0; p = p->p_next) {
- clean(&p->P_CALS);
- }
-}
-
-
-
-
-append_abstract(a,p)
- call_p a;
- proc_p p;
-{
- /* Append an abstract of a call-descriptor to
- * the call-list of procedure p.
- */
-
- call_p c;
-
- if (p->P_CALS == (call_p) 0) {
- p->P_CALS = a;
- } else {
- for (c = p->P_CALS; c->cl_cdr != (call_p) 0; c = c->cl_cdr);
- c->cl_cdr = a;
- }
-}
-
-
-#ifdef VERBOSE
-
-/* At the end, we traverse the entire call-list, to see why the
- * remaining calls were not expanded inline.
- */
-
-
-Sstatist(list,space)
- call_p list;
- short space;
-{
- call_p c;
-
- for (c = list; c != (call_p) 0; c = c->cl_cdr) {
- if (IS_SELECTED(c)) {
- Sstatist(c->cl_car,space);
- } else {
- if (IS_CHANGED(c->cl_proc)) Schangedcallee++;
- else if (BIG_PROC(c->cl_proc)) Sbigcallee++;
- else if (c->cl_proc->P_SIZE > space) Sspace++;
- else if (c->cl_ratio == 0) Szeroratio++;
- else assert(FALSE);
- }
- }
-}
-
-Sstat(proclist,space)
- proc_p proclist;
- short space;
-{
- proc_p p;
-
- for (p = proclist; p != (proc_p) 0; p = p->p_next) {
- if (BIG_CALLER(p)) Sbig_caller++;
- else if (IS_DISPENSABLE(p)) Sdispensable++;
- else Sstatist(p->P_CALS,space);
- }
-}
-#endif
+++ /dev/null
-extern anal_params(); /* (call_p c)
- * See which parameters of the call
- * may be expanded in line.
- */
-extern assign_ratio(); /* (call_p c)
- * Assigna ratio number to the call,
- * indicating how desirable it is to
- * expand the call in line.
- */
-extern call_p abstract(); /* (call_p c)
- * Abstract essential information from
- * the call.
- */
-extern select_calls(); /* (call_p alist; FILE *ccf;short space)
- * Select the best calls to be expanded.
- * Every procedure gets a list of
- * selected calls appearing in it.
- * space is the amount of space that the
- * program is allowed to grow
- * (expressed in number of EM instructions).
- */
-extern cleancals(); /* (proc_p plist)
- * Remove all calls that were not selected.
- */
-extern add_actuals(); /* (proc_p plist; FILE *cfile)
- * Add the actual parameters to the descriptor abstracts
- * of the selected calls.
- * the calfile contains the full descriptors of all
- * calls.
- * These two are combined to yield a file of full
- * descriptors of the selected calls.
- */
-extern append_abstract(); /* (call_p a; proc_p p)
- * Put the call-descriptor abstract in the p_cals
- * list of p.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ A U X . C
- */
-
-
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "il_aux.h"
-#include "il3_aux.h"
-
-
-
-line_p last_line(lines)
- line_p lines;
-{
- /* Determine the last line of a list */
-
- register line_p l;
-
- assert (l != (line_p) 0);
- for (l = lines; l->l_next != (line_p) 0; l = l->l_next);
- return l;
-}
-
-
-
-app_list(list,l)
- line_p list,l;
-{
- /* Append the list after line l */
-
- line_p llast;
-
- assert(l != (line_p) 0);
- assert (list != (line_p) 0);
- llast = last_line(list);
- llast->l_next = l->l_next;
- if (l->l_next != (line_p) 0) {
- PREV(l->l_next) = llast;
- }
- l->l_next = list;
- PREV(list) = l;
-}
-
-
-
-rem_line(l)
- line_p l;
-{
- /* Remove a line from the list */
-
- if (PREV(l) != (line_p) 0) {
- PREV(l)->l_next = l->l_next;
- }
- if (l->l_next != (line_p) 0) {
- PREV(l->l_next) = PREV(l);
- }
- oldline(l);
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ A U X . H
- */
-
-extern line_p last_line(); /* (line_p list)
- * Find the last line of a list.
- */
-extern app_list(); /* (line_p list,l)
- * Put list after l
- */
-extern rem_line(); /* (line_p l)
- * Remove a line from a (doubly linked)
- * list.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ C H A N G E . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/def.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mes.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "il_aux.h"
-#include "il3_change.h"
-#include "il3_aux.h"
-
-/* chg_callseq */
-
-
-
-
-STATIC line_p par_expr(l,expr)
- line_p l, expr;
-{
- /* Find the first line of the expression of which
- * l is the last line; expr contains a pointer
- * to a copy of that expression; effectively we
- * just have to tally lines.
- */
-
- line_p lnp;
-
- for (lnp = expr->l_next; lnp != (line_p) 0; lnp = lnp->l_next) {
- assert(l != (line_p) 0);
- l = PREV(l);
- }
- return l;
-}
-
-
-
-STATIC rem_text(l1,l2)
- line_p l1,l2;
-{
- /* Remove the lines from l1 to l2 (inclusive) */
-
- line_p l, lstop;
- l = PREV(l1);
- lstop = l2->l_next;
- while (l->l_next != lstop) {
- rem_line(l->l_next);
- }
-}
-
-
-
-STATIC store_tmp(p,l,size)
- proc_p p;
- line_p l;
- offset size;
-{
- /* Emit code to store a 'size'-byte value in a new
- * temporary local variable in the stack frame of p.
- * Put this code after line l.
- */
-
- line_p lnp;
-
- lnp = int_line(tmplocal(p,size)); /* line with operand temp. */
- if (size == ws) {
- lnp->l_instr = op_stl; /* STL temp. */
- } else {
- if (size == 2*ws) {
- lnp->l_instr = op_sdl; /* SDL temp. */
- } else {
- /* emit 'LAL temp; STI size' */
- lnp->l_instr = op_lal;
- appnd_line(lnp,l);
- l = lnp;
- assert ((short) size == size);
- lnp = newline(OPSHORT);
- SHORT(lnp) = size;
- lnp->l_instr = op_sti;
- }
- }
- appnd_line(lnp,l);
-}
-
-
-
-STATIC chg_actuals(c,cal)
- call_p c;
- line_p cal;
-{
- /* Change the actual parameter expressions of the call. */
-
- actual_p act;
- line_p llast,lfirst,l;
-
- llast = PREV(cal);
- for (act = c->cl_actuals; act != (actual_p) 0; act = act->ac_next) {
- lfirst = par_expr(llast,act->ac_exp);
- /* the code from lfirst to llast is a parameter expression */
- if (act->ac_inl) {
- /* in line parameter; remove it */
- l = llast;
- llast = PREV(lfirst);
- rem_text(lfirst,l);
- } else {
- store_tmp(curproc,llast,act->ac_size);
- /* put a "STL tmp" -like instruction after the code */
- llast = PREV(lfirst);
- }
- }
-}
-
-
-
-STATIC rm_callpart(c,cal)
- call_p c;
- line_p cal;
-{
- /* Remove the call part, consisting of a CAL,
- * an optional ASP and an optional LFR.
- */
-
- line_p l;
-
- l= PREV(cal);
- rem_line(cal);
- if (c->cl_proc->p_nrformals > 0) {
- /* called procedure has parameters */
- assert (INSTR(l->l_next) == op_asp);
- rem_line(l->l_next);
- }
- if (INSTR(l->l_next) == op_lfr) {
- rem_line(l->l_next);
- }
-}
-
-
-
-chg_callseq(c,cal,l_out)
- call_p c;
- line_p cal,*l_out;
-{
- /* Change the calling sequence. The actual parameter
- * expressions are changed (in line parameters are
- * removed, all other ones now store their result
- * in a temporary local of the caller);
- * the sequence "CAL ; ASP ; LFR" is removed.
- */
-
-
- chg_actuals(c,cal);
- *l_out = PREV(cal); /* last instr. of new parameter part */
- rm_callpart(c,cal);
-}
-
-
-/* make_label */
-
-line_p make_label(l,p)
- line_p l;
- proc_p p;
-{
- /* Make sure that the instruction after l
- * contains an instruction label. If this is
- * not already the case, create a new label.
- */
-
- line_p lab;
-
- if (l->l_next != (line_p) 0 && INSTR(l->l_next) == op_lab) {
- return l->l_next;
- }
- lab = newline(OPINSTRLAB);
- lab->l_instr = op_lab;
- p->p_nrlabels++;
- INSTRLAB(lab) = p->p_nrlabels;
- appnd_line(lab,l);
- return lab;
-}
-
-
-
-/* modify */
-
-STATIC act_info(off,acts,ab_off,act_out,off_out)
- offset off, ab_off, *off_out;
- actual_p acts, *act_out;
-{
- /* Find the actual parameter that corresponds to
- * the formal parameter with the given offset.
- * Return it via act_out. If the actual is not
- * an in-line actual, determine which temporary
- * local is used for it; return the offset of that
- * local via off_out.
- */
-
- offset sum = 0, tmp = 0;
- actual_p act;
-
- for (act = acts; act != (actual_p) 0; act = act->ac_next) {
- if (!act->ac_inl) {
- tmp -= act->ac_size;
- }
- if (sum >= off) {
- /* found */
- *act_out = act;
- if (!act->ac_inl) {
- *off_out = tmp + sum - off + ab_off;
- } else {
- assert (sum == off);
- }
- return;
- }
- sum += act->ac_size;
- }
- assert(FALSE);
-}
-
-
-
-STATIC store_off(off,l)
- offset off;
- line_p l;
-{
- if (TYPE(l) == OPSHORT) {
- assert ((short) off == off);
- SHORT(l) = (short) off;
- } else {
- OFFSET(l) = off;
- }
-}
-
-
-
-STATIC inl_actual(l,expr)
- line_p l, expr;
-{
- /* Expand an actual parameter in line.
- * A LOL or LDL instruction is replaced
- * by an expression.
- * A SIL or LIL is replaced by the expression
- * followed by a STI or LOI.
- */
-
- line_p e, lnp, s;
- short instr;
-
- instr = INSTR(l);
- assert(expr != (line_p) 0);
- e = copy_expr(expr); /* make a copy of expr. */
- if (instr == op_sil || instr == op_lil) {
- s = int_line((offset) ws);
- s->l_instr = (instr == op_sil ? op_sti : op_loi);
- appnd_line(s,last_line(e));
- } else {
- assert(instr == op_lol || instr == op_ldl);
- }
- lnp = PREV(l);
- rem_line(l);
- app_list(e,lnp);
-}
-
-
-
-STATIC localref(l,c,ab_off,lb_off)
- line_p l;
- call_p c;
- offset ab_off, lb_off;
-{
- /* Change a reference to a local variable or parameter
- * of the called procedure.
- */
-
- offset off, tmpoff;
- actual_p act;
-
- off = off_set(l);
- if (off < 0) {
- /* local variable, only the offset changes */
- store_off(lb_off + off,l);
- } else {
- act_info(off,c->cl_actuals,ab_off,&act,&tmpoff); /* find actual */
- if (act->ac_inl) {
- /* inline actual parameter */
- inl_actual(l,act->ac_exp);
- } else {
- /* parameter stored in temporary local */
- store_off(tmpoff,l);
- }
- }
-}
-
-
-
-STATIC chg_mes(l,c,ab_off,lb_off)
- line_p l;
- call_p c;
- offset ab_off, lb_off;
-{
- /* The register messages of the called procedure
- * must be changed. If the message applies to a
- * local variable or to a parameter that is not
- * expanded in line, the offset of the variable
- * is changed; else the entire message is deleted.
- */
-
- offset off, tmpoff;
- actual_p act;
- arg_p arg;
-
- arg = ARG(l);
- switch ((int) arg->a_a.a_offset) {
- case ms_reg:
- if ((arg = arg->a_next) != (arg_p) 0) {
- /* "mes 3" without further argument is not changed */
- off = arg->a_a.a_offset;
- if (off < 0) {
- /* local variable */
- arg->a_a.a_offset += lb_off;
- } else {
- act_info(off,c->cl_actuals,ab_off,&act,&tmpoff);
- if (act->ac_inl) {
- /* in line actual */
- rem_line(l);
- } else {
- arg->a_a.a_offset = tmpoff;
- }
- }
- }
- break;
- case ms_par:
- rem_line(l);
- break;
- }
-}
-
-
-
-STATIC chg_ret(l,c,lab)
- line_p l,lab;
- call_p c;
-{
- /* Change the RET instruction appearing in the
- * expanded text of a call. If the called procedure
- * falls through, the RET is just deleted; else it
- * is replaced by a branch.
- */
-
- line_p lnp, bra;
-
- lnp = PREV(l);
- rem_line(l);
- if (!FALLTHROUGH(c->cl_proc)) {
- bra = newline(OPINSTRLAB);
- bra->l_instr = op_bra;
- INSTRLAB(bra) = INSTRLAB(lab);
- appnd_line(bra,lnp);
- }
-}
-
-
-
-STATIC mod_instr(l,c,lab,ab_off,lb_off,lab_off)
- line_p l,lab;
- call_p c;
- offset ab_off,lb_off;
- int lab_off;
-{
- if (TYPE(l) == OPINSTRLAB) {
- INSTRLAB(l) += lab_off;
- } else {
- switch(INSTR(l)) {
- case op_stl:
- case op_inl:
- case op_del:
- case op_zrl:
- case op_sdl:
- case op_lol:
- case op_ldl:
- case op_sil:
- case op_lil:
- case op_lal:
- localref(l,c,ab_off,lb_off);
- break;
- case op_ret:
- chg_ret(l,c,lab);
- break;
- case ps_pro:
- case ps_end:
- case ps_sym:
- case ps_hol:
- case ps_bss:
- case ps_con:
- case ps_rom:
- rem_line(l);
- break;
- case ps_mes:
- chg_mes(l,c,ab_off,lb_off);
- break;
- }
- }
-}
-
-
-modify(text,c,lab,ab_off,lb_off,lab_off)
- line_p text,lab;
- call_p c;
- offset ab_off,lb_off;
- int lab_off;
-{
- /* Modify the EM text of the called procedure.
- * References to locals and parameters are
- * changed; RETs are either deleted or replaced
- * by a BRA to the given label; PRO and END pseudos
- * are removed; instruction labels are changed, in
- * order to make them different from any label used
- * by the caller; some messages need to be changed too.
- * Note that the first line of the text is a dummy instruction.
- */
-
- register line_p l;
- line_p next;
-
- for (l = text->l_next; l != (line_p) 0; l = next) {
- next = l->l_next;
- /* This is rather tricky. An instruction like
- * LOL 2 may be replaced by a number of instructions
- * (if the parameter is expanded in line). This inserted
- * code, however, should not be modified!
- */
- mod_instr(l,c,lab,ab_off,lb_off,lab_off);
- }
-}
-
-
-
-mod_actuals(nc,c,lab,ab_off,lb_off,lab_off)
- call_p nc,c;
- line_p lab;
- offset ab_off,lb_off;
- int lab_off;
-{
- actual_p act;
- line_p l, next, dum;
-
- dum = newline(OPNO);
- PREV(dum) = (line_p) 0;
- for (act = nc->cl_actuals; act != (actual_p) 0; act = act->ac_next) {
- l = act->ac_exp;
- assert(l != (line_p) 0);
- /* Insert a dummy instruction before l */
- dum->l_next = l;
- PREV(l) = dum;
- while(l != (line_p) 0) {
- next = l->l_next;
- mod_instr(l,c,lab,ab_off,lb_off,lab_off);
- l = next;
- }
- act->ac_exp = dum->l_next;
- PREV(dum->l_next) = (line_p) 0;
- }
- oldline(dum);
-}
-
-
-
-/* insert */
-
-STATIC line_p first_nonpseudo(l)
- line_p l;
-{
- /* Find the first non-pseudo instruction of
- * a list of instructions.
- */
-
- while (l != (line_p) 0 && INSTR(l) >= sp_fpseu &&
- INSTR(l) <= ps_last) l = l->l_next;
- return l;
-}
-
-
-
-insert(text,l,firstline)
- line_p text,l,firstline;
-{
- /* Insert the modified EM text of the called
- * routine in the calling routine. Pseudos are
- * put after the pseudos of the caller; all
- * normal instructions are put at the place
- * where the CAL originally was.
- */
-
- line_p l1,l2,lastpseu;
-
- l1 = text->l_next;
- oldline(text); /* remove dummy head instruction */
- if (l1 == (line_p) 0) return; /* no text at all! */
- l2 = first_nonpseudo(l1);
- if (l2 == (line_p) 0) {
- /* modified code consists only of pseudos */
- app_list(l1,PREV(first_nonpseudo(firstline)));
- } else {
- if (l1 == l2) {
- /* no pseudos */
- app_list(l2,l);
- } else {
- lastpseu = PREV(first_nonpseudo(firstline));
- PREV(l2)->l_next = (line_p) 0; /* cut link */
- app_list(l2,l); /* insert normal instructions */
- app_list(l1,lastpseu);
- }
- }
-}
-
-
-
-liquidate(p,text)
- proc_p p;
- line_p text;
-{
- /* All calls to procedure p were expanded in line, so
- * p is no longer needed. However, we must not throw away
- * any data declarations appearing in p.
- * The proctable entry of p is not removed, as we do not
- * want to create holes in this table; however the PF_BODYSEEN
- * flag is cleared, so p gets the same status as a procedure
- * whose body is unmkown.
- */
-
- line_p l, nextl, lastkept = (line_p) 0;
- call_p c, nextc;
-
- for (l = text; l != (line_p) 0; l = nextl) {
- nextl = l->l_next;
- switch(INSTR(l)) {
- case ps_sym:
- case ps_hol:
- case ps_bss:
- case ps_con:
- case ps_rom:
- lastkept = l;
- break;
- default:
- rem_line(l);
- }
- }
- if (lastkept != (line_p) 0) {
- /* There were some data declarations in p,
- * so we'll turn p into a data-unit; we'll
- * have to append an end-pseudo for this
- * purpose.
- */
- lastkept->l_next = newline(OPNO);
- lastkept->l_next->l_instr = (byte) ps_end;
- }
- /* There may be some calls in the body of p that
- * ought to be expanded in line. As p is removed
- * anyway, there is no use in really performing
- * these substitutions, so the call-descriptors
- * are just thrown away.
- */
-
- for (c = p->P_CALS; c != (call_p) 0; c = nextc) {
- nextc = c->cl_cdr;
- rem_call(c);
- }
- /* change the proctable entry */
- p->p_flags1 &= (byte) ~PF_BODYSEEN;
- oldchange(p->p_change);
- olduse(p->p_use);
-}
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ C H A N G E . C
- */
-
-
-extern chg_callseq(); /* (call_p c; line_p cal, *l_out)
- * Change the calling sequence of
- * the call c. The parameters are
- * changed and the sequence
- * CAL - ASP - LFR is removed.
- * cal points to the CAL instruction
- * l_out indicates where the expanded
- * text of the called routine must
- * be put.
- */
-extern line_p make_label(); /* (line_p l; proc_p p)
- * Make sure that the instruction after
- * l contains a label. If this is not
- * already the case, create a new label.
- */
-extern modify(); /* (line_p text; call_p c; line_p lab;
- * offset ab_off, lb_off; int lab_off)
- * Modify the EM text of the called
- * procedure.
- */
-extern mod_actuals(); /* (call_p nc,c; line_p lab;
- * offset ab_off, lb_off; int lab_off)
- * Modify the actual parameters of the
- * call nc the same way as the text of
- * call c would be modified.
- */
-extern insert(); /* (line_p text,l,firstline)
- * Insert the modified EM text.
- * Pseudos are put after the pseudos
- * of the caller.
- */
-extern liquidate(); /* (proc_p p; line_p text)
- * All calls to p were expanded in line,
- * so p is no longer needed.
- */
+++ /dev/null
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ S U B S T . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/get.h"
-#include "../../../h/em_mnem.h"
-#include "il_aux.h"
-#include "il3_aux.h"
-#include "il3_change.h"
-#include "il3_subst.h"
-
-STATIC line_p fetch_text(lf,c)
- FILE *lf;
- call_p c;
-{
- /* Read the EM text of the called procedure.
- * We use random access I/O here.
- */
-
- line_p l;
- proc_p p;
- lset savmes;
-
- savmes = mesregs;
- mesregs = Lempty_set();
- fseek(lf,c->cl_proc->P_LADDR,0);
- l = get_text(lf,&p);
- assert (p == c->cl_proc);
- Ldeleteset(mesregs);
- mesregs = savmes;
- return l;
-}
-
-
-
-
-line_p scan_to_cal(lines,n)
- line_p lines;
- short n;
-{
- /* Find the n-th CAL instruction */
-
- register line_p l;
-
- for (l = lines; l != (line_p) 0; l = l->l_next) {
- if (INSTR(l) == op_cal) {
- if (--n == 0) return l;
- }
- }
- return (line_p) 0; /* CAL not found */
-}
-
-
-
-substitute(lf,c,cal,firstline)
- FILE *lf;
- call_p c;
- line_p cal,firstline;
-{
- /* Perform in line substitution of the call described
- * by c. The EM text of the called routine is fetched
- * and modified, the calling sequence is changed,
- * the modified routine is put at the place of the call
- * and all global information (proctable etc.) is kept
- * up to date.
- */
-
- line_p l, text, lab;
- offset ab_off, lb_off;
- line_p startscan, ncal;
- short lastcid;
- call_p nc;
-
- Ssubst++;
- ab_off = - curproc->p_localbytes;
- /* offset of temporaries for parameters
- * that are not expanded in line.
- */
- chg_callseq(c,cal,&l);
- /* Change the calling sequence; l points to the place
- * where the expanded text must be put
- */
- text = fetch_text(lf,c); /* fetch EM text of called routine */
- lb_off = - curproc->p_localbytes;
- /* offset of temps. for locals of called proc. */
- curproc->p_localbytes += c->cl_proc->P_ORGLOCALS;
- /* locals of called routine are put in stack frame of caller */
- if (!FALLTHROUGH(c->cl_proc)) {
- /* The called proc contains one or more RETurns
- * somewhere in the middle of its text; these
- * should be changed into a jump to the end
- * of the text. We create a label for this
- * purpose (if there was no one already).
- */
- lab = make_label(l,curproc);
- }
- modify(text,c,lab,ab_off,lb_off,curproc->p_nrlabels);
- curproc->p_nrlabels += c->cl_proc->P_ORGLABELS;
- insert(text,l,firstline);
- /* insert text; instructions are put after l, pseudos
- * are put at beginning of caller.
- */
- /* Now take care of the nested calls */
- startscan = l->l_next;
- lastcid = 0;
- for (nc = c->cl_car; nc != (call_p) 0; nc = nc->cl_cdr) {
- mod_actuals(nc,c,lab,ab_off,lb_off,curproc->p_nrlabels);
- ncal = scan_to_cal(startscan,nc->cl_id - lastcid);
- assert(ncal != (line_p) 0);
- startscan = scan_to_cal(ncal->l_next,1);
- lastcid = nc->cl_id;
- substitute(lf,nc,ncal,firstline);
- }
-}
+++ /dev/null
-
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L 3 _ S U B S T . H
- */
-
-extern line_p scan_to_cal(); /* (line_p lines; short n)
- * Find the n-th cal instruction.
- */
-extern substitute(); /* (FILE *lf;call_p c; line_ pcal,firstline)
- * Perform in line substitution of the call described
- * by c. The EM text of the called routine is fetched
- * and modified, the calling sequence is changed,
- * the modified routine is put at the place of the call
- * and all global information (proctable etc.) is kept
- * up to date.
- */
+++ /dev/null
-
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L _ A U X . C
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "il.h"
-#include "../share/debug.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "il_aux.h"
-
-
-int tsize(type)
- int type;
-{
- /* Determine the size of a variable of the
- * given type.
- */
-
- switch(type) {
- case SINGLE: return ws;
- case DOUBLE: return 2*ws;
- case POINTER: return ps;
- default: assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-
-line_p duplicate(lnp)
- line_p lnp;
-{
- /* Make a duplicate of an EM instruction.
- * Pseudos may not be passed as argument.
- */
-
- line_p l;
-
- l = newline(TYPE(lnp));
- l->l_instr = INSTR(lnp);
- switch(TYPE(l)) {
- case OPNO:
- break;
- case OPSHORT:
- SHORT(l) = SHORT(lnp);
- break;
- case OPOFFSET:
- OFFSET(l) = OFFSET(lnp);
- break;
- case OPINSTRLAB:
- INSTRLAB(l) = INSTRLAB(lnp);
- break;
- case OPOBJECT:
- OBJ(l) = OBJ(lnp);
- break;
- case OPPROC:
- PROC(l) = PROC(lnp);
- break;
- default:
- assert(FALSE); /* cannot copy pseudo */
- }
- return l;
-}
-
-
-
-
-line_p copy_expr(l1)
- line_p l1;
-{
- /* copy the expression */
-
- line_p head, tail, l, lnp;
-
- head = (line_p) 0;
- for (lnp = l1; lnp != (line_p) 0; lnp = lnp->l_next) {
- l = duplicate(lnp);
- if (head == (line_p) 0) {
- head = tail = l;
- PREV(l) = (line_p) 0;
- } else {
- tail->l_next = l;
- PREV(l) = tail;
- tail = l;
- }
- }
- return head;
-}
-
-
-
-rem_call(c)
- call_p c;
-{
- actual_p act, nexta;
- call_p nc,nextc;
- line_p l, nextl;
-
- for (act = c->cl_actuals; act != (actual_p) 0; act = nexta) {
- nexta = act->ac_next;
- for (l = act->ac_exp; l != (line_p) 0; l = nextl) {
- nextl = l->l_next;
- oldline(l);
- }
- oldactual(act);
- }
- nc = c->cl_car;
- oldcall(c);
- for (; nc != (call_p) 0; nc = nextc) {
- /* Take care of nested calls */
- nextc = nc->cl_cdr;
- rem_call(nc);
- }
-}
-
-
-
-/* rem_graph */
-
-STATIC short remlines(l)
- line_p l;
-{
-
- register line_p lnp;
- line_p next;
-
- for (lnp = l; lnp != (line_p) 0; lnp = next) {
- next = lnp->l_next;
- oldline(lnp);
- }
-}
-
-
-
-remunit(kind,p,l)
- short kind;
- proc_p p;
- line_p l;
-{
- register bblock_p b;
- bblock_p next;
- Lindex pi;
- loop_p lp;
-
- if (kind == LDATA) {
- remlines(l);
- return;
- }
- for (b = p->p_start; b != (bblock_p) 0; b = next) {
- next = b->b_next;
- remlines(b->b_start);
- Ldeleteset(b->b_loops);
- Ldeleteset(b->b_succ);
- Ldeleteset(b->b_pred);
- oldbblock(b);
- }
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- oldloop(Lelem(pi));
- }
- Ldeleteset(p->p_loops);
- oldmap(lmap,llength);
- oldmap(lbmap,llength);
- oldmap(bmap,blength);
- oldmap(lpmap,lplength);
-}
-remcc(head)
- calcnt_p head;
-{
- calcnt_p cc, next;
-
- for (cc = head; cc != (calcnt_p) 0; cc = next) {
- next = cc->cc_next;
- oldcalcnt(cc);
- }
-}
-
-
-/* Extra I/O routines */
-
-call_p getcall(cf)
- FILE *cf;
-{
- /* read a call from the call-file */
-
- call_p c;
- proc_p voided;
- actual_p act,*app;
- short n,m;
-
- curinp = cf;
- c = newcall();
- n = getshort(); /* void nesting level */
- if (feof(curinp)) return (call_p) 0;
- c->cl_caller = pmap[getshort()];
- c->cl_id = getshort();
- c->cl_proc = pmap[getshort()];
- c->cl_looplevel = getbyte();
- c->cl_flags = getbyte();
- c->cl_ratio = getshort();
- app = &c->cl_actuals;
- n = getshort();
- while(n--) {
- act = newactual();
- m = getshort();
- act->ac_size = getoff();
- act->ac_inl = getbyte();
- act->ac_exp = getlines(cf,m,&voided);
- *app = act;
- app = &act->ac_next;
- }
- *app = (actual_p) 0;
- return c;
-}
-
-
-
-line_p get_text(lf,p_out)
- FILE *lf;
- proc_p *p_out;
-{
- /* Read the EM text of one unit
- * If it is a procedure, set p_out to
- * the proc. just read. Else set p_out
- * to 0.
- */
-
- line_p dumhead, l, lprev;
- loop_p *oldlpmap = lpmap;
- line_p *oldlmap = lmap;
- short oldllength = llength;
- short oldlastlabid = lastlabid;
-
- curinp = lf;
- *p_out = (proc_p) 0;
- dumhead = newline(OPNO);
- /* The list of instructions is preceeded by a dummy
- * line, to simplify list manipulation
- */
- dumhead->l_instr = op_nop; /* just for fun */
- lprev = dumhead;
- for (;;) {
- l = read_line(p_out);
- if (feof(curinp)) return (line_p) 0;
- lprev->l_next = l;
- PREV(l) = lprev;
- if (INSTR(l) == ps_end) break;
- if (INSTR(l) == ps_mes) {
- message(l);
- }
- lprev = l;
- }
- /* The tables that map labels to instructions
- * and labels to basic blocks are not used.
- */
- if (*p_out != (proc_p) 0) {
- oldmap(lmap,llength);
- oldmap(lbmap,llength);
- lmap = oldlmap;
- lpmap = oldlpmap;
- }
- llength = oldllength;
- lastlabid = oldlastlabid;
- return dumhead;
-}
-
-
-
-calcnt_p getcc(ccf,p)
- FILE *ccf;
- proc_p p;
-{
- /* Get call-count info of procedure p */
-
- calcnt_p head,cc,*ccp;
- short i;
-
- fseek(ccf,p->p_extend->px_il.p_ccaddr,0);
- curinp = ccf;
- head = (calcnt_p) 0;
- ccp = &head;
- for (i = getshort(); i != (short) 0; i--) {
- cc = *ccp = newcalcnt();
- cc->cc_proc = pmap[getshort()];
- cc->cc_count = getshort();
- ccp = &cc->cc_next;
- }
- return head;
-}
-
-
-/* The following routines are only used by the Inline Substitution phase */
-
-
-STATIC putactuals(alist,cfile)
- actual_p alist;
- FILE *cfile;
-{
- /* output a list of actual parameters */
-
- actual_p a,next;
- line_p l;
- int count;
-
- count = 0;
- for (a = alist; a != (actual_p) 0; a = a->ac_next) count++;
- outshort(count); /* number of actuals */
- for (a = alist; a != (actual_p) 0; a = next) {
- next = a->ac_next;
- count = 0;
- for (l = a->ac_exp; l != (line_p) 0; l= l->l_next) count++;
- outshort(count); /* length of actual */
- outoff(a->ac_size);
- outbyte(a->ac_inl);
- count = putlines(a->ac_exp,cfile);
- oldactual(a);
- }
-}
-
-
-
-putcall(c,cfile,level)
- call_p c;
- FILE *cfile;
- short level;
-{
- /* output a call */
-
- call_p nc,nextc;
-
-
- curoutp = cfile;
- outshort(level); /* nesting level */
- outshort(c->cl_caller->p_id); /* calling proc */
- outshort(c->cl_id);
- outshort(c->cl_proc->p_id); /* called proc */
- outbyte(c->cl_looplevel);
- outbyte(c->cl_flags);
- outshort(c->cl_ratio);
- putactuals(c->cl_actuals,cfile);
- nc = c->cl_car;
- oldcall(c);
- for (; nc != (call_p) 0; nc = nextc) {
- /* take care of nested calls */
- nextc = nc->cl_cdr;
- putcall(nc,cfile,level+1);
- }
-}
-
-long putcc(head,ccf)
- calcnt_p head;
- FILE *ccf;
-{
- /* Write call-count information to file ccf.
- * Return the disk address of the info written.
- */
-
- calcnt_p cc;
- long addr;
- short cnt;
-
- addr = ftell(ccf);
- curoutp = ccf;
- cnt = 0;
- for (cc = head; cc != (calcnt_p) 0;cc = cc->cc_next) cnt++;
- outshort(cnt);
- for (cc = head; cc != (calcnt_p) 0; cc = cc->cc_next) {
- outproc(cc->cc_proc);
- outshort(cc->cc_count);
- }
- return addr;
-}
+++ /dev/null
-
-/* I N L I N E S U B S T I T U T I O N
- *
- * I L _ A U X . H
- */
-
-extern int tsize(); /* (int type)
- * Determine the size of a variable of
- * the given type.
- */
-extern line_p duplicate(); /* (line_p lnp)
- * Make a duplicate of the given EM
- * instruction. Pseudos may not be
- * passed as argumnets.
- */
-extern line_p copy_expr(); /* (line_p l1)
- * copy the expression l1.
- * Pseudos may not be contained in
- * the list of instructions.
- */
-extern rem_call(); /* (call_p c)
- * Remove a call from main memory.
- */
-extern rem_graph(); /* (proc_p p)
- * Remove the CFG and EM text of
- * a procedure from core.
- */
-extern remcc(); /* (calcnt_p head)
- * Remove call-count info from core.
- */
-extern call_p getcall(); /* (FILE *cf)
- * Read a call from the call-file
- */
-extern line_p get_text(); /* (FILE *lf; proc_p *p_out)
- * Read the EM text of one procedure.
- * The procedure read is returned via
- * p_out.
- */
-extern calcnt_p getcc(); /* (FILE *ccf; proc_p p)
- * Read the call-count information
- * of procedure p.
- */
-extern putcall(); /* (call_p call; FILE *cfile; short level)
- * Write the call
- * with the given id to the given file.
- * The level is the nesting level, used by
- * putcall when it calls itself recurively.
- * It should be 0 on outer levels.
- */
-extern long putcc(); /* (calcnt_p head; FILE *ccf)
- * Write call-count information to
- * file ccf.
- */
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=
-SHARE=../share
-LV=.
-OBJECTS=lv.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/aux.o $(SHARE)/put.o $(SHARE)/map.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/parser.o $(SHARE)/files.o $(SHARE)/locals.o $(SHARE)/init_glob.o $(SHARE)/go.o
-SRC=lv.h lv.c
-all: $(OBJECTS)
-lv: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o lv -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-lv.o: ../../../h/em_mnem.h
-lv.o: ../../../h/em_pseu.h
-lv.o: ../../../h/em_spec.h
-lv.o: ../share/alloc.h
-lv.o: ../share/aux.h
-lv.o: ../share/cset.h
-lv.o: ../share/debug.h
-lv.o: ../share/def.h
-lv.o: ../share/files.h
-lv.o: ../share/get.h
-lv.o: ../share/global.h
-lv.o: ../share/go.h
-lv.o: ../share/init_glob.h
-lv.o: ../share/locals.h
-lv.o: ../share/lset.h
-lv.o: ../share/map.h
-lv.o: ../share/parser.h
-lv.o: ../share/put.h
-lv.o: ../share/types.h
-lv.o: lv.h
+++ /dev/null
-
-/* L I V E V A R I A B L E S A N A L Y S I S */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "lv.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/def.h"
-#include "../share/files.h"
-#include "../share/alloc.h"
-#include "../share/map.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/aux.h"
-#include "../share/init_glob.h"
-#include "../share/locals.h"
-#include "../share/go.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../share/parser.h"
-
-#define newlvbx() (bext_p) newstruct(bext_lv)
-#define oldlvbx(x) oldstruct(bext_lv,x)
-
-
-/* TEMPORARY: should be put in ../../../h/em_mes.h: */
-#define ms_liv 9
-#define ms_ded 10
-
-short nrglobals;
-short nrvars;
-
-STATIC int Slv;
-STATIC bool mesgflag = FALSE; /* Suppress generation of live/dead info */
-
-
-STATIC clean_up()
-{
- local_p *p;
-
- for (p = &locals[1]; p <= &locals[nrlocals]; p++) {
- oldlocal(*p);
- }
- oldmap(locals,nrlocals);
-}
-
-
-
-STATIC bool is_dir_use(l)
- line_p l;
-{
- /* See if l is a direct use of some variable
- * (i.e. not through a pointer). A LIL is a
- * direct use of some pointer variable
- * (and an indirect use of some other variable).
- * A SIL is also a direct use.
- * A LOI, however, is not an direct use of a variable.
- * An an increment/decrement instruction is regarded
- * as a use here, and not as a definition, as the
- * variable is first used and than defined.
- */
-
- switch(INSTR(l)) {
- case op_dee:
- case op_del:
- case op_ine:
- case op_inl:
- case op_lde:
- case op_ldl:
- case op_lil:
- case op_loe:
- case op_lol:
- case op_sil:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC bool is_indir_use(l)
- line_p l;
-{
- /* See if instruction l uses some variable(s) indirectly,
- * i.e. through a pointer or via a procedure call.
- */
-
- switch(INSTR(l)) {
- case op_blm:
- case op_bls:
- case op_cai:
- case op_cal:
- case op_lar:
- case op_ldf:
- case op_lil:
- case op_lof:
- case op_loi:
- case op_los:
- case op_mon:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC bool is_def(l)
- line_p l;
-{
- /* See if l does a direct definition */
-
- switch(INSTR(l)) {
- case op_sde:
- case op_sdl:
- case op_ste:
- case op_stl:
- case op_zre:
- case op_zrl:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-STATIC def_use(p)
- proc_p p;
-{
- /* Compute DEF(b) and USE(b), for every basic block b
- * of procedure p. DEF(b) contains the variables that
- * are certain to be defined (assigned) in b
- * before being used. USE(b) contains the variables
- * that may be used in b, before being defined.
- * (Note that uncertainty arises in the presence of
- * pointers and procedure calls).
- * We compute these sets, by scanning the text of
- * the basic block from beginning till end.
- */
-
- register bblock_p b;
- register line_p l;
- short v;
- bool found;
- cset all_ind_uses;
-
- all_ind_uses = Cempty_set(nrvars);
- for (v = 1; v < nrlocals; v++) {
- if (!IS_REGVAR(locals[v])) {
- Cadd(LOC_TO_VARNR(v),&all_ind_uses);
- }
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- USE(b) = Cempty_set(nrvars);
- DEF(b) = Cempty_set(nrvars);
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (is_def(l)) {
- /* An direct definition (i.e. not
- * through a pointer).
- */
- var_nr(l,&v,&found);
- if (found && !Cis_elem(v,USE(b))) {
- /* We do maintain live-dead info
- * for this variable, and it was
- * not used earlier in b.
- */
- Cadd(v, &DEF(b));
- }
- } else {
- if (is_dir_use(l)) {
- var_nr(l,&v,&found);
- if (found && !Cis_elem(v,DEF(b))) {
- Cadd(v, &USE(b));
- }
- }
- if (is_indir_use(l)) {
- /* Add variable that may be used
- * by l to USE(b).
- */
- Cjoin(all_ind_uses,&USE(b));
- }
- }
- }
- }
- Cdeleteset(all_ind_uses);
-}
-
-
-
-STATIC unite_ins(bbset,setp)
- lset bbset;
- cset *setp;
-{
- /* Take the union of L_IN(b), for all b in bbset,
- * and put the result in setp.
- */
-
- Lindex i;
-
- Cclear_set(setp);
- for (i = Lfirst(bbset); i != (Lindex) 0; i = Lnext(i,bbset)) {
- Cjoin(L_IN((bblock_p) Lelem(i)), setp);
- }
-}
-
-
-
-STATIC solve_lv(p)
- proc_p p;
-{
- /* Solve the data flow equations for Live Variables,
- * for procedure p. These equations are:
- * (1) IN[b] = OUT[b] - DEF[b] + USE[b]
- * (2) OUT(b) = IN(s1) + ... + IN(sn) ;
- * where SUCC(b) = {s1, ... , sn}
- */
-
- register bblock_p b;
- cset newout = Cempty_set(nrvars);
- bool change = TRUE;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- L_IN(b) = Cempty_set(nrvars);
- Ccopy_set(USE(b), &L_IN(b));
- L_OUT(b) = Cempty_set(nrvars);
- }
- while (change) {
- change = FALSE;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- unite_ins(b->b_succ,&newout);
- if (!Cequal(newout,L_OUT(b))) {
- change = TRUE;
- Ccopy_set(newout, &L_OUT(b));
- Ccopy_set(newout, &L_IN(b));
- Csubtract(DEF(b), &L_IN(b));
- Cjoin(USE(b), &L_IN(b));
- }
- }
- }
- Cdeleteset(newout);
-}
-
-
-STATIC live_variables_analysis(p)
- proc_p p;
-{
- make_localtab(p);
- nrvars = nrglobals + nrlocals;
- def_use(p);
- solve_lv(p);
-}
-
-
-STATIC init_live_dead(b)
- bblock_p b;
-{
- /* For every register variable, see if it is
- * live or dead at the end of b.
- */
-
- register short v;
- local_p loc;
-
- for (v = 1; v <= nrlocals; v++) {
- loc = locals[v];
- if (IS_REGVAR(loc) && Cis_elem(LOC_TO_VARNR(v),L_OUT(b))) {
- LIVE(loc);
- } else {
- DEAD(loc);
- }
- }
-}
-
-
-
-STATIC line_p make_mesg(mesg,loc)
- short mesg;
- local_p loc;
-{
- /* Create a line for a message stating that
- * local variable loc is live/dead. This message
- * looks like: "mes ms_liv,off,size" or
- * "mes ms_ded,off,size".
- */
-
- line_p l = newline(OPLIST);
- register arg_p ap;
-
- l->l_instr = ps_mes;
- ap = ARG(l) = newarg(ARGOFF);
- ap->a_a.a_offset = mesg;
- ap = ap->a_next = newarg(ARGOFF);
- ap->a_a.a_offset = loc->lc_off;
- ap = ap->a_next = newarg(ARGOFF);
- ap->a_a.a_offset = loc->lc_size;
- return l;
-}
-
-
-
-STATIC block_entry(b,prev)
- bblock_p b,prev;
-{
- short v,vn;
- local_p loc;
- bool was_live, is_live;
-
- /* Generate a live/dead message for every register variable that
- * was live at the end of prev, but dead at the beginning of b,
- * or v.v. If prev = 0 (i.e. begin of procedure), parameters were
- * live, normal local variables were dead.
- */
-
- for (v = 1; v <= nrlocals; v++) {
- loc = locals[v];
- vn = LOC_TO_VARNR(v);
- if (prev == (bblock_p) 0) {
- was_live = loc->lc_off >= 0;
- } else {
- was_live = Cis_elem(vn,L_OUT(prev));
- }
- is_live = Cis_elem(vn,L_IN(b));
- if (was_live != is_live) {
- app_block(make_mesg((is_live?ms_liv:ms_ded),loc),b);
- }
- }
-}
-
-
-
-STATIC app_block(l,b)
- line_p l;
- bblock_p b;
-{
- line_p x = b->b_start;
-
- if (x != (line_p) 0 && INSTR(x) == ps_pro) {
- /* start of procedure; append after pro pseudo ! */
- if ((l->l_next = x->l_next) != (line_p) 0) {
- PREV(l->l_next) = l;
- }
- x->l_next = l;
- PREV(l) = x;
- } else {
- if ((l->l_next = x) != (line_p) 0) {
- PREV(l->l_next) = l;
- }
- b->b_start = l;
- PREV(l) = (line_p) 0;
- }
-}
-
-
-
-STATIC definition(l,useless_out,v_out,mesgflag)
- line_p l;
- bool *useless_out;
- short *v_out;
- bool mesgflag;
-{
- /* Process a definition. If the defined (register-) variable
- * is live after 'l', then create a live-message and put
- * it after 'l'.
- */
-
- short v;
- bool found;
- local_p loc;
-
- *useless_out = FALSE;
- var_nr(l,&v,&found);
- if (found && IS_LOCAL(v)) {
- *v_out = v;
- loc = locals[TO_LOCAL(v)];
- if (IS_REGVAR(loc)) {
- if (IS_LIVE(loc)) {
- if (!mesgflag) {
- appnd_line(make_mesg(ms_liv,loc), l);
- }
- DEAD(loc);
- } else {
- *useless_out = TRUE;
- }
- }
- }
-}
-
-
-
-
-STATIC use(l,mesgflag)
- line_p l;
- bool mesgflag;
-{
- /* Process a use. If the defined (register-) variable
- * is dead after 'l', then create a dead-message and put
- * it after 'l'.
- */
-
- short v;
- bool found;
- local_p loc;
-
- var_nr(l,&v,&found);
- if (found && IS_LOCAL(v)) {
- loc = locals[TO_LOCAL(v)];
- if (IS_REGVAR(loc) && IS_DEAD(loc)) {
- if (!mesgflag) {
- appnd_line(make_mesg(ms_ded,loc), l);
- }
- LIVE(loc);
- }
- }
-}
-
-
-
-STATIC nothing() { } /* No action to be undertaken at level 0 of parser */
-
-STATIC rem_code(l1,l2,b)
- line_p l1,l2;
- bblock_p b;
-{
- line_p l,x,y;
-
- x = PREV(l1);
- y = l2->l_next;
- for (l = l1; l != l2; l = l->l_next) {
- oldline(l);
- }
- if (x == (line_p) 0) {
- b->b_start = y;
- } else {
- x->l_next = y;
- }
- if (y != (line_p) 0) {
- PREV(y) = x;
- }
-}
-
-
-
-
-#define SIZE(v) ((offset) locals[TO_LOCAL(v)]->lc_size)
-
-
-
-
-lv_mesg(p,mesgflag)
- proc_p p;
- bool mesgflag;
-{
- /* Create live/dead messages for every possible register
- * variable of p. A dead-message is put after a "use" of
- * such a variable, if the variable becomes dead just
- * after the use (i.e. this was its last use).
- * A live message is put after a "definition" of such
- * a variable, if the variable becomes live just
- * after the definition (which will usually be the case).
- * We traverse every basic block b of p from the last
- * instruction of b backwards to the beginning of b.
- * Initially, all variables that are dead at the end
- * of b are marked dead. All others are marked live.
- * If we come accross a definition of a variable X that
- * was marked live, we put a live-message after the
- * definition and mark X dead.
- * If we come accross a use of a variable X that
- * was marked dead, we put a dead-message after the
- * use and mark X live.
- * So at any point, the mark of X tells whether X is
- * live or dead immediately before (!) that point.
- * We also generate a message at the start of a basic block
- * for every variable that was live at the end of the (textually)
- * previous block, but dead at the entry of this block, or v.v.
- * On the fly, useless assignments are removed.
- */
-
- register bblock_p b;
- register line_p l;
- line_p lnp, prev;
- bblock_p prevb = (bblock_p) 0;
- short v;
- bool useless;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- block_entry(b,prevb); /* generate message at head of block */
- prevb = b;
- if (!mesgflag) {
- init_live_dead(b);
- }
- for (l = last_instr(b); l != (line_p) 0; l = prev) {
- /* traverse backwards! */
- prev = PREV(l);
- if (is_def(l)) {
- definition(l,&useless,&v,mesgflag);
- if (useless && /* assignment to dead var. */
- parse(prev,SIZE(v),&lnp,0,nothing)) {
- /* The code "VAR := expression" can
- * be removed. 'l' is the "STL VAR",
- * lnp is the beginning of the EM code
- * for the expression.
- */
- prev = PREV(lnp);
- rem_code(lnp,l,b);
-OUTVERBOSE("useless assignment ,proc %d,local %d", curproc->p_id,
- (int) locals[TO_LOCAL(v)]->lc_off);
- Slv++;
- }
- } else {
- if (is_dir_use(l)) {
- use(l,mesgflag);
- }
- }
- }
- }
-}
-
-
-STATIC lv_extend(p)
- proc_p p;
-{
- /* Allocate extended data structures for Use Definition analysis */
-
- register bblock_p b;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- b->b_extend = newlvbx();
- }
-}
-
-
-STATIC lv_cleanup(p)
- proc_p p;
-{
- /* Deallocate extended data structures for Use Definition analysis */
-
- register bblock_p b;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- Cdeleteset(USE(b));
- Cdeleteset(DEF(b));
- Cdeleteset(L_IN(b));
- Cdeleteset(L_OUT(b));
- oldlvbx(b->b_extend);
- }
-}
-
-lv_flags(p)
- char *p;
-{
- switch(*p) {
- case 'N':
- mesgflag = TRUE;
- break;
- }
-}
-
-
-lv_optimize(p)
- proc_p p;
-{
- locals = (local_p *) 0;
- lv_extend(p);
- live_variables_analysis(p);
- lv_mesg(p,mesgflag);
- /* generate live-dead messages for regvars */
- lv_cleanup(p);
- clean_up();
-}
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,init_globals,lv_optimize,no_action,lv_flags);
- report("useless assignments deleted",Slv);
- exit(0);
-}
+++ /dev/null
-/* L I V E V A R I A B L E S A N A L Y S I S
- *
- * L V . H
- */
-
-
-#define USE(b) (b)->b_extend->bx_lv.bx_use
-#define DEF(b) (b)->b_extend->bx_lv.bx_def
-#define L_IN(b) (b)->b_extend->bx_lv.bx_lin
-#define L_OUT(b) (b)->b_extend->bx_lv.bx_lout
-
-extern short nrglobals; /* number of global variables for which
- * ud-info is maintained.
- */
-extern short nrvars; /* total number of variables (global + local)
- * for which ud-info is maintained.
- */
-
-/* Every global variable for which ud-info is maintained has
- * a 'global variable number' (o_globnr). Every useful local
- * has a 'local variable number', which is its index in the
- * 'locals' table. All these variables also have a
- * 'variable number'. Conversions exist between these numbers.
- */
-
-#define TO_GLOBAL(v) (v)
-#define TO_LOCAL(v) (v - nrglobals)
-#define GLOB_TO_VARNR(v) (v)
-#define LOC_TO_VARNR(v) (v + nrglobals)
-#define IS_GLOBAL(v) (v <= nrglobals)
-#define IS_LOCAL(v) (v > nrglobals)
-
-#define REGVAR(lc) lc->lc_flags |= LCF_REG
-#define IS_REGVAR(lc) (lc->lc_flags & LCF_REG)
-#define BADLC(lc) lc->lc_flags |= LCF_BAD
-#define IS_BADLC(lc) (lc->lc_flags & LCF_BAD)
-#define LIVE(lc) lc->lc_flags |= LCF_LIVE
-#define DEAD(lc) lc->lc_flags &= ~LCF_LIVE
-#define IS_LIVE(lc) (lc->lc_flags & LCF_LIVE)
-#define IS_DEAD(lc) (!(lc->lc_flags & LCF_LIVE))
-
-
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=-DVERBOSE
-SHARE=../share
-RA=.
-OBJECTS=ra.o ra_items.o ra_lifet.o ra_allocl.o ra_profits.o ra_interv.o ra_pack.o ra_xform.o ra_aux.o
-SHOBJECTS=$(SHARE)/aux.o $(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/go.o
-SRC=ra.h ra_items.h ra_lifet.h ra_allocl.h ra_profits.h ra_interv.h ra_pack.h ra_xform.h ra_aux.h ra.c ra_items.c ra_lifet.c ra_allocl.c ra_profits.c ra_interv.c ra_pack.c ra_xform.c ra_aux.c
-all: $(OBJECTS)
-itemtab.h: \
- makeitems \
- itemtab.src
- makeitems $(EMH)/em_mnem.h itemtab.src > itemtab.h
-makeitems: \
- makeitems.c
- $(CC) -o makeitems makeitems.c
-ra: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o ra -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-opr:
- pr $(SRC) | opr
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-ra.o: ../../../h/em_reg.h
-ra.o: ../share/alloc.h
-ra.o: ../share/debug.h
-ra.o: ../share/files.h
-ra.o: ../share/get.h
-ra.o: ../share/global.h
-ra.o: ../share/go.h
-ra.o: ../share/lset.h
-ra.o: ../share/map.h
-ra.o: ../share/put.h
-ra.o: ../share/types.h
-ra.o: ra.h
-ra.o: ra_allocl.h
-ra.o: ra_items.h
-ra.o: ra_pack.h
-ra.o: ra_profits.h
-ra.o: ra_xform.h
-ra_allocl.o: ../../../h/em_mnem.h
-ra_allocl.o: ../../../h/em_pseu.h
-ra_allocl.o: ../../../h/em_reg.h
-ra_allocl.o: ../../../h/em_spec.h
-ra_allocl.o: ../share/alloc.h
-ra_allocl.o: ../share/aux.h
-ra_allocl.o: ../share/cset.h
-ra_allocl.o: ../share/debug.h
-ra_allocl.o: ../share/def.h
-ra_allocl.o: ../share/global.h
-ra_allocl.o: ../share/lset.h
-ra_allocl.o: ../share/map.h
-ra_allocl.o: ../share/types.h
-ra_allocl.o: ra.h
-ra_allocl.o: ra_allocl.h
-ra_allocl.o: ra_aux.h
-ra_allocl.o: ra_interv.h
-ra_allocl.o: ra_items.h
-ra_aux.o: ../../../h/em_mnem.h
-ra_aux.o: ../../../h/em_pseu.h
-ra_aux.o: ../../../h/em_reg.h
-ra_aux.o: ../../../h/em_spec.h
-ra_aux.o: ../share/alloc.h
-ra_aux.o: ../share/debug.h
-ra_aux.o: ../share/def.h
-ra_aux.o: ../share/global.h
-ra_aux.o: ../share/lset.h
-ra_aux.o: ../share/types.h
-ra_aux.o: ra.h
-ra_aux.o: ra_aux.h
-ra_interv.o: ../share/alloc.h
-ra_interv.o: ../share/debug.h
-ra_interv.o: ../share/global.h
-ra_interv.o: ../share/lset.h
-ra_interv.o: ../share/types.h
-ra_interv.o: ../../../h/em_reg.h
-ra_interv.o: ra.h
-ra_interv.o: ra_interv.h
-ra_items.o: ../../../h/em_mnem.h
-ra_items.o: ../../../h/em_pseu.h
-ra_items.o: ../../../h/em_reg.h
-ra_items.o: ../../../h/em_spec.h
-ra_items.o: ../share/alloc.h
-ra_items.o: ../share/aux.h
-ra_items.o: ../share/debug.h
-ra_items.o: ../share/def.h
-ra_items.o: ../share/global.h
-ra_items.o: ../share/lset.h
-ra_items.o: ../share/types.h
-ra_items.o: itemtab.h
-ra_items.o: ra.h
-ra_items.o: ra_aux.h
-ra_items.o: ra_items.h
-ra_lifet.o: ../../../h/em_mnem.h
-ra_lifet.o: ../../../h/em_pseu.h
-ra_lifet.o: ../../../h/em_reg.h
-ra_lifet.o: ../../../h/em_spec.h
-ra_lifet.o: ../share/alloc.h
-ra_lifet.o: ../share/aux.h
-ra_lifet.o: ../share/debug.h
-ra_lifet.o: ../share/def.h
-ra_lifet.o: ../share/global.h
-ra_lifet.o: ../share/lset.h
-ra_lifet.o: ../share/types.h
-ra_lifet.o: ra.h
-ra_lifet.o: ra_aux.h
-ra_lifet.o: ra_items.h
-ra_lifet.o: ra_lifet.h
-ra_pack.o: ../../../h/em_reg.h
-ra_pack.o: ../share/alloc.h
-ra_pack.o: ../share/aux.h
-ra_pack.o: ../share/cset.h
-ra_pack.o: ../share/debug.h
-ra_pack.o: ../share/def.h
-ra_pack.o: ../share/global.h
-ra_pack.o: ../share/lset.h
-ra_pack.o: ../share/types.h
-ra_pack.o: ra.h
-ra_pack.o: ra_aux.h
-ra_pack.o: ra_interv.h
-ra_profits.o: ../../../h/em_reg.h
-ra_profits.o: ../share/debug.h
-ra_profits.o: ../share/global.h
-ra_profits.o: ../share/lset.h
-ra_profits.o: ../share/types.h
-ra_profits.o: ra.h
-ra_profits.o: ra_aux.h
-ra_profits.o: ra_profits.h
-ra_xform.o: ../../../h/em_mes.h
-ra_xform.o: ../../../h/em_mnem.h
-ra_xform.o: ../../../h/em_pseu.h
-ra_xform.o: ../../../h/em_reg.h
-ra_xform.o: ../../../h/em_spec.h
-ra_xform.o: ../share/alloc.h
-ra_xform.o: ../share/aux.h
-ra_xform.o: ../share/debug.h
-ra_xform.o: ../share/def.h
-ra_xform.o: ../share/global.h
-ra_xform.o: ../share/lset.h
-ra_xform.o: ../share/types.h
-ra_xform.o: ra.h
-ra_xform.o: ra_interv.h
-ra_xform.o: ra_items.h
-ra_xform.o: ra_xform.h
+++ /dev/null
-op_cal PROC_ADDR 12
-op_dee GLOBL_ADDR 8
-op_del LOCALVAR 8
-op_ine GLOBL_ADDR 7
-op_inl LOCALVAR 7
-op_lae GLOBL_ADDR 2
-op_lal LOCAL_ADDR 2
-op_ldc DCONST 11
-op_lde GLOBL_ADDR 3
-op_ldl LOCALVAR 3
-op_lil LOCALVAR 1
-op_loc CONST 10
-op_loe GLOBL_ADDR 0
-op_lol LOCALVAR 0
-op_sde GLOBL_ADDR 6
-op_sdl LOCALVAR 6
-op_sil LOCALVAR 5
-op_ste GLOBL_ADDR 4
-op_stl LOCALVAR 4
-op_zre GLOBL_ADDR 9
-op_zrl LOCALVAR 9
+++ /dev/null
-#include <stdio.h>
-
-/* MAKE ITEMS TABLE
- *
- * This program is used by the register allocation phase of the optimizer
- * to make the file itemtab.h. It reads two files:
- * - the em_mnem.h file, containing the definitions of the
- * EM mnemonics
- * - the item-file, containing tuples:
- * (mnemonic, item_type)
- * The output (standard output) is a C array.
- */
-
-
-#define TRUE 1
-#define FALSE 0
-
-convert(mnemfile,itemfile)
- FILE *mnemfile, *itemfile;
-{
- char mnem1[20], mnem2[20],def[20],itemtype[20];
- int newcl,opc,index;
-
- newcl = TRUE;
- printf("struct item_descr itemtab[] = {\n");
- for (;;) {
- fscanf(mnemfile,"%s%s%d",def,mnem1,&opc);
- /* read a line like "#define op_aar 1" */
- if (feof(mnemfile)) break;
- if (strcmp(def,"#define") != 0) {
- error("bad mnemonic file, #define expected");
- }
- if (newcl) {
- fscanf(itemfile,"%s%s%d",mnem2,itemtype,&index);
- /* read a line like "op_loc CONST 4" */
- }
- if (feof(itemfile) || strcmp(mnem1,mnem2) != 0) {
- /* there is no line for this mnemonic, so
- * it has no type.
- */
- printf("{NO_ITEM,0},\n");
- newcl = FALSE;
- } else {
- printf("{%s,%d},\n",itemtype,index);
- newcl = TRUE;
- }
- }
- printf("};\n");
-}
-
-
-
-error(s)
- char *s;
-{
- fprintf(stderr,"%s\n",s);
- exit(-1);
-}
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- FILE *f1,*f2;
-
- if (argc != 3) {
- error("usage: makeitems mnemfile itemfile");
- }
- if ((f1 = fopen(argv[1],"r")) == NULL) {
- error("cannot open mnemonic file");
- }
- if ((f2 = fopen(argv[2],"r")) == NULL) {
- error("cannot open item file");
- }
- convert(f1,f2);
-}
+++ /dev/null
-/*
- * R E G I S T E R A L L O C A T I O N
- *
- */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/go.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_items.h"
-#include "ra_allocl.h"
-#include "ra_profits.h"
-#include "ra_pack.h"
-#include "ra_xform.h"
-
-
-#define newrabx() (bext_p) newstruct(bext_ra)
-#define newralpx() (lpext_p) newstruct(lpext_ra)
-#define oldrabx(x) oldstruct(bext_ra,x)
-#define oldralpx(x) oldstruct(lpext_ra,x)
-
-short alloc_id;
-static item_p items[NRITEMTYPES];
-int nrinstrs;
-line_p *instrmap;
-
-cond_p alocaltab[NRREGTYPES][NRREGTYPES],alocaddrtab[NRREGTYPES][NRREGTYPES],
- aconsttab,adconsttab,aglobaltab,aproctab;
-cond_p olocaltab[NRREGTYPES],olocaddrtab[NRREGTYPES],
- oconsttab,odconsttab,oglobaltab,oproctab;
-cond_p regsav_cost;
-
-short regs_available[] = {
- /* Actually machine dependent; this is for vax2 */
- 3, /* reg_any i.e. data regs */
- 0, /* reg_loop */
- 3, /* reg_pointer i.e. address reg. */
- 0 /* reg_float */
-} ;
-
-STATIC cond_p getcondtab(f)
- FILE *f;
-{
- int l,i;
- cond_p tab;
-
- fscanf(f,"%d",&l);
- tab = newcondtab(l);
- for (i = 0; i < l; i++) {
- fscanf(f,"%d %d %d",&tab[i].mc_cond,&tab[i].mc_tval,
- &tab[i].mc_sval);
- }
- assert(tab[l-1].mc_cond == DEFAULT);
- return tab;
-}
-
-get_atab(f,tab)
- FILE *f;
- cond_p tab[NRREGTYPES][NRREGTYPES];
-{
- int i,cnt,totyp,regtyp;
-
- fscanf(f,"%d",&cnt);
- for (i = 0; i < cnt; i++) {
- fscanf(f,"%d %d",®typ,&totyp);
- assert(regtyp >= 0 && regtyp < NRREGTYPES);
- assert(totyp >= 0 && totyp < NRREGTYPES);
- tab[regtyp][totyp] = getcondtab(f);
- }
-}
-
-
-get_otab(f,tab)
- FILE *f;
- cond_p tab[NRREGTYPES];
-{
- int i,cnt,regtyp;
-
- fscanf(f,"%d",&cnt);
- for (i = 0; i < cnt; i++) {
- fscanf(f,"%d",®typ);
- assert(regtyp >= 0 && regtyp < NRREGTYPES);
- tab[regtyp] = getcondtab(f);
- }
-}
-
-
-
-STATIC ra_machinit(f)
- FILE *f;
-{
- /* Read target machine dependent information for this phase */
- char s[100];
-
- for (;;) {
- while(getc(f) != '\n');
- fscanf(f,"%s",s);
- if (strcmp(s,"%%RA") == 0)break;
- }
- fscanf(f,"%d",®s_available[reg_any]);
- fscanf(f,"%d",®s_available[reg_pointer]);
- fscanf(f,"%d",®s_available[reg_float]);
- get_atab(f,alocaltab);
- get_atab(f,alocaddrtab);
- aconsttab = getcondtab(f);
- adconsttab = getcondtab(f);
- aglobaltab = getcondtab(f);
- aproctab = getcondtab(f);
- get_otab(f,olocaltab);
- get_otab(f,olocaddrtab);
- oconsttab = getcondtab(f);
- odconsttab = getcondtab(f);
- oglobaltab = getcondtab(f);
- oproctab = getcondtab(f);
- regsav_cost = getcondtab(f);
-}
-
-
-STATIC bblock_p header(lp)
- loop_p lp;
-{
- /* Try to determine the 'header' block of loop lp.
- * If 'e' is the entry block of loop L, then block 'b' is
- * called the header block of L, iff:
- * SUCC(b) = {e} & PRED(e) = {b}
- * If lp has no header block, 0 is returned.
- */
-
- bblock_p x = lp->lp_entry->b_idom;
-
- if (x != (bblock_p) 0 && Lnrelems(x->b_succ) == 1 &&
- (bblock_p) Lelem(Lfirst(x->b_succ)) == lp->lp_entry) {
- return x;
- }
- return (bblock_p) 0;
-}
-
-
-STATIC ra_extproc(p)
- proc_p p;
-{
- /* Allocate the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
- register bblock_p b;
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- lp->lp_extend = newralpx();
- lp->LP_HEADER = header(lp);
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- b->b_extend = newrabx();
- }
-}
-
-
-
-
-STATIC ra_cleanproc(p)
- proc_p p;
-{
- /* Allocate the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
- register bblock_p b;
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- oldralpx(lp->lp_extend);
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- oldrabx(b->b_extend);
- }
-}
-
-
-
-STATIC loop_blocks(p)
- proc_p p;
-{
- /* Compute the LP_BLOCKS sets for all loops of p */
-
- register bblock_p b;
- register Lindex i;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (i = Lfirst(b->b_loops); i != (Lindex) 0;
- i = Lnext(i,b->b_loops)) {
- Ladd(b,&(((loop_p) Lelem(i))->LP_BLOCKS));
- }
- }
-}
-
-
-
-
-STATIC make_instrmap(p,map)
- proc_p p;
- line_p map[];
-{
- /* make the instructions map of procedure p */
-
- register bblock_p b;
- register line_p l;
- register int i = 0;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- b->B_BEGIN = i; /* number of first instruction */
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- map[i++] = l;
- }
- b->B_END = i-1; /* number of last instruction */
- }
-}
-
-
-
-STATIC bool useful_item(item)
- item_p item;
-{
- /* See if it may be useful to put the item in a register.
- * A local variable that is not a parameter may always be put
- * in a register (as it need not be initialized).
- * Other items must be used at least twice.
- */
-
- int nruses = Lnrelems(item->it_usage);
- assert (nruses > 0); /* otherwise it would not be an item! */
- return nruses > 1 || (item->it_type == LOCALVAR &&
- item->i_t.it_off < 0);
-}
-
-
-STATIC item_p cat_items(items)
- item_p items[];
-{
- /* Make one item list out of an array of itemlists.
- * Remove items that are used only once.
- */
-
- register item_p it;
- item_p *ip,head,next;
- int t;
-
-
- ip = &head;
- for (t = 0; t < NRITEMTYPES;t++) {
- for ( it = items[t]; it != (item_p) 0; it = next) {
- next = it->it_next;
- if (!it->it_desirable || !useful_item(it)) {
- clean_timeset(it->it_usage);
- olditem(it);
- } else {
- *ip = it;
- ip = &it->it_next;
- }
- }
- }
- *ip = (item_p) 0;
- return head;
-}
-
-
-
-
-STATIC clean_interval(list)
- interv_p list;
-{
- register interv_p x,next;
-
- for (x = list; x != (interv_p) 0; x = next) {
- next = x->i_next;
- oldinterval(x);
- }
-}
-
-
-
-STATIC clean_timeset(s)
- lset s;
-{
- register Lindex i;
- register time_p t;
-
- for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i,s)) {
- t = (time_p) Lelem(i);
- oldtime(t);
- }
- Ldeleteset(s);
-}
-
-
-
-STATIC clean_allocs(list)
- alloc_p list;
-{
- register alloc_p x,next;
-
- for (x = list; x != (alloc_p) 0; x = next) {
- next = x->al_next;
- clean_interval(x->al_timespan);
- Cdeleteset(x->al_rivals);
- Ldeleteset(x->al_inits);
- clean_interval(x->al_busy);
- clean_allocs(x->al_mates);
- oldalloc(x);
- }
-}
-
-
-
-STATIC clean_items(list)
- item_p list;
-{
- register item_p x,next;
-
- for (x = list; x != (item_p) 0; x = next ) {
- next = x->it_next;
- clean_timeset(x->it_usage);
- olditem(x);
- }
-}
-
-
-ra_initialize()
-{
- init_replacements(ps,ws);
-}
-
-
-ra_optimize(p)
- proc_p p;
-{
- item_p itemlist;
- alloc_p alloclist,packed,unpacked;
- offset locls;
- bool time_opt = (time_space_ratio == 100);
-
- ra_extproc(p);
- loop_blocks(p);
- alloc_id =0;
- locls = p->p_localbytes;
- build_itemlist(p,items,&nrinstrs);
- instrmap = (line_p *) newmap(nrinstrs-1); /* map starts counting at 0 */
- make_instrmap(p,instrmap);
- build_lifetimes(items);
- /* print_items(items,p); */
- /* statistics(items); */
- itemlist = cat_items(items); /* make one list */
- alloclist = build_alloc_list(p,Lnrelems(p->p_loops),
- itemlist);
- build_rivals_graph(alloclist);
- compute_profits(alloclist,time_opt);
- /* print_allocs(alloclist); */
- pack(alloclist,time_opt,&packed,&unpacked,p);
- stat_regusage(packed);
- xform_proc(p,packed,nrinstrs,instrmap);
- /* print_allocs(packed); */
- p->p_localbytes = locls;
- /* don't really allocate dummy local variables! */
- rem_locals(p,packed);
- rem_formals(p,packed);
- /* remove storage for real locals that
- *are always put in register .
- */
- clean_allocs(unpacked);
- clean_allocs(packed);
- clean_items(itemlist);
- oldmap(instrmap,nrinstrs-1);
- ra_cleanproc(p);
-}
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,ra_initialize,ra_optimize,ra_machinit,no_action);
- exit(0);
-}
-
-
-/***************************************************************************/
-/***************************************************************************/
-/***************************************************************************/
-
-/* debugging stuff */
-
-
-
-char *str_types[] = {
- "local variable",
- "addr. of local",
- "addr. of external",
- "addr. of procedure",
- "constant",
- "double constant"
-};
-
-char *str_regtypes[] = {
- "any",
- "loop",
- "pointer",
- "float"
-};
-
-
-print_items(items,p)
- item_p items[];
- proc_p p;
-{
- int t;
- item_p item;
- interv_p iv;
-
- printf("BEGIN PROCEDURE %d\n",p->p_id);
- for (t = 0; t < NRITEMTYPES;t++) {
- for (item = items[t]; item != (item_p) 0;item = item->it_next) {
- printf("\nitemtype = %s\n",str_types[t]);
- if (t == GLOBL_ADDR) {
- printf("id of external = %d\n",
- item->i_t.it_obj->o_id);
- } else {
- printf("offset = %D\n",
- item->i_t.it_off);
- }
- printf("regtype = %s\n",str_regtypes[item->it_regtype]);
- printf("size = %d\n",item->it_size);
- printf("#usages = %d\n", Lnrelems(item->it_usage));
- printf("lifetime = {");
- for (iv = item->it_lives; iv != (interv_p) 0;
- iv = iv->i_next) {
- printf("(%d,%d) ",iv->i_start,iv->i_stop);
- }
- printf("} \n");
- }
- }
- printf("END PROCEDURE %d\n\n",p->p_id);
-}
-
-
-print_allocs(list)
- alloc_p list;
-{
- alloc_p al,m;
- item_p item;
- short t;
- interv_p iv;
-
- printf("BEGIN ALLOCLIST of proc %d\n",curproc->p_id);
- for (m = list ; m != (alloc_p) 0; m = m->al_next) {
- for (al = m; al != (alloc_p) 0; al = al->al_mates) {
- item = al->al_item;
- t = item->it_type;
- printf("\nitem: [type = %s, ",str_types[t]);
- switch(t) {
- case GLOBL_ADDR:
- printf("id = %d]\n", item->i_t.it_obj->o_id);
- break;
- case PROC_ADDR:
- printf("id = %d]\n", item->i_t.it_proc->p_id);
- break;
- default:
- printf("offset = %D]\n", item->i_t.it_off);
- }
- printf("#usages(static) = %d\n",al->al_susecount);
- printf("#usages(dyn) = %d\n",al->al_dusecount);
- printf("#inits = %d\n",Lnrelems(al->al_inits));
- printf("timespan = {");
- for (iv = al->al_timespan; iv != (interv_p) 0;
- iv = iv->i_next) {
- printf("(%d,%d) ",iv->i_start,iv->i_stop);
- }
- printf("} \n");
- printf("busy = {");
- for (iv = al->al_busy; iv != (interv_p) 0;
- iv = iv->i_next) {
- printf("(%d,%d) ",iv->i_start,iv->i_stop);
- }
- printf("} \n");
- printf("profits = %d\n",al->al_profits);
- printf("dummy local = %D\n",al->al_dummy);
- printf("regnr = %d\n",al->al_regnr);
- }
- }
-}
-
-
-short regs_needed[4];
-stat_regusage(list)
- alloc_p list;
-{
- int i;
- alloc_p x;
-
- for (i = 0; i < 4; i++) {
- regs_needed[i] = 0;
- }
- for (x = list; x != (alloc_p) 0; x = x->al_next) {
- regs_needed[x->al_regtype]++;
- }
- /* printf("data regs:%d\n",regs_needed[reg_any]); */
- /* printf("address regs:%d\n",regs_needed[reg_pointer]); */
-}
-
-
-
-int cnt_regtypes[reg_float+1];
-
-statistics(items)
- item_p items[];
-{
- register item_p item,next;
- int t,r;
- int cnt;
-
- printf("\nSTATISTICS\n");
- for (r = 0; r <= reg_float; r++) cnt_regtypes[r] = 0;
- for (t = 0; t < NRITEMTYPES;t++) {
- cnt = 0;
- for (item = items[t]; item != (item_p) 0;item = next) {
- if (useful_item(item)) {
- cnt++;
- cnt_regtypes[item->it_regtype]++;
- }
- next = item->it_next;
- }
- printf("#%s = %d\n",str_types[t],cnt);
- }
- for (r = 0; r <= reg_float; r++) {
- printf("#%s = %d\n",str_regtypes[r],cnt_regtypes[r]);
- }
-}
+++ /dev/null
-/*
- * R E G I S T E R A L L O C A T I O N
- *
- */
-
-/* TEMPORARY: should be put in ../../../h/em_mes.h: */
-#define ms_liv 9
-#define ms_ded 10
-
-#define INFINITE 10000
-#define NRREGTYPES (reg_float+1)
-
-extern int nrinstrs; /* number of instructions of current procedure */
-extern line_p *instrmap;
-/* Dynamic array: instrmap[i] points to i'th instruction */
-
-extern cond_p alocaltab[NRREGTYPES][NRREGTYPES],
- alocaddrtab[NRREGTYPES][NRREGTYPES], aconsttab,
- adconsttab,aglobaltab,aproctab;
-extern cond_p olocaltab[NRREGTYPES],olocaddrtab[NRREGTYPES],
- oconsttab,odconsttab,oglobaltab,oproctab;
-extern cond_p regsav_cost;
-
-/* Register Allocation */
-typedef struct item *item_p;
-typedef struct allocation *alloc_p;
-typedef struct interval *interv_p;
-typedef struct time *time_p;
-
-
-
-
-extern short regs_available[]; /* contains #registers of every type */
-
-
-/* A thing that can be put in a register is called an "item". The are several
- * types of items: a local variable, the address of a local variable,
- * the address of a global variable, the address of a procedure,
- * a word-size constant and a doubleword- size constant.
- */
-
-#define LOCALVAR 0
-#define LOCAL_ADDR 1
-#define GLOBL_ADDR 2
-#define PROC_ADDR 3
-#define CONST 4
-#define DCONST 5
-
-#define NO_ITEM 6
-#define NRITEMTYPES 6
-
-struct item {
- item_p it_next; /* link to next item is list */
- short it_type; /* its type; see above */
- short it_regtype; /* preferred type of register */
- short it_size; /* its size (in bytes) */
- short it_lastlive; /* temporary, used to build livetime */
- lset it_usage; /* all points in text where item is used*/
- interv_p it_lives; /* intervals during which item is live */
- bool it_desirable; /* should this item be put in reg.? */
- union {
- obj_p it_obj; /* for GLOBL_ADDR */
- proc_p it_proc; /* for PROC_ADDR */
- offset it_off; /* for others */
- } i_t;
-};
-
-
-/* A 'point in time' is defined by a (line,basic block) pair */
-
-struct time {
- line_p t_line; /* point in EM text */
- bblock_p t_bblock; /* its basic block */
-};
-
-
-struct interval {
- short i_start; /* number of first instruction */
- short i_stop; /* number of last instruction */
- interv_p i_next;
-};
-
-
-/* An item may be put in a register for the duration of a whole procedure
- * or part of a procedure (e.g. a loop). So a possible "allocation" looks
- * like: put item X in a register during the timespan T (which is a subset
- * of the timespan of the entire procedure). The packing process deals
- * with allocations, rather than items. One item may be part of several
- * possible allocations.
- */
-
-struct allocation {
- item_p al_item; /* the item to be put in a register */
- short al_id; /* unique identifying number */
- short al_regtype; /* the register type to be used */
- interv_p al_timespan; /* timespan during which item is in reg. */
- short al_profits; /* gains of putting item in register */
- cset al_rivals; /* set of allocations competing with it */
- short al_susecount; /* #usages during timespan (statically) */
- short al_dusecount; /* #usages (dynamically, estimate) */
- lset al_inits; /* points where reg. must be initialized */
- interv_p al_busy; /* used to compute rivals */
- short al_regnr; /* register nr.,if it is granted a reg. */
- offset al_dummy; /* dummy local variable,if granted a reg */
- alloc_p al_mates; /* link to allocations packed in same reg */
- alloc_p al_wholeproc; /* alloc. for whole proc as timespan */
- short al_cntrivals; /* # unpacked rivals ; used for cost estim. */
- bool al_isloop; /* true if timespan consists of loop */
- bool al_iswholeproc;/*true if timespan consists of whole proc*/
- alloc_p al_next; /* link to next one in a list */
-};
-
-extern short alloc_id; /* last al_id used for current procedure */
-
-#define LP_BLOCKS lp_extend->lpx_ra.lpx_blocks
-#define LP_HEADER lp_extend->lpx_ra.lpx_header
-#define B_BEGIN b_extend->bx_ra.bx_begin
-#define B_END b_extend->bx_ra.bx_end
-
-#define DLINK(l1,l2) l1->l_next=l2; l2->l_prev=l1
-
-struct item_descr {
- int id_type;
- int id_replindex;
-} ;
-
-extern struct item_descr itemtab[];
-
-#define newalloc() (alloc_p) newstruct(allocation)
-#define oldalloc(a) oldstruct(allocation,a)
-#define newitem() (item_p) newstruct(item)
-#define olditem(i) oldstruct(item,i)
-#define newtime() (time_p) newstruct(time)
-#define oldtime(t) oldstruct(time,t)
-#define newinterval() (interv_p) newstruct(interval)
-#define oldinterval(i) oldstruct(interval,i)
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ A L L O C L I S T . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/aux.h"
-#include "../share/alloc.h"
-#include "../share/map.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-#include "ra_items.h"
-#include "ra_allocl.h"
-#include "ra_interv.h"
-
-STATIC count_usage(p,item,nrloops,sloopcnt,dloopcnt)
- proc_p p;
- item_p item;
- short nrloops, sloopcnt[], dloopcnt[];
-{
- /* Determine how many times the item is used in every loop.
- * We maintain a 'static' count and a 'dynamic' count. The dynamic
- * count estimates the number of times the item is used during
- * execution, i.e. it gives a higher mark to items used inside
- * a loop.
- */
-
- lset loops;
- loop_p l;
- int i;
- short lev;
- Lindex ui,li;
- time_p u;
-
- for (i = 0; i <= nrloops; i++) {
- sloopcnt[i] = 0;
- dloopcnt[i] = 0;
- }
- for (ui = Lfirst(item->it_usage); ui != (Lindex) 0;
- ui = Lnext(ui,item->it_usage)) {
- u = (time_p) Lelem(ui);
- loops = u->t_bblock->b_loops;
- lev = Lnrelems(loops);
- /* set of loops in which this usage of item occurs */
- for (li = Lfirst(loops); li != (Lindex) 0; li=Lnext(li,loops)) {
- l = (loop_p) Lelem(li);
- sloopcnt[l->lp_id]++;
- dloopcnt[l->lp_id] +=
- (IS_FIRM(u->t_bblock) ? loop_scale(lev) : 1);
- }
- }
-}
-
-
-
-STATIC alloc_p cons_alloc(item,timespan,stat_usecount,
- dyn_usecount,inits,wholeproc,isloop,iswholeproc)
- item_p item;
- interv_p timespan;
- short stat_usecount,dyn_usecount;
- lset inits;
- alloc_p wholeproc;
- bool isloop,iswholeproc;
-{
- alloc_p x;
-
- x = newalloc();
- x->al_id = ++alloc_id;
- x->al_item = item;
- x->al_timespan = timespan;
- x->al_susecount = stat_usecount;
- x->al_dusecount = dyn_usecount;
- x->al_inits = inits;
- x->al_wholeproc = wholeproc;
- x->al_isloop = isloop;
- x->al_iswholeproc = iswholeproc;
- return x;
-}
-
-
-STATIC insert_alloc(alloc,list_p)
- alloc_p alloc, *list_p;
-{
- alloc->al_next = *list_p;
- *list_p = alloc;
-}
-
-
-
-#define MUST_INIT(i,b) (i->it_type!=LOCALVAR ||contains(b->B_BEGIN,i->it_lives))
-#define MUST_UPDATE(i,b) (i->it_type==LOCALVAR &&contains(b->B_BEGIN,i->it_lives))
-
-STATIC lset loop_inits(lp,item,header)
- loop_p lp;
- item_p item;
- bblock_p header;
-{
- /* Build the set of entry points to loop lp where item
- * must be initialized
- */
-
- lset s = Lempty_set();
- if (header != (bblock_p) 0 && MUST_INIT(item,header)) {
- Ladd(header,&s);
- }
- return s;
-}
-
-
-
-#define IN_LOOP(b) (Lnrelems(b->b_loops) > 0)
-
-STATIC bblock_p init_point(item)
- item_p item;
-{
- /* Find the most appropriate point to initialize any register
- * containing the item. We want to do the initialization as
- * late as possible, to allow other items to be put in the
- * same register, before this initialization. Yet, as we want
- * to do the initialization only once, it must be done in a
- * basic block that is a dominator of all points where the
- * item is used (ultimately in the first block of the procedure).
- * This basic block should not be part of loop.
- */
-
- bblock_p b,dom = 0;
- Lindex ti;
- time_p t;
-
- for (ti = Lfirst(item->it_usage); ti != (Lindex) 0;
- ti = Lnext(ti,item->it_usage)) {
- t = (time_p) Lelem(ti);
- b = t->t_bblock;
- dom = (dom == (bblock_p) 0 ? b : common_dom(dom,b));
- }
- while (IN_LOOP(dom)) {
- /* Find a dominator of dom (possibly
- * dom itself) that is outside any loop.
- */
- dom = dom->b_idom;
- }
- return dom;
-}
-
-
-STATIC add_blocks(b,s,span)
- bblock_p b;
- cset *s;
- interv_p *span;
-{
- Lindex pi;
-
- if (!Cis_elem(b->b_id,*s)) {
- Cadd(b->b_id,s);
- add_interval(b->B_BEGIN,b->B_END,span);
- for (pi = Lfirst(b->b_pred); pi != (Lindex) 0;
- pi = Lnext(pi,b->b_pred)) {
- add_blocks((bblock_p) Lelem(pi),s,span);
- }
- }
-}
-
-
-
-STATIC whole_lifetime(item,ini_out,span_out)
- item_p item;
- bblock_p *ini_out;
- interv_p *span_out;
-{
- /* Find the initialization point and the time_span of the item, if
- * we put the item in a register during all its uses.
- */
-
- bblock_p b, ini = init_point(item);
- cset s = Cempty_set(blength);
- Lindex ti;
- time_p t;
- interv_p span = (interv_p) 0;
-
- for (ti = Lfirst(item->it_usage); ti != (Lindex) 0;
- ti = Lnext(ti,item->it_usage)) {
- t = (time_p) Lelem(ti);
- b = t->t_bblock;
- add_blocks(b,&s,&span);
- }
- if (!Cis_elem(ini->b_id,s)) {
- add_interval(ini->B_BEGIN,ini->B_END,&span);
- }
- Cdeleteset(s);
- *ini_out = ini;
- *span_out = span;
-}
-
-
-
-
-STATIC lset proc_inits(p,item,ini)
- proc_p p;
- item_p item;
- bblock_p ini;
-{
- lset s = Lempty_set();
-
- if (item->it_type != LOCALVAR || item->i_t.it_off >= 0) {
- /* only local variables need not be initialized */
- Ladd(ini, &s);
- }
- return s;
-}
-
-
-STATIC bool updates_needed(lp,item)
- loop_p lp;
- item_p item;
-{
- /* See if the value of item is live after the loop has
- * been exited, i.e. must the item be updated after the loop?
- */
-
- Lindex bi,si;
- bblock_p b,s;
-
- for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
- bi = Lnext(bi,lp->LP_BLOCKS)) {
- b = (bblock_p) Lelem(bi);
- for (si = Lfirst(b->b_succ); si != (Lindex) 0;
- si = Lnext(si,b->b_succ)) {
- s = (bblock_p) Lelem(si);
- if (!Lis_elem(s,lp->LP_BLOCKS) && MUST_UPDATE(item,s)) {
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-
-
-STATIC short countuses(usage,b)
- lset usage;
- bblock_p b;
-{
- short cnt = 0;
- Lindex ti;
- time_p t;
-
- for (ti = Lfirst(usage); ti != (Lindex) 0; ti = Lnext(ti,usage)) {
- t = (time_p) Lelem(ti);
- if (t->t_bblock == b) cnt++;
- }
- return cnt;
-}
-
-
-
-STATIC allocs_of_item(p,item,loops,sloopcnt,dloopcnt,alloc_list_p)
- proc_p p;
- item_p item;
- lset loops;
- short *sloopcnt,*dloopcnt; /* dynamic arrays */
- alloc_p *alloc_list_p;
-{
- register Lindex li;
- loop_p lp;
- bblock_p header,ini;
- short susecount,dusecount;
- interv_p lt;
- alloc_p wholeproc;
-
- /* The whole procedure may be used as timespan.
- The dynamic usecount of a procedure is taken to be the same
- as its static usecount; this number is not very important, as
- time-optimziation chooses loops first.
- */
- whole_lifetime(item,&ini,<);
- wholeproc = cons_alloc(item,lt,Lnrelems(item->it_usage),
- Lnrelems(item->it_usage), proc_inits(p,item,ini),
- (alloc_p) 0,FALSE,TRUE);
- insert_alloc(wholeproc, alloc_list_p);
- for (li = Lfirst(loops); li != (Lindex) 0; li = Lnext(li,loops)) {
- lp = (loop_p) Lelem(li);
- if (sloopcnt[lp->lp_id] != 0 && !updates_needed(lp,item)) {
- /* Item is used within loop, so consider loop
- * as a timespan during which item may be put in
- * a register.
- */
- if ((header = lp->LP_HEADER) == (bblock_p) 0 &&
- MUST_INIT(item,lp->lp_entry)) continue;
- lt = loop_lifetime(lp);
- susecount = sloopcnt[lp->lp_id];
- dusecount = dloopcnt[lp->lp_id];
- if (MUST_INIT(item,lp->lp_entry)) {
- /* include header block in timespan */
- add_interval(header->B_BEGIN,header->B_END,<);
- susecount += countuses(item->it_usage,header);
- } else {
- header = (bblock_p) 0;
- }
- insert_alloc(cons_alloc(item,lt,susecount,dusecount,
- loop_inits(lp,item,header),wholeproc,
- TRUE,FALSE),
- alloc_list_p);
- }
- }
-}
-
-
-
-alloc_p build_alloc_list(p,nrloops,itemlist)
- proc_p p;
- short nrloops;
- item_p itemlist;
-{
- short *sloopcnt,*dloopcnt; /* dynamic arrays */
- register item_p item;
- alloc_p alloc_list = (alloc_p) 0;
-
- sloopcnt = (short *) newtable(nrloops);
- dloopcnt = (short *) newtable(nrloops);
- for (item = itemlist; item != (item_p) 0; item = item->it_next) {
- count_usage(p,item,nrloops,sloopcnt,dloopcnt);
- allocs_of_item(p,item,p->p_loops,sloopcnt,dloopcnt,
- &alloc_list);
- }
- oldtable(sloopcnt,nrloops);
- oldtable(dloopcnt,nrloops);
- return alloc_list;
-}
-
-
-
-build_rivals_graph(alloclist)
- alloc_p alloclist;
-{
- /* See which allocations in the list are rivals of each other,
- * i.e. there is some point of time, falling in both
- * timespans, at which the items of both allocations are live.
- * Allocations with the same item (but different timespans) are
- * not considered to be rivals.
- * We use an auxiliary data structure "busy" for each allocation,
- * indicating when the item is live during the timespan of the
- * allocation.
- */
-
- register alloc_p alloc,x;
-
- for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- alloc->al_rivals = Cempty_set(alloc_id);
- }
- for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- alloc->al_busy =
- (alloc->al_item->it_type == LOCALVAR ?
- intersect(alloc->al_timespan,alloc->al_item->it_lives) :
- copy_timespan(alloc->al_timespan));
- for (x = alloclist; x != alloc; x = x->al_next) {
- if (x->al_item != alloc->al_item &&
- not_disjoint(alloc->al_busy,x->al_busy)) {
- Cadd(x->al_id,&alloc->al_rivals);
- Cadd(alloc->al_id,&x->al_rivals);
- if (alloc->al_regtype == x->al_regtype) {
- alloc->al_cntrivals++;
- x->al_cntrivals++;
- }
- }
- }
- }
-}
+++ /dev/null
-
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ A L L O C L I S T . H
- */
-
-extern alloc_p build_alloc_list(); /* (proc_p p; short nrloops;
- * item_p itemlist)
- * Build a list of possible allocations
- * for procedure p. An allocation
- * essentially is a pair (item,timespan)
- */
-extern build_rivals_graph(); /* (alloc_p alloclist)
- /* See which allocations in the list are
- * rivals of each other, i.e. there is
- * some point of time, falling in both
- * timespans, at which the items of
- * both allocations are live.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * A U X I L I A R Y R O U T I N E S
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/alloc.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-
-
-time_p cons_time(l,b)
- line_p l;
- bblock_p b;
-{
- /* Construct a time */
-
- time_p t = newtime();
-
- t->t_line = l;
- t->t_bblock = b;
- return t;
-}
-
-
-
-
-short loop_scale(lev)
- short lev;
-{
- return (lev == 0 ? 1 : (lev > 3 ? 20 : 5 * lev));
-}
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * A U X I L I A R Y R O U T I N E S
- */
-
-#define regv_size(off) regv_arg(off,2)
- /* Fetch the size argument of the
- * register message of the local with
- * the given offset.
- */
-#define regv_type(off) regv_arg(off,3)
- /* Fetch the type argument of the
- * register message of the local with
- * the given offset.
- */
-extern time_p cons_time(); /* (line_p l; bblock_p b)
- * Construct a 'time' record with
- * fields 'l' and 'b'.
- */
-extern short loop_scale(); /* (short lev)
- * Estimate how many times an item
- * appearing in a loop of nesting
- * level 'lev' will be used dynamically.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ I N T E R V A L . C
- */
-
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_interv.h"
-
-interv_p cons_interval(t_start,t_stop)
- short t_start,t_stop;
-{
- interv_p x;
-
- x = newinterval();
- x->i_start = t_start;
- x->i_stop = t_stop;
- return x;
-}
-
-
-
-add_interval(t1,t2,list)
- short t1,t2;
- interv_p *list;
-{
- /* Add interval (t1,t2) to the list of intervals (which is
- * an in-out parameter!). The list is sorted in 'chronological'
- * order. We attempt to keep the list as small as possible, by
- * putting adjacent intervals in one interval.
- */
-
- register interv_p x1, x2, *q;
- int adjacent = 0;
- interv_p x;
-
- q = list;
- x1 = (interv_p) 0;
- for (x2 = *list; x2 != (interv_p) 0; x2 = x2->i_next) {
- if (t2 < x2->i_start) break;
- x1 = x2;
- q = &x2->i_next;
- }
- /* Now interval (t1,t2) should be inserted somewhere in between
- * x1 and x2.
- */
- if (x1 != (interv_p) 0 && t1 == x1->i_stop + 1) {
- /* join x1 and (t1,t2) */
- x1->i_stop = t2;
- adjacent++;
- }
- if (x2 != (interv_p) 0 && t2 + 1 == x2->i_start) {
- /* join (t1,t2) and x2 */
- x2->i_start = t1;
- adjacent++;
- }
- if (adjacent == 0) {
- /* no adjacents, allocate a new intervalfor (t1,t2) */
- x = cons_interval(t1,t2);
- x->i_next = x2;
- *q = x;
- } else {
- if (adjacent == 2) {
- /* x1, (t1,t2) and x2 can be put in one interval */
- x1->i_stop = x2->i_stop;
- x1->i_next = x2->i_next;
- oldinterval(x2);
- }
- }
-}
-
-
-
-interv_p loop_lifetime(lp)
- loop_p lp;
-{
- /* Determine the timespan of the loop, expressed as a list
- * of intervals.
- */
-
- interv_p lt = 0;
- register bblock_p b;
- register Lindex bi;
-
- for (bi = Lfirst(lp->LP_BLOCKS); bi != (Lindex) 0;
- bi = Lnext(bi,lp->LP_BLOCKS)) {
- b = (bblock_p) Lelem(bi);
- add_interval(b->B_BEGIN,b->B_END,<);
- }
- return lt;
-}
-
-
-interv_p proc_lifetime(p)
- proc_p p;
-{
- /* Determine the lifetime of an entire procedure */
-
- register bblock_p b;
-
- for (b = p->p_start; b->b_next != (bblock_p) 0; b = b->b_next) ;
- return cons_interval(0,b->B_END);
-}
-
-
-
-STATIC set_min_max(iv1,iv2)
- interv_p *iv1,*iv2;
-{
- /* Auxiliary routine of intersect */
-
- interv_p i1 = *iv1, i2 = *iv2;
-
- if (i1->i_start < i2->i_start) {
- *iv1 = i1;
- *iv2 = i2;
- } else {
- *iv1 = i2;
- *iv2 = i1;
- }
-}
-
-
-
-interv_p intersect(list1,list2)
- interv_p list1,list2;
-{
- /* Intersect two lifetimes, each denoted by a list of intervals.
- * We maintain two pointers, pmin and pmax, pointing to the
- * next interval of each list. At any time, pmin points to the
- * interval of which i_start is lowest; pmax points to the
- * other interval (i.e. the next interval of the other list).
- */
-
- interv_p lt = 0;
- interv_p pmin,pmax;
-
-#define BUMP(p) p = p->i_next
-#define EMIT(t1,t2) add_interval(t1,t2,<)
-
- pmin = list1;
- pmax = list2;
- while (pmin != (interv_p) 0 && pmax != (interv_p) 0) {
- set_min_max(&pmin,&pmax);
- if (pmax->i_start > pmin->i_stop) {
- /* e.g. (5,7) and (9,13) */
- BUMP(pmin);
- } else {
- if (pmax->i_stop < pmin->i_stop) {
- /* e.g. (5,12) and (7,10) */
- EMIT(pmax->i_start,pmax->i_stop);
- BUMP(pmax);
- } else {
- /* e.g. (5,8) and (7,12) */
- EMIT(pmax->i_start,pmin->i_stop);
- if (pmax->i_stop == pmin->i_stop) {
- /* e.g. (5,12) and (7,12) */
- BUMP(pmax);
- }
- BUMP(pmin);
- }
- }
- }
- return lt;
-}
-
-
-
-bool not_disjoint(list1,list2)
- interv_p list1,list2;
-{
- /* See if list1 and list2 do overlap somewhere */
-
- interv_p pmin,pmax;
-
- pmin = list1;
- pmax = list2;
- while (pmin != (interv_p) 0 && pmax != (interv_p) 0) {
- set_min_max(&pmin,&pmax);
- if (pmax->i_start > pmin->i_stop) {
- /* e.g. (5,7) and (9,13) */
- BUMP(pmin);
- } else {
- return TRUE; /* not disjoint */
- }
- }
- return FALSE; /* disjoint */
-}
-
-
-
-bool contains(t,timespan)
- short t;
- interv_p timespan;
-{
- register interv_p iv;
-
- for (iv = timespan; iv != (interv_p) 0; iv = iv->i_next) {
- if (t <= iv->i_stop) return (t >= iv->i_start);
- }
- return FALSE;
-}
-
-
-
-interv_p copy_timespan(list)
- interv_p list;
-{
- /* copy the time span */
-
- interv_p x,y,head,*p;
-
- head = (interv_p) 0;
- p = &head;
-
- for (x = list; x != (interv_p) 0; x = x->i_next) {
- y = cons_interval(x->i_start,x->i_stop);
- *p = y;
- p = &y->i_next;
- }
- return head;
-}
+++ /dev/null
-
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ I N T E R V A L . H
- */
-
-
-extern interv_p cons_interval();/* (short t_start,t_stop)
- * construct an interval
- */
-extern add_interval(); /* (short t1,t2; interv_p *list)
- * Add interval (t1,t2) to the list of
- * intervals (which is an in-out parameter!).
- */
-extern interv_p loop_lifetime();/* (loop_p lp)
- * Determine the timespan of the loop,
- * expressed as a list of intervals.
- */
-extern interv_p proc_lifetime();/* (proc_p p)
- * Determine the timespan of a procedure,
- * expressed as an interval.
- */
-extern interv_p intersect(); /* (interv_p list1,list2)
- * Intersect two lifetimes, each denoted
- * by a list of intervals.
- */
-extern bool not_disjoint(); /* (interv_p list1,list2)
- * See if list1 and list2 do overlap somewhere.
- */
-extern bool contains(); /* (short t;interv_p timespan)
- * See if t is part of the timespan.
- */
-extern interv_p copy_timespan();/* (interv_p list)
- * Make a copy of the timespan.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ I T E M S . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../share/alloc.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-#include "ra_items.h"
-
-
-#include "itemtab.h"
-/* Maps EM mnemonics onto item types, e.g. op_lol -> LOCALVAR, op_ldc->DCONST,
- * generated from em_mmen.h and itemtab.src files.
- */
-
-#define SMALL_CONSTANT(c) (c >= 0 && c <= 8)
-/* prevent small constants from being put in a register */
-
-
-clean_tab(items)
- item_p items[];
-{
- int t;
-
- for (t = 0; t < NRITEMTYPES;t++) {
- items[t] = (item_p) 0;
- }
-}
-
-
-
-
-short item_type(l)
- line_p l;
-{
- int instr = INSTR(l);
- int t;
-
- if (instr < sp_fmnem || instr > sp_lmnem) return NO_ITEM;
- t = itemtab[instr - sp_fmnem].id_type;
- if (t == CONST && SMALL_CONSTANT(off_set(l))) return NO_ITEM;
- return t;
-}
-
-
-
-bool is_item(l)
- line_p l;
-{
- return item_type(l) != NO_ITEM;
-}
-
-
-item_p item_of(off,items)
- offset off;
- item_p items[];
-{
- register item_p x;
-
- for (x = items[LOCALVAR]; x != (item_p) 0; x = x->it_next) {
- if (off == x->i_t.it_off) {
- if (!x->it_desirable) break;
- /* don't put this item in reg */
- return x;
- }
- }
- return (item_p) 0;
-}
-
-
-
-fill_item(item,l)
- item_p item;
- line_p l;
-{
- item->it_type = item_type(l);
- switch(item->it_type) {
- case GLOBL_ADDR:
- item->i_t.it_obj = OBJ(l);
- break;
- case PROC_ADDR:
- item->i_t.it_proc = PROC(l);
- break;
- default:
- item->i_t.it_off = off_set(l);
- }
-}
-
-
-
-STATIC bool desirable(l)
- line_p l;
-{
- /* See if it is really desirable to put the item of line l
- * in a register. We do not put an item in a register if it
- * is used as 'address of array descriptor' of an array
- * instruction.
- */
-
- if (l->l_next != (line_p) 0) {
- switch(INSTR(l->l_next)) {
- case op_aar:
- case op_lar:
- case op_sar:
- return FALSE;
- }
- }
- return TRUE;
-}
-
-
-
-STATIC int cmp_items(a,b)
- item_p a,b;
-{
- /* This routine defines the <, = and > relations between items,
- * used to sort them for fast lookup.
- */
-
- offset n1,n2;
-
- switch(a->it_type) {
- case GLOBL_ADDR:
- assert(b->it_type == GLOBL_ADDR);
- n1 = (offset) a->i_t.it_obj->o_id;
- n2 = (offset) b->i_t.it_obj->o_id;
- break;
- case PROC_ADDR:
- assert(b->it_type == PROC_ADDR);
- n1 = (offset) a->i_t.it_proc->p_id;
- n2 = (offset) b->i_t.it_proc->p_id;
- break;
- default:
- n1 = a->i_t.it_off;
- n2 = b->i_t.it_off;
- }
- return (n1 == n2 ? 0 : (n1 > n2 ? 1 : -1));
-}
-
-
-
-bool same_item(a,b)
- item_p a,b;
-{
- return cmp_items(a,b) == 0;
-}
-
-
-STATIC bool lt_item(a,b)
- item_p a,b;
-{
- return cmp_items(a,b) == -1;
-}
-
-
-
-/* build_itemlist()
- *
- * Build a list of all items used in the current procedure. An item
- * is anything that can be put in a register (a local variable, a constant,
- * the address of a local or global variable).
- * For each type of item we use a sorted list containing all items of
- * that type found so far.
- * A local variable is only considered to be an item if there is a
- * register message for it (indicating it is never accessed indirectly).
- * For each item, we keep track of all places where it is used
- * (either fetched or stored into). The usage of a local variable is also
- * considered to be a usage of its address.
- */
-
-
-
-static item_p items[NRITEMTYPES]; /* items[i] points to the list of type i */
-
-
-
-STATIC short reg_type(item)
- item_p item;
-{
- /* See which type of register the item should best be assigned to */
-
- switch(item->it_type) {
- case LOCALVAR:
- return regv_type(item->i_t.it_off);
- /* use type mentioned in reg. message for local */
- case LOCAL_ADDR:
- case GLOBL_ADDR:
- case PROC_ADDR:
- return reg_pointer;
- case CONST:
- case DCONST:
- return reg_any;
- default: assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC short item_size(item)
- item_p item;
-{
- /* Determine the size of the item (in bytes) */
-
- switch(item->it_type) {
- case LOCALVAR:
- return regv_size(item->i_t.it_off);
- /* use size mentioned in reg. message for local */
- case LOCAL_ADDR:
- case GLOBL_ADDR:
- case PROC_ADDR:
- return ps; /* pointer size */
- case CONST:
- return ws; /* word size */
- case DCONST:
- return 2 * ws; /* 2 * word size */
- default: assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC init_item(a,b)
- item_p a,b;
-{
- a->it_type = b->it_type;
- switch(a->it_type) {
- case GLOBL_ADDR:
- a->i_t.it_obj = b->i_t.it_obj;
- break;
- case PROC_ADDR:
- a->i_t.it_proc = b->i_t.it_proc;
- break;
- default:
- a->i_t.it_off = b->i_t.it_off;
- }
- a->it_usage = Lempty_set();
- a->it_regtype = reg_type(b);
- a->it_size = item_size(b);
- a->it_desirable = b->it_desirable;
-}
-
-
-
-STATIC add_item(item,t,items)
- item_p item;
- time_p t;
- item_p items[];
-{
- /* See if there was already a list element for item. In any
- * case record the fact that item is used at 't'.
- */
-
- register item_p x, *q;
-
- q = &items[item->it_type]; /* each type has its own list */
- for (x = *q; x != (item_p) 0; x = *q) {
- if (same_item(x,item)) {
- /* found */
- if (!item->it_desirable) {
- x->it_desirable = FALSE;
- }
- Ladd(t,&x->it_usage);
- return; /* done */
- }
- if (lt_item(item,x)) break;
- q = &x->it_next;
- }
- /* not found, allocate new item; q points to it_next field of
- * the item after which the new item should be put.
- */
- x = newitem();
- x->it_next = *q;
- *q = x;
- init_item(x,item);
- Ladd(t,&x->it_usage);
-}
-
-
-
-STATIC add_usage(l,b,items)
- line_p l;
- bblock_p b;
- item_p items[];
-{
- /* An item is used at line l. Add it to the list of items.
- * A local variable is only considered to be an item, if
- * there is a register message for it; else its address
- * is also considered to be an item.
- */
-
- struct item thisitem;
-
- fill_item(&thisitem,l); /* fill in some fields */
- if (!desirable(l)) {
- thisitem.it_desirable = FALSE; /* don't put item in reg. */
- }
- if (thisitem.it_type == LOCALVAR && !is_regvar(thisitem.i_t.it_off)) {
- /* Use address of local instead of local itself */
- thisitem.it_type = LOCAL_ADDR;
- thisitem.it_regtype = reg_pointer;
- }
- add_item(&thisitem,cons_time(l,b),items);
-}
-
-
-
-build_itemlist(p,items,nrinstr_out)
- proc_p p;
- item_p items[];
- int *nrinstr_out;
-{
- /* Make a list of all items used in procedure p.
- * An item is anything that can be put in a register,
- * such as a local variable, a constant etc.
- * As a side effect, determine the number of instructions of p.
- */
-
- register line_p l;
- register bblock_p b;
- register cnt= 0;
-
- clean_tab(items);
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (is_item(l)) {
- add_usage(l,b,items);
- }
- cnt++;
- }
- }
- *nrinstr_out = cnt;
-}
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ I T E M S . H
- */
-
-extern short item_type(); /* (line_p l)
- * Determine the type of item (constant,local
- * variable etc.) accessed by l.
- */
-extern bool is_item(); /* (line_p l)
- * See if l accesses an item
- */
-extern item_p item_of(); /* (offset off;item_p items)
- * Determine the descriptor of the item
- * accessed by l; return 0 if not found
- */
-extern fill_item(); /* (item_p item;line_p l)
- * Compute the type and obj/off attributes
- * of the item accessed by l and put them
- * in the given item descriptor.
- */
-extern bool same_item(); /* (item_p a,b)
- * See if a and b are the same items.
- */
-extern build_itemlist(); /* (proc_p p;item_p items[]; int *nrinstr_out)
- * Determine all items accessed by procedure p
- * and put them in the items lists. All items
- * of type T must be put in list items[T].
- * Also determine the number of instructions
- * of p.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ L I F E T I M E . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../share/alloc.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-#include "ra_items.h"
-#include "ra_lifet.h"
-
-
-#define MSG_OFF(l) aoff(ARG(l),1)
-#define is_livemsg(l) (INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_liv)
-#define is_deadmsg(l) (INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_ded)
-
-build_lifetimes(items)
- item_p items[];
-{
- /* compute the it_lives attribute of every item; this is
- * a list of intervals during which the item is live,
- * i.e. its current value may be used.
- * We traverse the EM text of the current procedure in
- * lexical order. If we encounter a live-message, we store
- * the number ('time') of the current instruction in the
- * it_lastlive attribute of the concerning item. If we see
- * a dead-message for that item, we know that the item is
- * live in between these two pseudo's. If the first message
- * appearing in the procedure is a dead-message, the item
- * is live from time 0 (start of procedure) till now. (Note
- * that it_lastlive is initially 0!).
- * The lifetime ends on the last instruction before the
- * dead-message that is not a live -or dead message.
- */
-
- register line_p l;
- register short now;
- item_p item;
- short last_code;
-
- last_code = 0;
- for (now = 0; now < nrinstrs; now++) {
- l = instrmap[now];
- if (is_livemsg(l)) {
- item = item_of(MSG_OFF(l),items);
- /* A local variable that is never used is NOT an
- * item; yet, there may be a register message for it...
- */
- if(item != (item_p) 0) {
- item->it_lastlive = now;
- }
- } else {
- if (is_deadmsg(l)) {
- item = item_of(MSG_OFF(l),items);
- if (item != (item_p) 0) {
- add_interval(item->it_lastlive,
- last_code, &item->it_lives);
- }
- } else {
- last_code = now;
- }
- }
- }
-}
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ L I F E T I M E . H
- */
-
-
-extern build_lifetimes(); /* item_p items[];
- * compute the it_lives attribute of every
- * item; this is a list of intervals
- * during which the item is live,
- * i.e. its current value may be used.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ P A C K . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-#include "ra_interv.h"
-
-
-short regs_occupied[NRREGTYPES]; /* #occupied registers for reg_pointer,
- * reg_any etc.
- */
-#define reg_available(t) (regs_available[t] > regs_occupied[t])
-
-STATIC init_regcount()
-{
- int t;
-
- for (t = 0; t < NRREGTYPES; t++) {
- regs_occupied[t] = 0;
- }
-}
-
-STATIC alloc_p make_dummy()
-{
- alloc_p x;
-
- x = newalloc();
- /* x->al_profits = 0; */
- return x;
-}
-
-
-STATIC bool fits_in(a,b,cont_item)
- alloc_p a,b;
- bool *cont_item;
-{
- /* See if allocation a can be assigned the same register as b.
- * Both allocations should be of the same register-type.
- * Note that there may be several other allocations (mates) assigned to
- * the same register as b. A new candidate (i.e. 'a') is only
- * allowed to join them if it is not the rival of any resident
- * allocation.
- */
-
- *cont_item = FALSE;
- if (a->al_regtype == b->al_regtype) {
- while (b != (alloc_p) 0) {
- if (Cis_elem(a->al_id,b->al_rivals)) break;
- b = b->al_mates;
- if (a->al_item == b->al_item) {
- *cont_item = TRUE;
- }
- }
- }
- return b == (alloc_p) 0;
-}
-
-
-STATIC alloc_p find_fitting_alloc(alloc,packed)
- alloc_p alloc,packed;
-{
- /* Try to find and already packed allocation that is assigned
- * a register that may also be used for alloc.
- * We prefer allocations that have the same item as alloc.
- */
-
- register alloc_p x;
- alloc_p cand = (alloc_p) 0;
- bool cont_item;
-
- for (x = packed->al_next; x != (alloc_p) 0; x = x->al_next) {
- if (fits_in(alloc,x,&cont_item)) {
- cand = x;
- if (cont_item) break;
- }
- }
- return cand;
-}
-
-
-STATIC bool room_for(alloc,packed)
- alloc_p alloc,packed;
-{
- /* See if there is any register available for alloc */
-
- return reg_available(alloc->al_regtype) ||
- (find_fitting_alloc(alloc,packed) != (alloc_p) 0);
-}
-
-
-
-STATIC alloc_p best_alloc(unpacked,packed,time_opt)
- alloc_p unpacked,packed;
- bool time_opt;
-{
- /* Find the next best candidate */
-
- register alloc_p x,best;
- bool loops_only;
-
- for (loops_only = time_opt; ; loops_only = FALSE) {
- /* If we're optimizing execution time, we first
- * consider loops.
- */
- best = unpacked; /* dummy */
- for (x = unpacked->al_next; x != (alloc_p) 0; x = x->al_next) {
- if ((!loops_only || x->al_isloop) &&
- x->al_profits > best->al_profits &&
- room_for(x,packed)) {
- best = x;
- }
- }
- if (best != unpacked || !loops_only) break;
- }
- return (best == unpacked ? (alloc_p) 0 : best);
-}
-
-
-
-
-STATIC alloc_p choose_location(alloc,packed,p)
- alloc_p alloc,packed;
- proc_p p;
-{
- /* Decide in which register to put alloc */
-
- alloc_p fit;
- offset dum;
-
- fit = find_fitting_alloc(alloc,packed);
- if (fit == (alloc_p) 0) {
- /* Take a brand new register; allocate a dummy local for it */
- alloc->al_regnr = regs_occupied[alloc->al_regtype]++;
- dum = tmplocal(p,alloc->al_item->it_size);
- alloc->al_dummy = dum;
- } else {
- alloc->al_regnr = fit->al_regnr;
- alloc->al_dummy = fit->al_dummy;
- }
- return fit;
-}
-
-
-
-STATIC update_lists(alloc,unpacked,packed,fit)
- alloc_p alloc,unpacked,packed,fit;
-{
- /* 'alloc' has been granted a register; move it from the 'unpacked'
- * list to the 'packed' list. Also remove any allocation from 'unpacked'
- * having:
- * 1. the same item as 'alloc' and
- * 2. a timespan that overlaps the timespan of alloc.
- */
-
- register alloc_p x,q,next;
-
- q = unpacked; /* dummy element at head of list */
- for (x = unpacked->al_next; x != (alloc_p) 0; x = next) {
- next = x->al_next;
- if (x->al_item == alloc->al_item &&
- not_disjoint(x->al_timespan, alloc->al_timespan)) {
- /* this code kills two birds with one stone;
- * x is either an overlapping allocation or
- * alloc itself!
- */
- q->al_next = x->al_next;
- if (x == alloc) {
- if (fit == (alloc_p) 0) {
- x->al_next = packed->al_next;
- packed->al_next = x;
- } else {
- x->al_mates = fit->al_mates;
- fit->al_mates = x;
- x->al_next = (alloc_p) 0;
- }
- }
- } else {
- q = x;
- }
- }
-}
-
-
-
-STATIC short cum_profits(alloc)
- alloc_p alloc;
-{
- /* Add the profits of all allocations packed in the same
- * register as alloc (i.e. alloc and all its 'mates').
- */
-
- alloc_p m;
- short sum = 0;
-
- for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
- sum += m->al_profits;
- }
- return sum;
-}
-
-
-
-STATIC alloc_p best_cumprofits(list,x_out,prev_out)
- alloc_p list, *x_out, *prev_out;
-{
- /* Find the allocation with the best cummulative profits */
-
- register alloc_p x,prev,best_prev;
- short best = 0, cum;
-
- prev = list;
- for (x = list->al_next; x != (alloc_p) 0; x = x->al_next) {
- cum = cum_profits(x);
- if (cum > best) {
- best = cum;
- best_prev = prev;
- }
- prev = x;
- }
- if (best == 0) {
- *x_out = (alloc_p) 0;
- } else {
- *x_out = best_prev->al_next;
- *prev_out = best_prev;
- }
-}
-
-
-
-STATIC account_regsave(packed,unpacked)
- alloc_p packed,unpacked;
-{
- /* After all packing has been done, we check for every allocated
- * register whether it is really advantageous to use this
- * register. It may be possible that the cost of saving
- * and restoring the register are higher than the profits of all
- * allocations packed in the register. If so, we simply remove
- * all these allocations.
- * The cost of saving/restoring one extra register may depend on
- * the number of registers already saved.
- */
-
- alloc_p x,prev,checked;
- short time,space;
- short tot_cost = 0,diff;
-
- init_regcount();
- checked = make_dummy();
- while (TRUE) {
- best_cumprofits(packed,&x,&prev);
- if (x == (alloc_p) 0) break;
- regs_occupied[x->al_regtype]++;
- regsave_cost(regs_occupied,&time,&space);
- diff = add_timespace(time,space) - tot_cost;
- if (diff < cum_profits(x)) {
- /* x is o.k. */
- prev->al_next = x->al_next;
- x->al_next = checked->al_next;
- checked->al_next = x;
- tot_cost += diff;
- } else {
- break;
- }
- }
- /* Now every allocation in 'packed' does not pay off, so
- * it is moved to unpacked, indicating it will not be assigned
- * a register.
- */
- for (x = unpacked; x->al_next != (alloc_p) 0; x = x->al_next);
- x->al_next = packed->al_next;
- packed->al_next = checked->al_next;
- oldalloc(checked);
-}
-
-
-
-STATIC bool in_single_reg(item,packed)
- item_p item;
- alloc_p packed;
-{
- /* See if item is allocated in only one register (i.e. not in
- * several different registers during several parts of its lifetime.
- */
-
- register alloc_p x,m;
- bool seen = FALSE;
-
- for (x = packed->al_next; x != (alloc_p) 0; x = x->al_next) {
- for ( m = x; m != (alloc_p) 0; m = m->al_mates) {
- if (m->al_item == item) {
- if (seen) return FALSE;
- seen = TRUE;
- break;
- }
- }
- }
- return TRUE;
-}
-
-
-
-STATIC alloc_p find_prev(alloc,list)
- alloc_p alloc,list;
-{
- register alloc_p x;
-
- assert ( alloc != (alloc_p) 0);
- for (x = list; x->al_next != alloc ; x = x->al_next)
- assert(x != (alloc_p) 0);
- return x;
-}
-
-
-
-STATIC repl_allocs(new,old,packed)
- alloc_p new,old,packed;
-{
- alloc_p x,next,prev,*p;
- new->al_regnr = old->al_regnr;
- new->al_dummy = old->al_dummy;
- prev = find_prev(old,packed);
- new->al_next = old->al_next;
- old->al_next = (alloc_p) 0;
- prev->al_next = new;
- new->al_mates = old;
- p = &new->al_mates;
- for (x = old; x != (alloc_p) 0; x = next) {
- next = x->al_mates;
- if (x->al_item == new->al_item) {
- *p = next;
- oldalloc(x);
- } else {
- p = &x->al_mates;
- }
- }
-}
-
-
-
-STATIC assemble_allocs(packed)
- alloc_p packed;
-{
- register alloc_p x,m,next;
- alloc_p e;
- bool voidb;
-
- for (x = packed->al_next; x != (alloc_p) 0; x = next) {
- next = x->al_next;
- for ( m = x; m != (alloc_p) 0; m = m->al_mates) {
- if (in_single_reg(m->al_item,packed) &&
- (e = m->al_wholeproc) != (alloc_p) 0 &&
- e->al_profits > 0 &&
- fits_in(e,x,&voidb)) {
- repl_allocs(e,x,packed);
- break;
- }
- }
- }
-}
-
-pack(alloclist,time_opt,packed_out,not_packed_out,p)
- alloc_p alloclist, *packed_out,*not_packed_out;
- bool time_opt;
- proc_p p;
-{
- /* This is the packing system. It decides which allations
- * to grant a register.
- * We use two lists: packed (for allocations that are assigned a
- * register) and unpacked (allocations not yet assigned a register).
- * The packed list is in fact '2-dimensional': the al_next field is
- * used to link allations that are assigned different registers;
- * the al_mates field links allocations that are assigned to
- * the same registers (i.e. these allocations fit together).
- */
-
- register alloc_p x;
- alloc_p packed,unpacked,fit;
-
- init_regcount();
- packed = make_dummy();
- unpacked = make_dummy();
- unpacked->al_next = alloclist;
- while ((x = best_alloc(unpacked,packed,time_opt)) != (alloc_p) 0) {
- fit = choose_location(x,packed,p);
- update_lists(x,unpacked,packed,fit);
- }
- assemble_allocs(packed);
- account_regsave(packed,unpacked);
- /* remove allocations that don't pay off against register
- * save/restore costs.
- */
- *packed_out = packed->al_next;
- *not_packed_out = unpacked->al_next;
- oldalloc(packed);
- oldalloc(unpacked);
-}
+++ /dev/null
-
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ P A C K . H
- */
-
-extern pack(); /* ( alloc_p alloclist, *packed_out,*not_packed_out;
- * bool time_opt; proc_p p)
- * This is the packing system. It decides which
- * allations to grant a register.
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ P R O F I T S . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/lset.h"
-#include "../share/global.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_aux.h"
-#include "ra_profits.h"
-
-STATIC bool test_cond(cond,val)
- short cond;
- offset val;
-{
- switch(cond) {
- case DEFAULT:
- return TRUE;
- case FITBYTE:
- return val >= -128 && val < 128;
- case IN_0_63:
- return val >= 0 && val <= 63;
- case IN_0_8:
- return val >= 0 && val <= 8;
- }
-}
-
-STATIC short map_value(tab,val,time)
- struct cond_tab tab[];
- offset val;
- bool time;
-{
- cond_p p;
-
- for (p = &tab[0]; ; p++) {
- if (test_cond(p->mc_cond,val)) {
- return (time ? p->mc_tval : p->mc_sval);
- }
- }
-}
-
-
-STATIC short index_value(tab,n,time)
- struct cond_tab tab[];
- short n;
- bool time;
-{
- cond_p p;
-
- p = &tab[n];
- return (time ? p->mc_tval : p->mc_sval);
-}
-
-
-allocscore(itemtyp,localtyp,size,off,totyp,time_out,space_out)
- short itemtyp, localtyp,totyp,size;
- offset off;
- short *time_out, *space_out;
-{
- cond_p m;
-
- if (localtyp == reg_loop) localtyp = reg_any;
- if (size == ws || size ==ps && totyp == reg_pointer) {
- switch(itemtyp) {
- case LOCALVAR:
- m = alocaltab[localtyp][totyp];
- break;
- case LOCAL_ADDR:
- m = alocaddrtab[localtyp][totyp];
- break;
- case CONST:
- m = aconsttab;
- break;
- case DCONST:
- m = aconsttab;
- break;
- case GLOBL_ADDR:
- m = aglobaltab;
- break;
- case PROC_ADDR:
- m = aproctab;
- break;
- }
- } else {
- m = (cond_p) 0;
- }
- *time_out = (m == (cond_p) 0 ? -1 : map_value(m,off,TRUE));
- *space_out = (m == (cond_p) 0 ? -1 : map_value(m,off,FALSE));
- /*
- printf("itemtyp = %d, localtyp = %d off = %D\n",itemtyp,localtyp,off);
- printf("ALLOCSCORE = (%d,%d)\n",*time_out,*space_out);
- */
-}
-
-opening_cost(itemtyp,localtyp,off,time_out,space_out)
- short itemtyp, localtyp;
- offset off;
- short *time_out, *space_out;
-{
- cond_p m;
-
- if (localtyp == reg_loop) localtyp = reg_any;
- switch(itemtyp) {
- case LOCALVAR:
- m = olocaltab[localtyp];
- break;
- case LOCAL_ADDR:
- m = olocaddrtab[localtyp];
- break;
- case CONST:
- m = oconsttab;
- break;
- case DCONST:
- m = oconsttab;
- break;
- case GLOBL_ADDR:
- m = oglobaltab;
- break;
- case PROC_ADDR:
- m = oproctab;
- break;
- }
- *time_out = (m == (cond_p) 0 ? 1000 : map_value(m,off,TRUE));
- *space_out = (m == (cond_p) 0 ? 1000 : map_value(m,off,FALSE));
- /*
- printf("itemtyp = %d, localtyp = %d off = %D\n",itemtyp,localtyp,off);
- printf("OPEN_COST = (%d,%d)\n",*time_out,*space_out);
- */
-}
-
-
-
-
-short regsave_cost(regs,time_out,space_out)
- short regs[], *time_out, *space_out;
-{
- /* Estimate the costs of saving and restoring the registers
- * The array regs contains the number of registers of every
- * possible type.
- */
-
- short n = regs[reg_any] + regs[reg_pointer] + regs[reg_float];
- /* #registers */
-
- *time_out = index_value(regsav_cost,n,TRUE);
- *space_out = index_value(regsav_cost,n,FALSE);
- /*
- printf("REGSAVE COST, n=%d, (%d,%d)\n",n,*time_out,*space_out);
- */
-}
-
-
-
-STATIC short dyn_inits(inits)
- lset inits;
-{
- Lindex i;
- short sum = 0;
- bblock_p b;
-
- for (i = Lfirst(inits); i != (Lindex) 0; i = Lnext(i,inits)) {
- b = (bblock_p) Lelem(i);
- sum += loop_scale(Lnrelems(b->b_loops));
- }
- return sum;
-}
-
-
-
-compute_profits(alloclist,time_opt)
- alloc_p alloclist;
- bool time_opt;
-{
- /* Compute the profits attribute of every allocation.
- * If the item of an allocation may be put in several types
- * of register, we choose only the most advanteagous one.
- */
-
- register alloc_p alloc;
- short s,t,rtyp,maxsc;
- item_p item;
- short time,space,sc;
- short otime,ospace;
- offset off;
- short cnt,nr_inits;
-
- for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- maxsc = 0;
- item = alloc->al_item;
- switch(item->it_type) {
- case LOCALVAR:
- case LOCAL_ADDR:
- case CONST:
- case DCONST:
- off = item->i_t.it_off;
- break;
- default:
- off = 0;
- }
- for (rtyp = item->it_regtype; ; rtyp = reg_any) {
- allocscore( item->it_type,
- item->it_regtype,
- item->it_size,
- off,
- rtyp,
- &time,
- &space);
- opening_cost( item->it_type,
- item->it_regtype,
- off,
- &otime,
- &ospace);
- nr_inits = Lnrelems(alloc->al_inits);
- s = alloc->al_susecount * space -
- nr_inits*ospace;
- if (!alloc->al_isloop && nr_inits > 0) {
- /* might lead to increase of execution time */
- cnt = 0;
- } else {
- cnt = alloc->al_dusecount;
- }
- t = cnt * time - dyn_inits(alloc->al_inits) * otime;
- sc = (time_opt ? t : s);
- if (sc >= maxsc) {
- maxsc = sc;
- alloc->al_regtype = rtyp;
- alloc->al_profits = sc;
- }
- if (rtyp == reg_any) break;
- }
- }
-}
+++ /dev/null
-
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ P R O F I T S . H
- */
-
-extern compute_profits();/* (alloc_p alloclist)
- * Compute the profits attribute of every allocation.
- */
-short regsave_cost(); /* (short regs[], *time_out, *space_out)
- */
+++ /dev/null
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ X F O R M . C
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/def.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../share/alloc.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mes.h"
-#include "../../../h/em_reg.h"
-#include "ra.h"
-#include "ra_interv.h"
-#include "ra_xform.h"
-#include "ra_items.h"
-
-
-/* The replacement table is used to transform instructions that reference
- * items other than local variables (i.e. the address of a local or global
- * variable or a single/double constant; the transformation of an instruction
- * that references a local variable is very simple).
- * The generated code depends on the word and pointer size of the target
- * machine.
- */
-
-
-struct repl {
- short r_instr; /* instruction */
- short r_op; /* operand */
-};
-
-/* REGNR,NO and STOP should not equal the wordsize or pointer size
- * of any machine.
- */
-#define REGNR -3
-#define NO -2
-#define STOP -1
-#define PS 0
-#define PS2 1
-#define WS 2
-#define WS2 3
-
-#define LOAD_POINTER op_nop
-#define BLANK {0, STOP}
-
-#define NRREPLACEMENTS 13
-#define REPL_LENGTH 3
-
-struct repl repl_tab[NRREPLACEMENTS][REPL_LENGTH] = {
- /* 0 */ {{op_lil, REGNR}, BLANK, BLANK},
- /* 1 */ {{LOAD_POINTER,REGNR}, {op_loi,PS}, {op_loi,WS}},
- /* 2 */ {{LOAD_POINTER,REGNR}, BLANK, BLANK},
- /* 3 */ {{LOAD_POINTER,REGNR}, {op_loi,WS2}, BLANK},
- /* 4 */ {{op_sil,REGNR}, BLANK, BLANK},
- /* 5 */ {{LOAD_POINTER,REGNR}, {op_loi,PS}, {op_sti,WS}},
- /* 6 */ {{LOAD_POINTER,REGNR}, {op_sti,WS2}, BLANK},
- /* 7 */ {{op_lil,REGNR}, {op_inc,NO}, {op_sil,REGNR}},
- /* 8 */ {{op_lil,REGNR}, {op_dec,NO}, {op_sil,REGNR}},
- /* 9 */ {{op_zer,WS}, {op_sil,REGNR}, BLANK},
- /*10 */ {{op_lol,REGNR}, BLANK, BLANK},
- /*11 */ {{op_ldl,REGNR}, BLANK, BLANK},
- /*12 */ {{LOAD_POINTER,REGNR}, {op_cai,NO}, BLANK},
-};
-
-
-
-
-init_replacements(psize,wsize)
- short psize,wsize;
-{
- /* The replacement code to be generated depends on the
- * wordsize and pointer size of the target machine.
- * The replacement table is initialized with a description
- * of which sizes to use. This routine inserts the real sizes.
- * It also inserts the actual EM instruction to be used
- * as a 'Load pointer' instruction.
- */
-
- register int i,j;
- short load_pointer;
- struct repl *r;
-
- assert (psize == wsize || psize == 2*wsize);
- load_pointer = (psize == wsize ? op_lol : op_ldl);
- for (i = 0; i < NRREPLACEMENTS; i++) {
- for (j = 0; j < REPL_LENGTH; j++) {
- r = &repl_tab[i][j];
- if (r->r_op == STOP) break;
- if (r->r_instr == LOAD_POINTER) {
- r->r_instr = load_pointer;
- }
- switch (r->r_op) {
- /* initially r_op describes how to compute
- * the real operand of the instruction. */
- case PS2:
- r->r_op = 2*psize;
- break;
- case PS:
- r->r_op = psize;
- break;
- case WS2:
- r->r_op = 2*wsize;
- break;
- case WS:
- r->r_op = wsize;
- break;
- case NO:
- case REGNR: /* use offset of dummy local,
- * will be filled in later.
- */
- break;
- default: assert(FALSE);
- }
- }
- }
-}
-
-
-
-STATIC int repl_index(l)
- line_p l;
-{
- return itemtab[INSTR(l) - sp_fmnem].id_replindex;
-}
-
-
-
-STATIC bool is_current(alloc,t)
- alloc_p alloc;
- short t;
-{
- /* Is time t part of alloc's timespan? */
-
- return contains(t,alloc->al_timespan);
-}
-
-
-STATIC match_item(item,l)
- item_p item;
- line_p l;
-{
- /* See if the item used by l is the same one as 'item' */
- struct item thisitem;
-
- fill_item(&thisitem,l);
- if (item->it_type == LOCAL_ADDR && thisitem.it_type == LOCALVAR) {
- /* The usage of a local variable is also considered to
- * be the usage of the address of that variable.
- */
- thisitem.it_type = LOCAL_ADDR;
- }
- return item->it_type == thisitem.it_type && same_item(item,&thisitem);
-}
-
-
-
-STATIC alloc_p find_alloc(alloclist,l,t)
- alloc_p alloclist;
- line_p l;
- short t;
-{
- /* See if any of the allocations of the list applies to instruction
- * l at time t.
- */
-
- register alloc_p alloc,m;
-
- for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
- if (is_current(m,t) && match_item(m->al_item,l)) {
- return m;
- }
- }
- }
- return (alloc_p) 0;
-}
-
-
-STATIC replace_line(l,b,list)
- line_p l,list;
- bblock_p b;
-{
- if (b->b_start == l) {
- b->b_start = list;
- } else {
- PREV(l)->l_next = list;
- }
- PREV(list) = PREV(l);
- while (list->l_next != (line_p) 0) {
- list = list->l_next;
- }
- list->l_next = l->l_next;
- if (l->l_next != (line_p) 0) {
- PREV(l->l_next) = list;
- }
- oldline(l);
-}
-
-
-STATIC line_p repl_code(lnp,regnr)
- line_p lnp;
- offset regnr;
-{
- line_p head,*q,l,prev = (line_p) 0;
- int i,index;
- struct repl *r;
-
- q = &head;
- index = repl_index(lnp);
- for (i = 0; i < REPL_LENGTH; i++) {
- r = &repl_tab[index][i];
- if (r->r_op == STOP) break; /* replacement < REPL_LENGTH */
- switch(r->r_op) {
- case REGNR:
- l = int_line(regnr);
- break;
- case NO:
- l = newline(OPNO);
- break;
- default:
- l = newline(OPSHORT);
- SHORT(l) = r->r_op;
- break;
- }
- *q = l;
- l->l_instr = r->r_instr;
- PREV(l) = prev;
- prev = l;
- q = &l->l_next;
- }
- return head;
-}
-
-
-
-STATIC apply_alloc(b,l,alloc)
- bblock_p b;
- line_p l;
- alloc_p alloc;
-{
- /* 'l' is an EM instruction using an item that will be put in
- * a register. Generate new code that uses the register instead
- * of the item.
- * If the item is a local variable the new code is the same as
- * the old code, except for the fact that the offset of the
- * local is changed (it now uses the dummy local that will be
- * put in a register by the code generator).
- * If the item is a constant, the new code is a LOL or LDL.
- * If the item is the address of a local or global variable, things
- * get more complicated. The new code depends on the instruction
- * that uses the item (i.e. l). The new code, which may consist of
- * several instructions, is obtained by consulting a replacement
- * table.
- */
-
- line_p newcode;
-
- if (alloc->al_item->it_type == LOCALVAR) {
- SHORT(l) = alloc->al_dummy;
- } else {
- newcode = repl_code(l,alloc->al_dummy);
- replace_line(l,b,newcode);
- }
-}
-
-
-
-STATIC int loaditem_tab[NRITEMTYPES][2] =
-{ /* WS 2 * WS */
- /*LOCALVAR*/ op_lol, op_ldl,
- /*LOCAL_ADDR*/ op_lal, op_lal,
- /*GLOBL_ADDR*/ op_lae, op_lae,
- /*PROC_ADDR*/ op_lpi, op_lpi,
- /*CONST*/ op_loc, op_nop,
- /*DCONST*/ op_nop, op_ldc
-};
-
-
-STATIC line_p load_item(item)
- item_p item;
-{
- /* Generate an EM instruction that loads the item on the stack */
-
- line_p l;
-
- switch (item->it_type) {
- case GLOBL_ADDR:
- l = newline(OPOBJECT);
- OBJ(l) = item->i_t.it_obj;
- break;
- case PROC_ADDR:
- l = newline(OPPROC);
- PROC(l) = item->i_t.it_proc;
- break;
- default:
- l = int_line(item->i_t.it_off);
- }
- l->l_instr = loaditem_tab[item->it_type][item->it_size == ws ? 0 : 1];
- assert(l->l_instr != op_nop);
- return l;
-}
-
-
-STATIC line_p store_local(size,off)
- short size;
- offset off;
-{
- line_p l = int_line(off);
-
- l->l_instr = (size == ws ? op_stl : op_sdl);
- return l;
-}
-
-
-
-STATIC line_p init_place(b)
- bblock_p b;
-{
-
- register line_p l,prev;
-
- prev = (line_p) 0;
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- switch(INSTR(l)) {
- case ps_mes:
- case ps_pro:
- case op_lab:
- break;
- default:
- return prev;
- }
- prev =l;
- }
- return prev;
-}
-
-
-
-STATIC append_code(l1,l2,b)
- line_p l1,l2;
- bblock_p b;
-{
- /* Append instruction l1 and l2 at begin of block b */
-
- line_p l;
-
- DLINK(l1,l2);
- l = init_place(b);
- if (l == (line_p) 0) {
- l2->l_next = b->b_start;
- b->b_start = l1;
- PREV(l1) = (line_p) 0;
- } else {
- l2->l_next = l->l_next;
- DLINK(l,l1);
- }
- if (l2->l_next != (line_p) 0) {
- PREV(l2->l_next) = l2;
- }
-}
-
-
-
-STATIC emit_init_code(list)
- alloc_p list;
-{
- /* Emit initialization code for all packed allocations.
- * This code looks like "dummy_local := item", e.g.
- * "LOC 25 ; STL -10" in EM terminology.
- */
-
- register alloc_p alloc,m;
- Lindex bi;
- bblock_p b;
-
- for (alloc = list; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
- for (bi = Lfirst(m->al_inits); bi != (Lindex) 0;
- bi = Lnext(bi,m->al_inits)) {
- /* "inits" contains all initialization points */
- b = (bblock_p) Lelem(bi);
- append_code(load_item(m->al_item),
- store_local(m->al_item->it_size,
- m->al_dummy),
- b);
- }
- }
- }
-}
-
-
-
-STATIC emit_mesregs(p,alloclist)
- proc_p p;
- alloc_p alloclist;
-{
- line_p l,m,x;
- alloc_p alloc;
-
-
- l = p->p_start->b_start;
- x = l->l_next;
- for (alloc = alloclist; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- m = reg_mes(alloc->al_dummy,alloc->al_item->it_size,
- alloc->al_regtype,INFINITE);
- DLINK(l,m);
- l = m;
- }
- if (x != (line_p) 0) DLINK(l,x);
-}
-
-#define is_mesreg(l) (INSTR(l) == ps_mes && aoff(ARG(l),0) == ms_reg)
-
-
-
-rem_mes(p)
- proc_p p;
-{
- register bblock_p b;
- register line_p l,next;
- offset m;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = next) {
- next = l->l_next;
- if ( INSTR(l) == ps_mes &&
- ((m = aoff(ARG(l),0)) == ms_liv || m == ms_ded)) {
- /* remove live/dead messages */
- rm_line(l,b);
- }
- }
- }
-}
-
-
-
-xform_proc(p,alloclist,nrinstrs,instrmap)
- proc_p p;
- alloc_p alloclist;
- short nrinstrs;
- line_p instrmap[];
-{
- /* Transform every instruction of procedure p that uses an item
- * at a point where the item is kept in a register.
- */
-
- register short now = 0;
- register line_p l,next;
- register bblock_p b;
- alloc_p alloc;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = next) {
- next = l->l_next;
- if (is_mesreg(l) && ARG(l)->a_next != (arg_p) 0 &&
- aoff(ARG(l),4) != INFINITE) {
- /* All register messages for local variables
- * that were not assigned a register get
- * their 'count' fields* set to 0.
- */
- ARG(l)->a_next->a_next->a_next
- ->a_next->a_a.a_offset = 0;
- }
- if (is_item(l) &&
- (alloc = find_alloc(alloclist,l,now))
- != (alloc_p) 0 ) {
- apply_alloc(b,l,alloc);
- }
- now++;
- }
- }
- emit_init_code(alloclist);
- emit_mesregs(p,alloclist);
- rem_mes(p);
-}
-
-
-
-
-STATIC bool always_in_reg(off,allocs,size_out)
- offset off;
- alloc_p allocs;
- short *size_out;
-{
- /* See if the local variable with the given offset is stored
- * in a register during its entire lifetime. As a side effect,
- * return the size of the local.
- */
-
- alloc_p alloc,m;
- item_p item;
-
- for (alloc = allocs; alloc != (alloc_p) 0; alloc = alloc->al_next) {
- for (m = alloc; m != (alloc_p) 0; m = m->al_mates) {
- item = m->al_item;
- if (m->al_iswholeproc &&
- item->it_type == LOCALVAR &&
- item->i_t.it_off == off) {
- *size_out = item->it_size;
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-
-rem_locals(p,allocs)
- proc_p p;
- alloc_p allocs;
-{
- /* Try to decrease the number of locals of procedure p, by
- * looking at which locals are always stored in a register.
- */
-
- offset nrlocals = p->p_localbytes;
- short size;
-
- while (nrlocals > 0) {
- /* A local can only be removed if all locals with
- * higher offsets are removed too.
- */
- if (always_in_reg(-nrlocals,allocs,&size)) {
- OUTVERBOSE("local %d removed from proc %d\n",
- nrlocals,p->p_id);
- nrlocals -= size;
- } else {
- break;
- }
- }
- p->p_localbytes = nrlocals;
-}
-rem_formals(p,allocs)
- proc_p p;
- alloc_p allocs;
-{
- /* Try to decrease the number of formals of procedure p, by
- * looking at which formals are always stored in a register.
- */
-
- offset nrformals = p->p_nrformals;
- offset off = 0;
- short size;
-
- if (nrformals == UNKNOWN_SIZE) return;
- while (off < nrformals) {
- if (always_in_reg(off,allocs,&size)) {
- OUTVERBOSE("formal %d removed from proc %d\n",
- off,p->p_id);
- off += size;
- } else {
- break;
- }
- }
- if (nrformals == off) {
- OUTVERBOSE("all formals of procedure %d removed\n",p->p_id,0);
- p->p_nrformals = 0;
- }
-}
+++ /dev/null
-
-/* R E G I S T E R A L L O C A T I O N
- *
- * R A _ X F O R M . H
- */
-
-extern init_replacements(); /* (short psize,wsize)
- * This routine must be called once, before
- * any call to xform_proc. It initializes
- * a machine dependent table.
- */
-extern xform_proc(); /* (proc_p p; alloc_p alloclist;
- * short nrinstrs; line_p instrmap[])
- * Transform a procedure. Alloclist must
- * contain the packed allocations (i.e. those
- * allocations that are assigned a register).
- */
-bool always_in_reg(); /* ( offset off; alloc_p allocs;
- * short *size_out;)
- * See if the local variable with the given
- * offset is stored in a register during its
- * entire lifetime. As a side effect,
- * return the size of the local.
- */
+++ /dev/null
-EM=../../..
-EMH=$(EM)/h
-EML=$(EM)/lib
-CFLAGS=-DVERBOSE -DNOTCOMPACT
-SRC=types.h def.h debug.h debug.c global.h global.c files.h files.c go.h go.c map.h map.c aux.h aux.c get.h get.c put.h put.c alloc.h alloc.c lset.h lset.c cset.h cset.c parser.h parser.c stack_chg.h stack_chg.c locals.h locals.c init_glob.h init_glob.c
-
-.SUFFIXES: .m
-.c.m:
- ack -O -L -c.m $(CFLAGS) $<
-all: classdefs.h alloc.o cset.o debug.o files.o go.o global.o lset.o map.o parser.o get.o put.o aux.o stack_chg.o locals.o init_glob.o
-optim: classdefs.h alloc.m cset.m debug.m files.m global.m lset.m map.m parser.m get.m put.m stack_chg.m locals.m init_globl.m
-classdefs.h: \
- makeclassdef \
- cldefs.src
- makeclassdef $(EMH)/em_mnem.h cldefs.src > classdefs.h
-makeclassdef: \
- makecldef.c
- $(CC) -o makeclassdef makecldef.c
-pop_push.h: \
- $(EM)/etc/em_table pop_push.awk
- awk -f pop_push.awk < $(EM)/etc/em_table > pop_push.h
-lpr:
- pr $(SRC) | lpr
-opr:
- pr $(SRC) | opr
-dumpflop:
- tar -uf ../../../ego/share/share.tarf $(SRC) Makefile show.c
-show: \
- show.c
- $(CC) -o show show.c $(EML)/em_data.a
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-alloc.o: alloc.h
-alloc.o: debug.h
-alloc.o: types.h
-aux.o: ../../../h/em_mes.h
-aux.o: ../../../h/em_pseu.h
-aux.o: ../share/alloc.h
-aux.o: ../share/aux.h
-aux.o: ../share/debug.h
-aux.o: ../share/global.h
-aux.o: ../share/map.h
-aux.o: ../share/types.h
-cset.o: alloc.h
-cset.o: cset.h
-cset.o: debug.h
-cset.o: global.h
-cset.o: types.h
-debug.o: ../../../h/em_spec.h
-debug.o: debug.h
-debug.o: def.h
-debug.o: global.h
-debug.o: types.h
-get.o: ../../../h/em_flag.h
-get.o: ../../../h/em_mes.h
-get.o: ../../../h/em_mnem.h
-get.o: ../../../h/em_pseu.h
-get.o: ../../../h/em_spec.h
-get.o: alloc.h
-get.o: aux.h
-get.o: cset.h
-get.o: debug.h
-get.o: def.h
-get.o: get.h
-get.o: global.h
-get.o: lset.h
-get.o: map.h
-get.o: types.h
-global.o: types.h
-go.o: ../share/alloc.h
-go.o: ../share/debug.h
-go.o: ../share/files.h
-go.o: ../share/get.h
-go.o: ../share/global.h
-go.o: ../share/lset.h
-go.o: ../share/map.h
-go.o: ../share/put.h
-go.o: ../share/types.h
-init_glob.o: ../share/alloc.h
-init_glob.o: ../share/debug.h
-init_glob.o: ../share/global.h
-init_glob.o: ../share/map.h
-init_glob.o: ../share/types.h
-locals.o: ../../../h/em_mes.h
-locals.o: ../../../h/em_mnem.h
-locals.o: ../../../h/em_pseu.h
-locals.o: ../../../h/em_spec.h
-locals.o: alloc.h
-locals.o: aux.h
-locals.o: cset.h
-locals.o: debug.h
-locals.o: def.h
-locals.o: get.h
-locals.o: global.h
-locals.o: locals.h
-locals.o: lset.h
-locals.o: types.h
-lset.o: alloc.h
-lset.o: debug.h
-lset.o: lset.h
-lset.o: types.h
-map.o: map.h
-map.o: types.h
-parser.o: ../../../h/em_mnem.h
-parser.o: ../../../h/em_spec.h
-parser.o: alloc.h
-parser.o: aux.h
-parser.o: classdefs.h
-parser.o: debug.h
-parser.o: global.h
-parser.o: lset.h
-parser.o: types.h
-put.o: ../../../h/em_pseu.h
-put.o: ../../../h/em_spec.h
-put.o: alloc.h
-put.o: debug.h
-put.o: def.h
-put.o: global.h
-put.o: lset.h
-put.o: map.h
-put.o: put.h
-put.o: types.h
-show.o: ../../../h/em_flag.h
-show.o: ../../../h/em_pseu.h
-show.o: ../../../h/em_spec.h
-show.o: ../share/def.h
-show.o: ../share/global.h
-show.o: ../share/types.h
-stack_chg.o: ../share/debug.h
-stack_chg.o: ../share/global.h
-stack_chg.o: ../share/types.h
-stack_chg.o: ../../../h/em_mnem.h
-stack_chg.o: ../../../h/em_spec.h
-stack_chg.o: pop_push.h
+++ /dev/null
-/* S H A R E D F I L E
- *
- * A L L O C . C
- */
-
-
-
-#include <stdio.h>
-#include "types.h"
-#include "debug.h"
-#include "alloc.h"
-
-
-short * myalloc();
-short * malloc();
-
-#ifdef DEBUG
-
-STATIC unsigned maxuse, curruse;
-
-short *newcore(size)
- int size;
-{
- if ((curruse += (unsigned) (size+2)) > maxuse) maxuse = curruse;
- return myalloc(size);
-}
-
-oldcore(p,size)
- short *p;
- int size;
-{
- curruse -= (size+2);
- free(p);
-}
-
-coreusage()
-{
- fprintf(stderr,"Maximal core usage (excl. buffers):%u\n",maxuse);
-}
-
-#endif
-
-
-/*
- * The following two sizetables contain the sizes of the various kinds
- * of line and argument structures.
- * The assumption when making the tables was that every non-byte object
- * had to be aligned on an even boundary. On machines where alignment
- * is worse ( for example a long has to be aligned on a longword bound )
- * these tables should be revised.
- * A wasteful but safe approach is to replace every line of them by
- * sizeof(line_t)
- * and
- * sizeof(arg_t)
- * respectively.
- */
-
-#ifndef NOTCOMPACT
-int lsizetab[] = {
- 2*sizeof(line_p)+2*sizeof(byte),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(short),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(offset),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(lab_id),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(obj_p),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(proc_p),
- 2*sizeof(line_p)+2*sizeof(byte)+sizeof(arg_p),
-};
-
-int asizetab[] = {
- sizeof(arg_p)+sizeof(short)+sizeof(offset),
- sizeof(arg_p)+sizeof(short)+sizeof(lab_id),
- sizeof(arg_p)+sizeof(short)+sizeof(obj_p),
- sizeof(arg_p)+sizeof(short)+sizeof(proc_p),
- sizeof(arg_p)+sizeof(short)+sizeof(argb_t),
- sizeof(arg_p)+sizeof(short)+sizeof(short)+sizeof(argb_t),
- sizeof(arg_p)+sizeof(short)+sizeof(short)+sizeof(argb_t),
- sizeof(arg_p)+sizeof(short)+sizeof(short)+sizeof(argb_t)
-};
-#else
-int lsizetab[] = {
- sizeof(struct line),
- sizeof(struct line),
- sizeof(struct line),
- sizeof(struct line),
- sizeof(struct line),
- sizeof(struct line),
- sizeof(struct line)
-};
-
-int asizetab[] = {
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg),
- sizeof (struct arg)
-};
-#endif
-
-/*
- * 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;
-
- lnp = (line_p) newcore(lsizetab[kind]);
- TYPE(lnp) = optyp;
- return(lnp);
-}
-
-oldline(lnp) register line_p lnp; {
- register kind=TYPE(lnp)&BMASK;
-
- if (kind == OPLIST)
- oldargs(ARG(lnp));
- oldcore((short *) lnp,lsizetab[kind]);
-}
-
-arg_p newarg(kind) int kind; {
- register arg_p ap;
-
- ap = (arg_p) newcore(asizetab[kind]);
- ap->a_type = 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_type) {
- case ARGSTRING:
- 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_type]);
- 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;
- }
-}
-
-oldobjects(op) register obj_p op; {
- register obj_p next;
-
- while (op != (obj_p) 0) {
- next = op->o_next;
- oldcore((short *) op, sizeof(struct obj));
- op = next;
- }
-}
-
-olddblock(dbl) dblock_p dbl; {
- oldobjects(dbl->d_objlist);
- oldargs(dbl->d_values);
- oldcore((short *) dbl, sizeof(struct dblock));
-}
-
-
-short **newmap(length) short length; {
- return((short **) newcore((length+1) * sizeof(short *)));
-}
-
-oldmap(mp,length) short **mp, length; {
- oldcore((short *) mp, (length+1) * sizeof(short *));
-}
-
-
-cset newbitvect(n) short n; {
- return((cset) newcore((n-1)*sizeof(int) + sizeof(struct bitvector)));
- /* sizeof(struct bitvector) equals to the size of a struct with
- * one short, followed by one ALLIGNED int. So the above statement
- * also works e.g. on a VAX.
- */
-}
-
-oldbitvect(s,n) cset s; short n; {
- oldcore((short *) s, (n-1)*sizeof(int) + sizeof(struct bitvector));
-}
-
-
-short *newtable(length) short length; {
- return((short *) newcore((length+1) * sizeof(short)));
-}
-
-oldtable(mp,length) short **mp, length; {
- oldcore((short *) mp, (length+1) * sizeof(short));
-}
-
-cond_p newcondtab(l) int l;
-{
- return (cond_p) newcore(l * (sizeof (struct cond_tab)));
-}
-
-oldcondtab(tab) cond_p tab;
-{
- int i;
- for (i = 0; tab[i].mc_cond != DEFAULT; i++);
- oldcore((short *) tab,((i+1) * sizeof (struct cond_tab)));
-}
-
-
-short *myalloc(size) register size; {
- register short *p,*q;
-
- p = malloc(size);
- if (p == 0)
- error("out of memory");
- for(q=p;size>0;size -= sizeof(short))
- *q++ = 0;
- return(p);
-}
+++ /dev/null
-/* I N T E R M E D I A T E C O D E
- *
- * C O R E A L L O C A T I O N A N D D E A L L O C A T I O N
- */
-
-#ifdef DEBUG
-extern short *newcore();
-extern oldcore();
-#else
-extern short *myalloc();
-#define newcore(size) myalloc(size)
-#define oldcore(p,size) free(p)
-#endif
-
-#define newstruct(t) (newcore (sizeof (struct t)))
-#define oldstruct(t,p) oldcore((short *) p,sizeof (struct t))
-
-extern line_p newline(); /* (byte optype) */
-extern arg_p newarg(); /* (byte argtype) */
-extern short **newmap(); /* (short length) */
-extern cset newbitvect(); /* (short nrbytes) */
-extern cond_p newcondtab();
-
-
-extern oldline() ;
-extern oldargs() ;
-extern oldargb() ;
-extern oldobjects() ;
-extern olddblock() ;
-extern oldmap();
-extern oldbitvect(); /* (cset s, short nrbytes) */
-extern oldcondtab();
-
-extern short *newtable();
-extern oldtable();
-
-#define newdblock() (dblock_p) newstruct(dblock)
-#define newobject() (obj_p) newstruct(obj)
-#define newproc() (proc_p) newstruct(proc)
-#define newargb() (argb_p) newstruct(argbytes)
-#define newbblock() (bblock_p) newstruct(bblock)
-#define newelem() (elem_p) newstruct(elemholder)
-#define newloop() (loop_p) newstruct(loop)
-#define newuse() (use_p) newstruct(use)
-#define newchange() (change_p) newstruct(change)
-#define newlocal() (local_p) newstruct(local)
-
-#define oldproc(x) oldstruct(proc,x)
-#define oldbblock(x) oldstruct(bblock,x)
-#define oldelem(x) oldstruct(elemholder,x)
-#define oldloop(x) oldstruct(loop,x)
-#define olduse(x) oldstruct(use,x)
-#define oldchange(x) oldstruct(change,x)
-#define oldlocal(x) oldstruct(local,x)
+++ /dev/null
-/* S H A R E D F I L E
- *
- * A U X I L I A R Y R O U T I N E S
- *
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../share/map.h"
-#include "../share/lset.h"
-#include "../../../h/em_mes.h"
-#include "../../../h/em_pseu.h"
-
-offset off_set(lnp)
- line_p lnp;
-{
- switch(lnp->l_optype) {
- case OPSHORT:
- return (offset) SHORT(lnp);
- case OPOFFSET:
- return OFFSET(lnp);
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-
-
-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_type != ARGOFF)
- error("offset expected");
- return(ap->a_a.a_offset);
-}
-
-
-offset tmplocal(p,size)
- proc_p p;
- int size;
-{
- /* Allocate a new local variable in the stack frame of p */
-
- p->p_localbytes += (offset) size;
- return -(p->p_localbytes);
-}
-
-
-
-
-line_p int_line(off)
- offset off;
-{
- /* Allocate a line struct of type OPSHORT or OPOFFSET,
- * whichever one fits best.
- */
-
- line_p lnp;
-
- if ((short) off == off) {
- /* fits in a short */
- lnp = newline(OPSHORT);
- SHORT(lnp) = (short) off;
- } else {
- lnp = newline(OPOFFSET);
- OFFSET(lnp) = off;
- }
- return lnp;
-}
-
-
-
-line_p reg_mes(tmp,size,typ,score)
- offset tmp;
- short size;
- int typ,score;
-{
- /* Generate a register message */
-
- line_p l;
- arg_p a;
-
-#define NEXTARG(a,val) a->a_next = newarg(ARGOFF); a = a->a_next; \
- a->a_a.a_offset = val
- l = newline(OPLIST);
- l->l_instr = ps_mes;
- a = ARG(l) = newarg(ARGOFF);
- a->a_a.a_offset = ms_reg;
- NEXTARG(a,tmp);
- NEXTARG(a,size);
- NEXTARG(a,typ);
- NEXTARG(a,score);
- return l;
-}
-
-
-bool dom(b1,b2)
- bblock_p b1,b2;
-{
- /* See if b1 dominates b2. Note that a block always
- * dominates itself.
- */
-
- register bblock_p b;
-
- for (b = b2; b != (bblock_p) 0; b = b->b_idom) {
- /* See if b1 is a (not necessarily proper) ancestor
- * of b2 in the immediate dominator tree.
- */
- if (b == b1) return TRUE;
- }
- return FALSE;
-}
-
-
-bblock_p common_dom(a,b)
- bblock_p a,b;
-{
- /* find a basic block that dominates a as well as b;
- * note that a basic block also dominates itself.
- */
-
- assert (a != (bblock_p) 0);
- assert (b != (bblock_p) 0);
- if (dom(a,b)) {
- return a;
- } else {
- if (dom(b,a)) {
- return b;
- } else {
- return common_dom(a->b_idom,b->b_idom);
- }
- }
-}
-
-#define R time_space_ratio
-
-short add_timespace(time,space)
- short time,space;
-{
- /* Add together a time and space, using the time_space_ratio
- * parameter that may be set by the user, indicating the need
- * to optimize for time, space or something in between.
- */
-
- return (R * time + (100 - R) * space) / 100;
-}
-
-
-
-rm_line(l,b)
- line_p l;
- bblock_p b;
-{
- if (b->b_start == l) {
- b->b_start = l->l_next;
- } else {
- PREV(l)->l_next = l->l_next;
- }
- if (l->l_next != (line_p) 0) {
- PREV(l->l_next) = PREV(l);
- }
- oldline(l);
-}
-
-
-
-
-appnd_line(l1,l2)
- line_p l1,l2;
-{
- /* Put l1 after l2 */
-
- PREV(l1) = l2;
- l1->l_next = l2->l_next;
- l2->l_next = l1;
- if (l1->l_next != (line_p) 0) {
- PREV(l1->l_next) = l1;
- }
-}
-
-
-
-line_p last_instr(b)
- bblock_p b;
-{
- /* Determine the last line of a list */
-
- register line_p l = b->b_start;
-
- if (l == (line_p) 0) return (line_p) 0;
- while (l->l_next != (line_p) 0) l = l->l_next;
- return l;
-}
-
-
-
-
-line_p find_mesreg(off)
- offset off;
-{
- /* Find the register message for the local with the given offset */
-
- Lindex li;
- line_p l;
-
- for (li = Lfirst(mesregs); li != (Lindex) 0; li = Lnext(li,mesregs)) {
- l = (line_p) Lelem(li);
- if (aoff(ARG(l),1) == off) return l;
- }
- return (line_p) 0;
-}
-
-
-bool is_regvar(off)
- offset off;
-{
- return find_mesreg(off) != (line_p) 0;
-}
-
-
-
-offset regv_arg(off,n)
- offset off;
- int n;
-{
- /* fetch the n'th argument of the register message of the
- * local variable at offset off;
- */
-
- line_p x = find_mesreg(off);
- assert (x != (line_p) 0);
- return aoff(ARG(x),n);
-}
+++ /dev/null
-/* S H A R E D
- *
- * A U X I L I A R Y R O U T I N E S
- *
- */
-
-
-extern offset off_set(); /* (line_p lnp)
- * lnp has a SHORT or OFFSET operand. Return
- * the value of this operand as an offset.
- */
-extern offset aoff(); /* (arg_p list; int n)
- * Determine the offset field of the
- * n'th argument in the list (this argument
- * must have type ARGOFF). Start counting at 0.
- */
-extern offset tmplocal(); /* (proc_p p, int size)
- * Allocate a new local variable in the
- * stack frame of p.
- */
-line_p int_line(); /* (offset off)
- * Allocate a line struct of type OPSHORT
- * or OPOFFSET, whichever one fits best.
- */
-extern line_p reg_mes(); /* (offset tmp; short size; int typ,score)
- * Generate a register message with the
- * given arguments.
- */
-extern bool dom(); /* (bblock_p b1,b2)
- /* See if b1 dominates b2. Note that a
- * block always * dominates itself.
- */
-extern bblock_p common_dom(); /* (bblock_p a,b)
- * find a basic block that dominates a as
- * well as b; note that a basic block also
- * dominates itself.
- */
-extern short add_timespace(); /* (short time,space)
- * Add together a time and space, using
- * the time_space_ratio parameter that
- * may be set by the user.
- */
-extern rm_line(); /* ( line_p l; bblock_p b)
- * Remove line l from b basic block b.
- */
-
-extern appnd_line(); /* ( line_p l1,l2)
- * Put line l1 after l2.
- */
-extern line_p last_instr(); /* ( bblock_p b)
- * Determine the last line of a basic block.
- */
-extern line_p find_mesreg(); /* (offset off)
- * Find the register message for the local
- * with the given offset.
- */
-extern bool is_regvar(); /* (offset off)
- * See if there is a 'register message'
- * for the local variable with the
- * given offset.
- */
-extern offset regv_arg(); /* (offset off; int n)
- * Fetch the n'th argument of the
- * register message of the local with
- * the given offset.
- */
+++ /dev/null
-op_aar 11 7
-op_adf 2 1
-op_adi 2 1
-op_adp 7 7
-op_ads 4 7
-op_adu 2 1
-op_and 2 1
-op_cff 10 1
-op_cfi 10 1
-op_cfu 10 1
-op_cif 10 1
-op_cii 10 1
-op_ciu 10 1
-op_cmf 2 5
-op_cmi 2 5
-op_cmp 8 5
-op_cms 2 5
-op_cmu 2 5
-op_com 1 1
-op_cuf 10 1
-op_cui 10 1
-op_cuu 10 1
-op_dec 5 5
-op_dup 1 2
-op_dvf 2 1
-op_dvi 2 1
-op_dvu 2 1
-op_fef 2 2
-op_fif 2 2
-op_inc 5 5
-op_ior 2 1
-op_lae 9 7
-op_lal 9 7
-op_ldc 9 6
-op_lde 9 6
-op_ldf 7 6
-op_ldl 9 6
-op_lil 9 5
-op_loc 9 5
-op_loe 9 5
-op_lof 7 5
-op_loi 7 1
-op_lol 9 5
-op_mlf 2 1
-op_mli 2 1
-op_mlu 2 1
-op_ngf 1 1
-op_ngi 1 1
-op_rmi 2 1
-op_rmu 2 1
-op_rol 3 1
-op_ror 3 1
-op_sbf 2 1
-op_sbi 2 1
-op_sbs 6 1
-op_sbu 2 1
-op_sli 3 1
-op_slu 3 1
-op_sri 3 1
-op_sru 3 1
-op_teq 5 5
-op_tge 5 5
-op_tgt 5 5
-op_tle 5 5
-op_tlt 5 5
-op_tne 5 5
-op_xor 2 1
-op_zer 9 1
-op_zrf 9 1
+++ /dev/null
-/* S H A R E D F I L E
- *
- * C S E T . C
- */
-
-
-#include "types.h"
-#include "cset.h"
-#include "alloc.h"
-#include "debug.h"
-#include "global.h"
-
-
-/* A set over a range of integers from 1 to N may be represented
- * as a 'compact' set. Such a set is represented as a 'bitvector'
- * record, containing the size of the set (i.e. N) and a row
- * of words (the bitvector itself). An integer J (1 <= J <= N) is
- * an element of the set iff the J-th bit of the vector is a '1'.
- * Any redundant bits in the last word are garanteed to be zero bits.
- * This package implements the usual operations on sets.
- * The name of every operation is preceede by a 'C' to
- * distinguish it from the operation on 'long' (list)
- * sets whth a similar name.
- */
-
-
-/* The two arithmetic operations 'divide by wordlength' and
- * 'modulo wordlength' can be performed very efficiently
- * if the word length (of the source machine) is 16.
- */
-
-
-
-
-cset Cempty_set(n)
- short n;
-{
- cset s;
-
- s = newbitvect(DIVWL(n-1) + 1);
- s->v_size = n;
- return s;
-}
-
-
-bool Cis_elem(x,s)
- Celem_t x;
- cset s;
-{
- short n;
- int mask;
-
- assert(x>0 && x <= s->v_size);
- n = DIVWL(x-1);
- mask = (1 << MODWL(x-1));
- if ((s->v_bits[n] & mask) == 0) {
- return FALSE;
- } else {
- return TRUE;
- }
-}
-
-
-
-Cadd(x,s_p)
- Celem_t x;
- cset *s_p;
-{
- cset s;
- short n;
- int mask;
-
- s = *s_p;
- assert(x>0 && x <= s->v_size);
- n = DIVWL(x-1);
- mask = (1 << MODWL(x-1));
- s->v_bits[n] |= mask;
-}
-
-
-Cremove(x,s_p)
- Celem_t x;
- cset *s_p;
-{
- cset s;
- short n;
- int mask;
-
- s = *s_p;
- assert(x>0 && x <= s->v_size);
- n = DIVWL(x-1);
- mask = (1 << MODWL(x-1));
- s->v_bits[n] &= ~mask;
-}
-
-
-
-/* The operations first, next and elem can be used to iterate
- * over a set. For example:
- * for (i = Cfirst(s); i != (Cindex) 0; i = Cnext(i,s) {
- * x = Celem(i);
- * use x
- * }
- * which is like:
- * 'for all elements x of s do'
- * use x
- *
- * The implementation of first and next is not very fast.
- * It could be made much more efficient (at the price of a
- * higher complexity) by not using 'is_elem'.
- * Iteration over a bitvector, however, is not supposed to
- * be used very often.
- */
-
-Cindex Cfirst(s)
- cset s;
-{
- return Cnext((Cindex) 0,s);
-}
-
-
-Cindex Cnext(i,s)
- Cindex i;
- cset s;
-{
- register short n;
-
- for (n = i+1; n <= s->v_size; n++) {
- if (Cis_elem(n,s)) {
- return (Cindex) n;
- }
- }
- return (Cindex) 0;
-}
-
-
-Celem_t Celem(i)
- Cindex i;
-{
- return (Celem_t) i;
-}
-
-
-
-Cjoin(s1,s2_p)
- cset s1, *s2_p;
-{
- /* Two sets are joined by or-ing their bitvectors,
- * word by word.
- */
-
- cset s2;
- short n;
- register short i;
-
- s2 = *s2_p;
- assert(s1->v_size == s2->v_size);
- n = DIVWL(s1->v_size -1); /* #words -1 */
- for (i = 0; i <= n; i++) {
- s2->v_bits[i] |= s1->v_bits[i];
- }
-}
-
-
-
-Cintersect(s1,s2_p)
- cset s1, *s2_p;
-{
- /* Two sets are intersected by and-ing their bitvectors,
- * word by word.
- */
-
- cset s2;
- short n;
- register short i;
-
- s2 = *s2_p;
- assert(s1->v_size == s2->v_size);
- n = DIVWL(s1->v_size -1); /* #words -1 */
- for (i = 0; i <= n; i++) {
- s2->v_bits[i] &= s1->v_bits[i];
- }
-}
-
-
-Cdeleteset(s)
- cset s;
-{
- oldbitvect(s,DIVWL(s->v_size - 1) + 1);
-}
-
-
-bool Cis_subset(s1,s2)
- cset s1,s2;
-{
- /* See if s1 is a subset of s2 */
-
- register short i;
-
- assert(s1->v_size == s2->v_size);
- if (s1->v_size == 0) return TRUE;
- for (i = 0; i <= DIVWL(s1->v_size-1); i++) {
- if ((s1->v_bits[i] & ~(s2->v_bits[i])) != 0) {
- return FALSE;
- }
- }
- return TRUE;
-}
-
-
-Cclear_set(s_p)
- cset *s_p;
-{
- cset s;
- register short i;
-
- s = *s_p;
- assert (s != (cset) 0);
- for (i = 0; i <= DIVWL(s->v_size-1); i++) {
- s->v_bits[i] = 0;
- }
-}
-
-
-Ccopy_set(s1,s2_p)
- cset s1, *s2_p;
-{
- cset s2;
- register short i;
-
- s2 = *s2_p;
- assert (s1->v_size == s2->v_size);
- for (i = 0; i <= DIVWL(s1->v_size-1); i++) {
- s2->v_bits[i] = s1->v_bits[i];
- }
-}
-
-
-Csubtract(s1,s2_p)
- cset s1, *s2_p;
-{
- cset s2;
- register short i;
-
- s2 = *s2_p;
- assert (s1->v_size == s2->v_size);
- for (i = 0; i <= DIVWL(s1->v_size-1); i++) {
- s2->v_bits[i] &= ~(s1->v_bits[i]);
- }
-}
-
-
-bool Cequal(s1,s2)
- cset s1, s2;
-{
- register short i;
-
- assert (s1->v_size == s2->v_size);
- for (i = 0; i <= DIVWL(s1->v_size-1); i++) {
- if (s1->v_bits[i] != s2->v_bits[i]) return FALSE;
- }
- return TRUE;
-}
-
-short Cnrelems(s)
- cset s;
-{
- register short n, cnt;
-
- cnt = 0;
- for (n = 1; n <= s->v_size; n++) {
- if (Cis_elem(n,s)) {
- cnt++;
- }
- }
- return cnt;
-}
+++ /dev/null
-/* O P E R A T I O N S F O R
- * C O M P A C T S E T S
- */
-
-
-extern cset Cempty_set(); /* (short) */
-extern bool Cis_elem(); /* (Celem, cset) */
-extern Cadd(); /* (Celem, *cset) */
-extern Cremove(); /* (Celem, *cset) */
-extern Cindex Cfirst(); /* (cset) */
-extern Cindex Cnext(); /* (Cindex, cset) */
-extern Celem_t Celem(); /* (Cindex) */
-extern Cjoin(); /* (cset, *cset) */
-extern Cintersect(); /* (cset, *cset) */
-extern Cdeleteset(); /* (cset) */
-extern bool Cis_subset(); /* (cset, cset) */
-extern Cclearset(); /* (cset, *cset) */
-extern Ccopy_set(); /* (cset, *cset) */
-extern Csubtract(); /* (cset, *cset) */
-extern bool Cequal(); /* (cset, cset) */
-extern short Cnrelems(); /* (cset) */
+++ /dev/null
-/* S H A R E D F I L E
- *
- * D E B U G . C
- */
-
-
-#include <stdio.h>
-#include "types.h"
-#include "def.h"
-#include "debug.h"
-#include "../../../h/em_spec.h"
-#include "global.h"
-
-
-
-int linecount; /* # lines in this file */
-bool verbose_flag = FALSE; /* generate verbose output ? */
-
-/* VARARGS1 */
-error(s,a) char *s,*a; {
-
- fprintf(stderr,"error on line %u",linecount);
- if (filename != (char *) 0) {
- fprintf(stderr," file %s",filename);
- }
- fprintf(stderr,": ");
- fprintf(stderr,s,a);
- fprintf(stderr,"\n");
- _cleanup();
- abort();
- exit(-1);
-}
-
-#ifdef TRACE
-/* VARARGS1 */
-OUTTRACE(s,n)
- char *s;
- int n;
-{
- fprintf(stderr,"> ");
- fprintf(stderr,s,n);
- fprintf(stderr,"\n");
-}
-#endif
-
-#ifdef VERBOSE
-/* VARARGS1 */
-OUTVERBOSE(s,n1,n2)
- char *s;
- int n1,n2;
-{
- if (verbose_flag) {
- fprintf(stderr,"optimization: ");
- fprintf(stderr,s,n1,n2);
- fprintf(stderr,"\n");
- }
-}
-#endif
-
-
-
-#ifdef DEBUG
-badassertion(file,line) char *file; unsigned line; {
-
- fprintf(stderr,"assertion failed file %s, line %u\n",file,line);
- error("assertion");
-}
-#endif
-/* Valid Address */
-
-VA(a) short *a; {
- if (a == (short *) 0) error("VA: 0 argument");
- if ( ((unsigned) a & 01) == 01) {
- /* MACHINE DEPENDENT TEST */
- error("VA: odd argument");
- }
-}
-
-
-/* Valid Instruction code */
-
-VI(i) short i; {
- if (i > ps_last) error("VI: illegal instr: %d", i);
-}
-
-
-/* Valid Line */
-
-VL(l) line_p l; {
- byte instr, optype;
-
- VA((short *) l);
- instr = l->l_instr;
- VI(instr);
- optype = TYPE(l);
- if (optype < OP_FIRST || optype > OP_LAST) {
- error("VL: illegal optype: %d", optype);
- }
-}
-
-
-
-/* Valid Data block */
-
-VD(d) dblock_p d; {
- byte pseudo;
-
- VA((short *) d);
- pseudo = d->d_pseudo;
- if (pseudo < D_FIRST || pseudo > D_LAST) {
- error("VD: illegal pseudo: %d",pseudo);
- }
-}
-
-
-/* Valid Object */
-
-VO(o) obj_p o; {
- offset off;
-
- VA((short *) o);
- off = o->o_off;
- if (off < 0 || off > 10000) {
- error("VO: unlikely offset: %d", off);
- }
-}
-
-
-
-/* Valid Proc */
-
-VP(p) proc_p p; {
- proc_id pid;
- int nrlabs;
-
- VA((short *) p);
- pid = p->p_id;
- if (pid <0 || pid > 1000) {
- error("VP: unlikely proc_id: %d", (int) pid);
- }
- nrlabs = p->p_nrlabels;
- if (nrlabs < 0 || nrlabs > 500) {
- error("VP: unlikely p_nrlabels: %d", nrlabs);
- }
-}
+++ /dev/null
-/* D E B U G G I N G T O O L S */
-
-/* TEMPORARY: */
-#define DEBUG
-
-extern int linecount; /* # lines in this file */
-extern bool verbose_flag; /* generate verbose output ? */
-
-/* VARARGS 1 */
-error();
-
-
-#ifdef TRACE
-extern OUTTRACE();
-#else
-#define OUTTRACE(s,n)
-#endif
-#ifdef VERBOSE
-extern OUTVERBOSE();
-#else
-#define OUTVERBOSE(s,n1,n2)
-#endif
-#ifdef DEBUG
-
-/* Some (all?) Unix debuggers don't particularly like
- * static procedures and variables. Therefor we make everything
- * global when debugging.
- */
-
-#define STATIC
-
-#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__)
-
-extern VI();
-extern VL();
-extern VD();
-extern VA();
-extern VO();
-extern VP();
-
-
-
-#else /*DEBUG*/
-
-#define assert(b)
-
-#define VI(i)
-#define VL(l)
-#define VD(d)
-#define VA(a)
-#define VO(o)
-#define VP(p)
-
-
-#define STATIC static
-#endif
+++ /dev/null
-/* G L O B A L M A C R O D E F I N I T I O N S
- *
- * F O R A L L O P T I M I Z E R P A S S E S
- */
-
-#define MARK_DBLOCK 0
-#define MARK_OBJ 1
-#define MARK_ARG 2
-
-
-#define op_lab (sp_lmnem+1)
-#define op_last op_lab
-#define ps_sym (sp_lpseu+1)
-#define ps_last ps_sym
+++ /dev/null
-/* S H A R E D F I L E
- *
- * F I L E S . C
- */
-
-#include <stdio.h>
-
-FILE *openfile(name,mode)
- char *name,*mode;
-{
- FILE *f;
-
- if ((f = fopen(name,mode)) == NULL) {
- error("cannot open %s",name);
- }
- return f;
-}
+++ /dev/null
-/* F I L E N A M E S */
-
-/* The names of the input files of every phase are passed as
- * arguments to the phase. First come the input file names,
- * then the output file names. We use a one-letter convention
- * to denote the type of file:
- * p: procedure table file
- * d: data table file
- * l: EM text file (lines of EM instructions)
- * b: basic block file (Control Flow Graph file)
- */
-
-/* The input file names */
-
-#define pname argv[1]
-#define dname argv[2]
-#define lname argv[3]
-#define bname argv[4]
-
-/* The output file names */
-
-#define pname2 argv[5]
-#define dname2 argv[6]
-#define lname2 argv[7]
-#define bname2 argv[8]
-
-#define ARGSTART 9
-
-extern FILE *openfile(); /* (char *name, *mode)
- * Open a file with the given name
- * and mode; aborts if the file
- * cannot be opened.
- */
+++ /dev/null
-/* S H A R E D F I L E
- *
- * G E T . C
- */
-
-#include <stdio.h>
-#include "types.h"
-#include "def.h"
-#include "debug.h"
-#include "global.h"
-#include "lset.h"
-#include "cset.h"
-#include "get.h"
-#include "alloc.h"
-#include "map.h"
-#include "aux.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mes.h"
-
-FILE *curinp;
-block_id lastbid; /* block identifying number */
-lab_id lastlabid; /* last label identifier */
-
-
-/* creating new identifying numbers, i.e. numbers that did not
- * appear in the input.
- */
-
-bblock_p freshblock()
-{
- bblock_p b;
- b = newbblock();
- b->b_id = ++lastbid;
- return b;
-}
-
-
-lab_id freshlabel()
-{
- curproc->p_nrlabels++;
- return ++lastlabid;
-}
-
-
-#define getmark() getbyte()
-
-short getshort() {
- register int l_byte, h_byte;
-
- l_byte = getbyte();
- h_byte = getbyte();
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l_byte | (h_byte*256) ;
-}
-
-
-offset getoff() {
- register long l;
- register int h_byte;
-
- l = getbyte();
- l |= ((unsigned) getbyte())*256 ;
- l |= getbyte()*256L*256L ;
- h_byte = getbyte() ;
- if ( h_byte>=128 ) h_byte -= 256 ;
- return l | (h_byte*256L*256*256L) ;
-}
-
-STATIC int getint()
-{
- /* Read an integer from the input file. This routine is
- * only used when reading a bitvector-set. We expect an
- * integer to be either a short or a long.
- */
-
- if (sizeof(int) == sizeof(short)) {
- return getshort();
- } else {
- assert (sizeof(int) == sizeof(offset));
- return getoff();
- }
-}
-
-/* getptable */
-
-loop_p getloop(id)
- loop_id id;
-{
- /* Map a loop identifier onto a loop struct.
- * If no struct was alocated yet for this identifier then
- * allocate one now and update the loop-map table.
- */
-
-
- assert (id > 0 && id <=lplength);
- if (lpmap[id] == (loop_p) 0) {
- lpmap[id] = newloop();
- lpmap[id]->lp_id = id;
- }
- return (lpmap[id]);
-}
-
-bblock_p getblock(id)
- block_id id;
-{
- /* Map a basic block identifier onto a block struct
- * If no struct was alocated yet for this identifier then
- * allocate one now and update the block-map table.
- */
-
-
- assert (id >= 0 && id <=blength);
- if (id == 0) return (bblock_p) 0;
- if (bmap[id] == (bblock_p) 0) {
- bmap[id] = newbblock();
- bmap[id]->b_id = id;
- }
- return (bmap[id]);
-}
-
-
-lset getlset(p)
- char *((*p) ());
-{
- /* Read a 'long' set. Such a set is represented externally
- * as a sequence of identifying numbers terminated by a 0.
- * The procedural parameter p maps such a number onto a
- * pointer to a struct (bblock_p, loop_p etc.).
- */
-
- lset s;
- int id;
-
- s = Lempty_set();
- while (id = getshort()) {
- Ladd( (*p) (id), &s);
- }
- return s;
-}
-
-
-cset getcset()
-{
- /* Read a 'compact' set. Such a set is represented externally
- * a row of bytes (its bitvector) preceded by its length.
- */
-
- cset s;
- register short i;
-
- s = Cempty_set(getshort());
- for (i = 0; i <= DIVWL(s->v_size-1);i++) {
- s->v_bits[i] = getint();
- }
- return s;
-}
-
-
-proc_p getptable(pname)
- char *pname;
-{
- short i;
- proc_p head, p, *pp;
- short all;
-
- if ((curinp = fopen(pname,"r")) == NULL) {
- error("cannot open %s",pname);
- }
-
- plength = getshort(); /* table is preceded by its length */
- assert(plength >= 0);
- assert(plength < 1000); /* See if its a reasonable number */
- pmap = (proc_p *) newmap(plength); /* allocate the pmap table */
-
- all = getshort();
- head = (proc_p) 0;
- pp = &head;
- for (i = 0; i < plength; i++) {
- if (feof(curinp)) {
- error("unexpected eof %s", pname);
- }
- p = newproc();
- p->p_id = getshort();
- assert(p->p_id > 0 && p->p_id <= plength);
- pmap[p->p_id] = p;
- p->p_flags1 = getbyte();
- if (p->p_flags1 & PF_BODYSEEN) {
- p->p_nrlabels = getshort();
- p->p_localbytes = getoff();
- p->p_nrformals = getoff();
- if (all) {
- p->p_change = newchange();
- p->p_change->c_ext = getcset();
- p->p_change->c_flags = getshort();
- p->p_use = newuse();
- p->p_use->u_flags = getshort();
- p->p_calling = getcset();
- }
- }
- *pp = p;
- pp = &(p->p_next);
- }
- fclose(curinp);
- OUTTRACE("have read proc table of length %d",plength);
- return head; /* pointer to first structure of list */
-}
-
-
-
-/* getdtable */
-
-dblock_p getdtable(dname)
- char *dname;
-{
- /* Read the data block table. Every data block may
- * have a list of objects and a list of values (arguments),
- * each of which is also represented by a structure.
- * So the input file contains a mixture of dblock,
- * obj and arg records, each one having its own
- * attributes. A mark indicates which one comes next.
- * We assume that the syntactic structure of the input
- * is correct.
- */
-
- dblock_p head, d, *dp;
- obj_p obj, *op;
- arg_p arg, *ap;
- /* dp, op an ap tell how the next dblock/obj/arg
- * has to be linked.
- */
- int n;
-
- head = (dblock_p) 0;
- dp = &head;
- if ((curinp = fopen(dname,"r")) == NULL) {
- error("cannot open %s", dname);
- }
- olength = getshort();
- assert(olength >= 0);
- assert(olength < 5000); /* See if its a reasonable number */
- /* total number of objects */
- omap = (obj_p *) newmap(olength); /* allocate omap table */
-
- while (TRUE) {
- n = getmark();
- if (feof(curinp)) break;
- switch(n) {
- case MARK_DBLOCK:
- d = *dp = newdblock();
- op = &d->d_objlist;
- ap = &d->d_values;
- dp = &d->d_next;
- d->d_id = getshort();
- d->d_pseudo = getbyte();
- d->d_size = getoff();
- d->d_fragmnr = getshort();
- d->d_flags1 = getbyte();
- break;
- case MARK_OBJ:
- obj = *op = newobject();
- op = &obj->o_next;
- obj->o_dblock = d;
- obj->o_id = getshort();
- assert(obj->o_id >0);
- assert(obj->o_id <= olength);
- omap[obj->o_id] = obj;
- obj->o_size = getoff();
- obj->o_off = getoff();
- break;
- case MARK_ARG:
- arg = *ap = newarg(ARGOFF);
- ap = &arg->a_next;
- arg->a_a.a_offset = getoff();
- break;
- default:
- assert(FALSE);
- }
- }
- OUTTRACE("have read data table, %d objects",olength);
- return head;
-}
-
-
-
-/* getbblocks */
-
-STATIC argstring(length,abp)
- short length;
- register argb_p abp;
-{
-
- while (length--) {
- if (abp->ab_index == NARGBYTES)
- abp = abp->ab_next = newargb();
- abp->ab_contents[abp->ab_index++] = getbyte();
- }
-}
-
-
-
-STATIC arg_p readargs()
-{
- /* Read a list of arguments and allocate structures
- * for them. Return a pointer to the head of the list.
- */
-
- arg_p head, arg, *ap;
- byte t;
- short length;
-
- ap = &head;
- for (;;) {
- /* every argument list is terminated by an
- * ARGCEND byte in Intermediate Code.
- */
- t = getbyte();
- if (t == (byte) ARGCEND) {
- return head;
- }
- arg = *ap = newarg(t);
- ap = &arg->a_next;
- switch((short) t) {
- case ARGOFF:
- arg->a_a.a_offset = getoff();
- break;
- case ARGINSTRLAB:
- arg->a_a.a_instrlab = getshort();
- break;
- case ARGOBJECT:
- arg->a_a.a_obj = omap[getshort()];
- /* Read an object identifier (o_id)
- * and use the omap table to obtain
- * a pointer to the rigth obj struct.
- */
- break;
- case ARGPROC:
- arg->a_a.a_proc = pmap[getshort()];
- /* Read a procedure identifier (p_id) */
- break;
- case ARGSTRING:
- length = getshort();
- argstring(length, &arg->a_a.a_string);
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- length = getshort();
- arg->a_a.a_con.ac_length = length;
- /* size of the constant */
- argstring(getshort(),
- &arg->a_a.a_con.ac_con);
- break;
- default:
- assert(FALSE);
- }
- }
-}
-
-
-line_p read_line(p_out)
- proc_p *p_out;
-{
- /* Read a line of EM code (i.e. one instruction)
- * and its arguments (if any).
- * In Intermediate Code, the first byte is the
- * instruction code and the second byte denotes the kind
- * of operand(s) that follow.
- */
-
- line_p lnp;
- byte instr;
-
- instr = getbyte();
- if (feof(curinp)) return (line_p) 0;
- lnp = newline(getbyte());
- linecount++;
- lnp->l_instr = instr;
- switch(TYPE(lnp)) {
- /* read the operand(s) */
- case OPSHORT:
- SHORT(lnp) = getshort();
- break;
- case OPOFFSET:
- OFFSET(lnp) = getoff();
- break;
- case OPINSTRLAB:
- INSTRLAB(lnp) = getshort();
- if (instr == op_lab) {
- /* defining occurrence of an
- * instruction label.
- */
- lmap[INSTRLAB(lnp)] = lnp;
- }
- break;
- case OPOBJECT:
- OBJ(lnp) = omap[getshort()];
- break;
- case OPPROC:
- PROC(lnp) = pmap[getshort()];
- if ((instr & BMASK) == ps_pro) {
- /* enter new procedure: allocate a
- * label map and a label-block map table.
- */
- *p_out = PROC(lnp);
- llength = (*p_out)->p_nrlabels;
- lmap = (line_p *) newmap(llength);
- /* maps lab_id to line structure */
- lbmap = (bblock_p *) newmap(llength);
- /* maps lab_id to bblock structure */
- lastlabid = llength;
- }
- break;
- case OPLIST:
- ARG(lnp) = readargs();
- break;
- default:
- assert(TYPE(lnp) == OPNO);
- }
- return lnp;
-}
-
-
-STATIC message(lnp)
- line_p lnp;
-{
- /* See if lnp is some useful message.
- * (e.g. a message telling that a certain local variable
- * will never be referenced indirectly, so it may be put
- * in a register. If so, add it to the mesregs set.)
- */
-
- assert(ARG(lnp)->a_type == ARGOFF);
- switch((int) aoff(ARG(lnp),0)) {
- case ms_reg:
- if (ARG(lnp)->a_next != (arg_p) 0) {
- /* take only "mes 3" with further arguments */
- Ladd(lnp,&mesregs);
- }
- break;
- case ms_err:
- error("ms_err encountered");
- case ms_opt:
- error("ms_opt encountered");
- case ms_emx:
- ws = aoff(ARG(lnp),1);
- ps = aoff(ARG(lnp),2);
- break;
- }
-}
-
-
-
-line_p getlines(lf,n,p_out,collect_mes)
- FILE *lf;
- int n;
- proc_p *p_out;
- bool collect_mes;
-{
- /* Read n lines of EM text and doubly link them.
- * Also process messages.
- */
-
- line_p head, *pp, l, lprev;
-
- curinp = lf; /* EM input file */
- pp = &head;
- lprev = (line_p) 0;
- while (n--) {
- l = *pp = read_line(p_out);
- PREV(l) = lprev;
- pp = &l->l_next;
- lprev = l;
- if (collect_mes && INSTR(l) == ps_mes) {
- message(l);
- }
- }
- *pp = (line_p) 0;
- return head;
-}
-
-
-
-bool getunit(gf,lf,kind_out,g_out,l_out,p_out,collect_mes)
- FILE *gf,*lf;
- short *kind_out;
- bblock_p *g_out;
- line_p *l_out;
- proc_p *p_out;
- bool collect_mes;
-{
- /* Read control flow graph (gf) and EM text (lf) of the next procedure.
- * A pointer to the proctable entry of the read procedure is
- * returned via p_out.
- * This routine also constructs the bmap and lpmap tables.
- * Note that we allocate structs for basic blocks and loops
- * at their first reference rather than at when we read them.
- */
-
- int n,i;
- bblock_p head, *pp, b;
- loop_p lp;
-
- curinp = gf;
- blength = getshort(); /* # basic blocks in this procedure */
- if (feof(curinp)) return FALSE;
- if (blength == 0) {
- /* data unit */
- *kind_out = LDATA;
- n = getshort();
- *l_out = getlines(lf,n,p_out,collect_mes);
- return TRUE;
- }
- *kind_out = LTEXT;
- bmap = (bblock_p *) newmap(blength); /* maps block_id on bblock_p */
- lplength = getshort(); /* # loops in this procedure */
- lpmap = (loop_p *) newmap(lplength); /* maps loop_id on loop_p */
-
- /* Read the basic blocks and the EM text */
- pp = &head; /* we use a pointer-to-a-pointer to link the structs */
- for (i = 0; i < blength; i++) {
- b = getblock(getshort());
- n = getshort(); /* #instructions in the block */
- b->b_succ = getlset(getblock);
- b->b_pred = getlset(getblock);
- b->b_idom = getblock(getshort());
- b->b_loops = getlset(getloop);
- b->b_flags = getshort();
- b->b_start = getlines(lf,n,p_out,collect_mes); /* read EM text */
- *pp = b;
- pp = &b->b_next;
- curinp = gf;
- }
- lastbid = blength; /* last block_id */
-
- /* read the information about loops */
- curproc->p_loops = Lempty_set();
- for (i = 0; i < lplength; i++) {
- lp = getloop(getshort());
- lp->lp_level = getshort(); /* nesting level */
- lp->lp_entry = getblock(getshort()); /* entry block of the loop */
- lp->lp_end = getblock(getshort()); /* tail of back edge of loop */
- Ladd(lp,&curproc->p_loops);
- }
- *g_out = head;
- return TRUE;
-}
+++ /dev/null
-/* I N P U T R O U T I N E S */
-
-extern FILE *curinp; /* current input file */
-extern block_id lastbid; /* block identifying number */
-extern lab_id lastlabid; /* last label identifier */
-
-#define getbyte() getc(curinp)
-extern short getshort(); /* ()
- * Read a short from curinp
- */
-extern offset getoff(); /* ()
- * Read an offset from curinp
- */
-extern line_p read_line(); /* ( proc_p *p_out)
- * Read a line of EM code (i.e. one
- * instruction) and its arguments
- * (if any). If the instruction is a
- * 'pro' pseudo, set p_out.
- */
-
-extern line_p getlines(); /* ( FILE *lf; int n; proc_p *p_out;
- * bool collect_mes)
- * Read n lines of EM text and doubly
- * link them. Also process messages
- * if required.
-
-extern bblock_p freshblock(); /* ()
- * Allocate a bblock struct and assign
- * it a brand new block_id.
- */
-extern lab_id freshlabel(); /* ()
- * Get a brand new lab_id.
- */
-extern dblock_p getdtable(); /* (char *dname)
- * Read the data block table from
- * the file with the given name.
- */
-extern proc_p getptable(); /* (char *pname)
- * Read the proc table from
- * the file with the given name.
- */
-extern bool getunit(); /* (FILE *gf,*lf; short kind_out;
- * bblock_p g_out; line_p l_out;
- * proc_p *p_out; bool collect_mes)
- * Read the control flow graph
- * (from file gf) and the EM text
- * (from lf). If collect_mes is TRUE,
- * all register messages will be
- * collected and put in the global
- * variable 'mesregs'. The proc read
- * is returned in p_out.
- */
+++ /dev/null
-/* S H A R E D F I L E
- *
- * G L O B A L . C
- */
-
-#include "types.h"
-
-int ps = 0;
-int ws = 0;
-
-proc_p curproc; /* current procedure */
-
-char *filename; /* name of current input file */
-
-lset mesregs; /* set of MES ms_reg pseudos */
-
-short time_space_ratio = 50;
- /* 0 if optimizing for space only,
- * 100 if optimizing for time only,
- * else something 'in between'.
- */
+++ /dev/null
-/* G L O B A L V A R I A B L E S */
-
-/* sizes of TARGET machine */
-
-extern int ps; /* pointer size */
-extern int ws; /* word size */
-
-/* sizes of SOURCE machine (i.e. machine on which
- * the optimizer runs)
- */
-
-/* number of bits in a byte */
-#define BYTELENGTH 8
-
-/* number of bits in a word */
-#define WORDLENGTH 32
-
-#if BYTELENGTH==8
-#define DIVBL(a) ((a) >> 3)
-#define MODBL(a) ((a) & 07)
-#else
-#define DIVBL(a) (a/BYTELENGTH)
-#define MODBL(a) (a%BYTELENGTH)
-#endif
-
-#if WORDLENGTH==16
-#define DIVWL(a) ((a) >> 4)
-#define MODWL(a) ((a) & 017)
-#else
-#if WORDLENGTH==32
-#define DIVWL(a) ((a) >> 5)
-#define MODWL(a) ((a) & 037)
-#else
-#define DIVWL(a) (a/WORDLENGTH)
-#define MODWL(a) (a%WORDLENGTH)
-#endif
-#endif
-
-
-#define UNKNOWN_SIZE (-1)
-
-extern proc_p curproc; /* current procedure */
-
-extern char *filename; /* name of current input file */
-
-extern lset mesregs; /* set of MES ms_reg pseudos */
-
-extern short time_space_ratio; /* 0 if optimizing for space only,
- * 100 if optimizing for time only,
- * else something 'in between'.
- */
+++ /dev/null
-/* S H A R E D F I L E
- *
- * G O . C
- *
- */
-
-
-#include <stdio.h>
-#include "types.h"
-#include "debug.h"
-#include "global.h"
-#include "files.h"
-#include "get.h"
-#include "put.h"
-#include "lset.h"
-#include "map.h"
-#include "alloc.h"
-#include "go.h"
-
-
-STATIC bool report_flag = FALSE; /* report #optimizations found? */
-STATIC bool core_flag = FALSE; /* report core usage? */
-
-
-STATIC mach_init(machfile,phase_machinit)
- char *machfile;
- int (*phase_machinit)();
-{
- /* Read target machine dependent information */
-
- FILE *f;
-
- f = openfile(machfile,"r");
- fscanf(f,"%d",&ws);
- fscanf(f,"%d",&ps);
- if (ws != ps && ps != 2*ws) error("illegal pointer size");
- phase_machinit(f);
- fclose(f);
-}
-
-
-
-go(argc,argv,initialize,optimize,phase_machinit,proc_flag)
- int argc;
- char *argv[];
- int (*initialize)();
- int (*optimize)();
- int (*phase_machinit)();
- int (*proc_flag)();
-{
- FILE *f, *gf, *f2, *gf2; /* The EM input and output and
- * the basic block graphs input and output
- */
- bblock_p g;
- line_p l;
- short kind;
- int i;
- char *p;
- bool time_opt = FALSE;
-
- linecount = 0;
- for (i = ARGSTART; i < argc; i++) {
- p = argv[i];
- if (*p++ != '-') error("illegal argument");
- switch(*p) {
- case 'S':
- time_opt = FALSE;
- break;
- case 'T':
- time_opt = TRUE;
- break;
- case 'M':
- p++;
- mach_init(p,phase_machinit);
- break;
- case 'C':
- core_flag = TRUE;
- break;
- case 'Q':
- report_flag = TRUE;
- break;
- case 'V':
- verbose_flag = TRUE;
- break;
- default:
- proc_flag(p);
- break;
- }
- }
- time_space_ratio = (time_opt ? 100 : 0);
- fproc = getptable(pname); /* proc table */
- fdblock = getdtable(dname); /* data block table */
- initialize();
- if (optimize == no_action) return;
- f = openfile(lname,"r");
- gf = openfile(bname,"r");
- f2 = openfile(lname2,"w");
- gf2 = openfile(bname2,"w");
- mesregs = Lempty_set();
- while (getunit(gf,f,&kind,&g,&l,&curproc,TRUE)) {
- /* Read the control flow graph and EM text of
- * one procedure and optimize it.
- */
- if (kind == LDATA) {
- putunit(LDATA, (proc_p) 0, l, gf2, f2);
- continue;
- }
- OUTTRACE("flow graph of proc %d read",curproc->p_id);
- curproc->p_start = g;
- /* The global variable curproc points to the
- * current procedure. It is set by getgraph
- */
- optimize(curproc);
- putunit(LTEXT,curproc,(line_p) 0,gf2,f2);
- /* output control flow graph + text */
- OUTTRACE("graph of proc %d outputted",curproc->p_id);
- Ldeleteset(mesregs);
- mesregs = Lempty_set();
- }
- fclose(f);
- fclose(f2);
- fclose(gf);
- fclose(gf2);
- f = openfile(dname2,"w");
- putdtable(fdblock,f);
- fclose(f);
- f = openfile(pname2,"w");
- putptable(fproc,f,TRUE);
- fclose(f);
- core_usage();
-}
-
-
-no_action() { }
-
-core_usage()
-{
- if (core_flag) {
- coreusage();
- }
-}
-
-report(s,n)
- char *s;
- int n;
-{
- /* Report number of optimizations found, if report_flag is set */
-
- if (report_flag) {
- fprintf(stderr,"%s: %d\n",s,n);
- }
-}
+++ /dev/null
-/* S H A R E D F I L E
- *
- * G O . H
- *
- */
-
-
-extern go(); /* ( int argc; char *argv[];
- * int (*initialize)(); int (*optimize)();
- * int (*phase_machinit)(); int (*proc_flag)() )
- * This is the main driving routine of the optimizer.
- * It first processes the flags given as argument;
- * for every flag it does not recognize itself, it
- * calls 'proc_flag'; as soon as the -M flag is seen,
- * it opens the machine descriptor file and
- * reads phase-independend information (notably the
- * wordsize and pointersize of the target machine);
- * next it calls 'phase_machinit' with this file as
- * parameter. Subsequently it calls 'initialize'.
- * Finally, all procedures are read, one at a time,
- * and 'optimize' is called with the current procedure
- * as parameter.
- */
-extern no_action(); /* ()
- * Parameter to be supplied for e.g. 'initialize' if
- * no action is required.
- */
-extern core_usage(); /* ()
- * Report core usage, if core_flag is set.
- */
-extern report(); /* ( char *s; int n)
- * Report number of optimizations found, if
- * report_flag is set
- */
+++ /dev/null
-
-/* S H A R E D F I L E
- *
- * I N I T _ G L O B L S
- *
- */
-
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/map.h"
-
-
-extern short nrglobals;
-
-init_globals()
-{
- /* Assign a 'global variable number (o_globnr) to
- * every global variable for which we want to
- * maintain ud-info. We do not maintain ud-info
- * for a global variable if:
- * - it is part of a ROM data block (so it will never be changed)
- * - it's size is not known
- * - it overlaps another variable (e.g. LOE X+2 ; LDE X)
- */
-
- dblock_p d;
- obj_p obj, prev;
- short nr = 1;
- offset ill_zone, x;
-
- for (d = fdblock; d != (dblock_p) 0; d = d->d_next) {
- ill_zone = (offset) 0;
- for (obj = d->d_objlist; obj != (obj_p) 0; obj = obj->o_next) {
- if (d->d_pseudo == DROM ||
- obj->o_size == UNKNOWN_SIZE) {
- obj->o_globnr = 0; /* var. not considered */
- continue;
- }
- if (obj->o_off < ill_zone) {
- obj->o_globnr = 0; /* var. not considered */
- if (prev != (obj_p) 0 && prev->o_globnr != 0) {
- prev->o_globnr = 0;
- nr--;
- }
- } else {
- obj->o_globnr = nr++;
- }
- if ((x = obj->o_off + obj->o_size) > ill_zone) {
- ill_zone = x;
- }
- prev = obj;
- }
- }
- nrglobals = nr -1;
-}
+++ /dev/null
-
-/* S H A R E D
- *
- * I N I T _ G L O B L S
- *
- */
-
-extern init_globals(); /* Assign a 'global variable number (o_globnr)
- * to every global variable.
- */
+++ /dev/null
-/*
- * L O C A L S . C
- */
-
-#include <stdio.h>
-#include "types.h"
-#include "debug.h"
-#include "global.h"
-#include "lset.h"
-#include "cset.h"
-#include "def.h"
-#include "get.h"
-#include "aux.h"
-#include "alloc.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_mes.h"
-#include "locals.h"
-
-
-extern short nrglobals;
-
-short nrlocals;
-local_p *locals; /* dynamic array */
-
-STATIC localvar(off,size,locs,reg,score)
- offset off;
- short size;
- local_p *locs;
- bool reg;
- offset score;
-{
- /* process a reference to a local variable.
- * A local is characterized by a (offset,size) pair.
- * We first collect all locals in a list, sorted
- * by offset. Later we will construct a table
- * out of this list.
- */
-
- local_p lc, x, *prevp;
-
- prevp = locs;
- for (lc = *locs; lc != (local_p) 0; lc = lc->lc_next) {
- if (lc->lc_off == off && lc->lc_size == size) {
- if (reg) {
- REGVAR(lc); /* register variable */
- lc->lc_score = score;
- }
- return; /* local already present */
- }
- if (lc->lc_off > off) break;
- prevp = &lc->lc_next;
- }
- /* the local was not seen before; create an entry
- * for it in the list.
- */
- x = *prevp = newlocal();
- x->lc_off = off;
- x->lc_size = size;
- x->lc_next = lc;
- if (reg) {
- REGVAR(x);
- x->lc_score = score;
- }
-}
-
-
-
-STATIC check_message(l,locs)
- line_p l;
- local_p *locs;
-{
- /* See if l is a register message */
-
- arg_p arg;
-
- arg = ARG(l);
- if (aoff(arg,0) == ms_reg && arg->a_next != (arg_p) 0) {
- localvar(aoff(arg,1), (short) aoff(arg,2), locs, TRUE,
- aoff(arg,4));
- }
-}
-
-
-
-
-STATIC check_local_use(l,locs)
- line_p l;
- local_p *locs;
-{
- short sz;
-
- switch(INSTR(l)) {
- case op_lol:
- case op_stl:
- case op_inl:
- case op_del:
- case op_zrl:
- sz = ws;
- break;
- case op_ldl:
- case op_sdl:
- sz = 2 * ws;
- break;
- case op_lil:
- case op_sil:
- sz = ps;
- break;
- case ps_mes:
- check_message(l,locs);
- /* fall through .. */
- default:
- return;
- }
- localvar(off_set(l),sz,locs,FALSE,(offset) 0);
-}
-
-
-make_localtab(p)
- proc_p p;
-{
- /* Make a table of local variables.
- * This table is used to associate a
- * unique number with a local. If two
- * locals overlap (e.g. LDL 4 and LDL 2)
- * none of them is considered any further,
- * i.e. we don't compute ud-info for them.
- */
-
- local_p prev, next, lc;
- local_p locallist = (local_p) 0;
- short cnt = 0;
- offset x, ill_zone = 0;
- register bblock_p b;
- register line_p l;
-
- /* first make a list of all locals used */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- check_local_use(l,&locallist);
- }
- }
- /* Now remove overlapping locals, count useful ones on the fly */
- for (lc = locallist; lc != (local_p) 0; lc = lc->lc_next) {
- if (ill_zone != 0 && lc->lc_off < ill_zone) {
- /* this local overlaps with a previous one */
- BADLC(lc);
- if (!IS_BADLC(prev)) {
- BADLC(prev);
- cnt--;
- }
- } else {
- cnt++;
- }
- x = lc->lc_off + lc->lc_size;
- if (ill_zone == 0 || x > ill_zone) {
- ill_zone = x;
- }
- prev = lc;
- }
- /* Now we know how many local variables there are */
- nrlocals = cnt;
- locals = (local_p *) newmap(cnt);
- cnt = 1;
- for (lc = locallist; lc != (local_p) 0; lc = next) {
- next = lc->lc_next;
- if (IS_BADLC(lc)) {
- oldlocal(lc);
- } else {
- locals[cnt++] = lc;
- lc->lc_next = (local_p) 0;
- }
- }
- assert (cnt == nrlocals+1);
-}
-
-
-
-STATIC find_local(off,nr_out,found_out)
- offset off;
- short *nr_out;
- bool *found_out;
-{
- /* Try to find the local variable at the given
- * offset. Return its local-number.
- */
-
- short v;
-
- for (v = 1; v <= nrlocals; v++) {
- if (locals[v]->lc_off > off) break;
- if (locals[v]->lc_off == off) {
- *found_out = TRUE;
- *nr_out = v;
- return;
- }
- }
- *found_out = FALSE;
-}
-
-
-
-
-var_nr(l,nr_out,found_out)
- line_p l;
- short *nr_out;
- bool *found_out;
-{
- /* Determine the number of the variable referenced
- * by EM instruction l.
- */
-
- offset off;
- short nr;
-
- switch(TYPE(l)) {
- case OPOBJECT:
- /* global variable */
- if (OBJ(l)->o_globnr == 0) {
- /* We don't maintain ud-info for this var */
- *found_out = FALSE;
- } else {
- *nr_out = GLOB_TO_VARNR(OBJ(l)->o_globnr);
- *found_out = TRUE;
- }
- return;
- case OPSHORT:
- off = (offset) SHORT(l);
- break;
- case OPOFFSET:
- off = OFFSET(l);
- break;
- default:
- assert(FALSE);
- }
- /* Its's a local variable */
- find_local(off,&nr,found_out);
- if (*found_out) {
- *nr_out = LOC_TO_VARNR(nr);
- }
-}
+++ /dev/null
-
-/*
- * L O C A L S . H
- */
-
-extern local_p *locals; /* table of locals, index is local-number */
-extern short nrlocals; /* number of locals for which we keep ud-info */
-
-extern make_localtab(); /* (proc_p p)
- * Analyse the text of procedure p to determine
- * which local variable p has. Make a table of
- * these variables ('locals') and count them
- * ('nrlocals'). Also collect register messages.
- */
-extern var_nr(); /* (line_p l; short *nr_out;bool *found_out)
- * Compute the 'variable number' of the
- * variable referenced by EM instruction l.
- */
-
-/* Every global variable for which ud-info is maintained has
- * a 'global variable number' (o_globnr). Every useful local
- * has a 'local variable number', which is its index in the
- * 'locals' table. All these variables also have a
- * 'variable number'. Conversions exist between these numbers.
- */
-
-#define TO_GLOBAL(v) (v)
-#define TO_LOCAL(v) (v - nrglobals)
-#define GLOB_TO_VARNR(v) (v)
-#define LOC_TO_VARNR(v) (v + nrglobals)
-#define IS_GLOBAL(v) (v <= nrglobals)
-#define IS_LOCAL(v) (v > nrglobals)
-
-#define REGVAR(lc) lc->lc_flags |= LCF_REG
-#define IS_REGVAR(lc) (lc->lc_flags & LCF_REG)
-#define BADLC(lc) lc->lc_flags |= LCF_BAD
-#define IS_BADLC(lc) (lc->lc_flags & LCF_BAD)
-
-
+++ /dev/null
-/* L O N G S E T S
- *
- * L S E T . C
- */
-
-
-#include "types.h"
-#include "lset.h"
-#include "alloc.h"
-#include "debug.h"
-
-
-/* A 'long' set is represented as a linear list of 'elemholder'
- * records. Every such record contains a pointer to an element
- * of the set and to the next elemholder. An empty set is
- * represented as a null pointer.
- * An element of a long set must be of some pointer type or,
- * in any case, must have the size of a pointer. Note that
- * the strict typing rules are not obeyed here.
- * This package implements the usual operations on sets.
- * The name of every operation is preceeded by a 'L' to
- * distinguish it from the operation on 'compact' (bitvector)
- * sets with a similar name.
- */
-
-
-lset Lempty_set()
-{
- return ((lset) 0);
-}
-
-
-bool Lis_elem(x,s)
- register Lelem_t x;
- register lset s;
-{
-
- /* Search the list to see if x is an element of s */
- while (s != (elem_p) 0) {
- if (s->e_elem == x) {
- return TRUE;
- }
- s = s->e_next;
- }
- return FALSE;
-}
-
-
-Ladd(x,s_p)
- Lelem_t x;
- lset *s_p;
-{
- /* add x to a set. Note that the set is given as in-out
- * parameter, because it may be changed.
- */
-
- elem_p t;
-
- if (!Lis_elem(x,*s_p)) {
- t = newelem(); /* allocate a new elemholder */
- t->e_elem = x;
- t->e_next = *s_p; /* insert it at the head of the list */
- *s_p = t;
- }
-}
-
-
-Lremove(x,s_p)
- Lelem_t x;
- lset *s_p;
-{
- /* Remove x from a set. If x was not an element of
- * the set, nothing happens.
- */
-
- register elem_p *epp, ep;
- lset s;
-
- s = *s_p;
- epp = &s;
- while ((ep = *epp) != (elem_p) 0) {
- if (ep->e_elem == x) {
- *epp = ep->e_next;
- oldelem(ep);
- break;
- } else {
- epp = &ep->e_next;
- }
- }
- *s_p = s;
-}
-
-
-/* The operations first, next and elem can be used to iterate
- * over a set. For example:
- * for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i,s) {
- * x = Lelem(i);
- * use x
- * }
- * which is like:
- * 'for all elements x of s do'
- * use x
- */
-
-
-Lindex Lfirst(s)
- lset s;
-{
- return ((Lindex) s);
- /* Note that an index for long sets is just
- * a pointer to an elemholder.
- */
-}
-
-
-Lindex Lnext(i,s)
- Lindex i;
- lset s;
-{
- assert(i != (Lindex) 0);
- return (i->e_next);
-}
-
-
-Lelem_t Lelem(i)
- Lindex i;
-{
- return (i->e_elem);
-}
-
-
-
-Ljoin(s1,s2_p)
- lset s1,*s2_p;
-{
- /* Join two sets, assign the result to the second set
- * and delete the first set (i.e. the value of the
- * first set becomes undefined).
- */
-
- register elem_p *epp, ep;
- lset s2;
-
- /* First all elements of s1 that are also an element of s2
- * are removed from the s1 list. The two resulting lists
- * (for s1 and s2) are linked (s1 first).
- * Note the usage of epp, which points to a pointer that
- * points to the next elemholder record of the list.
- */
-
- s2 = *s2_p;
- epp = &s1;
- while ((ep = *epp) != (elem_p) 0) {
- if (Lis_elem(ep->e_elem,s2)) {
- /* remove an element */
- *epp = ep->e_next;
- oldelem(ep);
- } else {
- epp = &ep->e_next;
- }
- }
- *epp = s2; /* last record of s1 (or s1 itself) now points
- * to first record of s2.
- */
- *s2_p = s1;
-}
-
-
-Ldeleteset(s)
- lset s;
-{
- register elem_p ep, next;
-
- for (ep = s; ep != (elem_p) 0; ep = next) {
- next = ep->e_next;
- oldelem(ep);
- }
-}
-
-
-bool Lis_subset(s1,s2)
- lset s1,s2;
-{
- /* See if s1 is a subset of s2 */
-
- register Lindex i;
-
- for (i = Lfirst(s1); i != (Lindex) 0; i = Lnext(i,s1)) {
- if (!Lis_elem(Lelem(i),s2)) return FALSE;
- }
- return TRUE;
-}
-
-
-short Lnrelems(s)
- lset s;
-{
- /* Compute the number of elements of a set */
-
- register elem_p ep;
- register short cnt;
-
- cnt = 0;
- for (ep = s; ep != (elem_p) 0; ep = ep->e_next) {
- cnt++;
- }
- return cnt;
-}
+++ /dev/null
-/* O P E R A T I O N S F O R
- * L O N G S E T S
- */
-
-
-extern lset Lempty_set(); /* () */
-extern bool Lis_elem(); /* (Lelem_t, lset) */
-extern Ladd(); /* (Lelem_t, *lset) */
-extern Lremove(); /* (Lelem_t, *lset) */
-extern Lindex Lfirst(); /* (lset) */
-extern Lindex Lnext(); /* (Lindex, lset) */
-extern Lelem_t Lelem(); /* (Lindex) */
-extern Ljoin(); /* (lset, *lset) */
-extern Ldeleteset(); /* (lset) */
-extern bool Lis_subset(); /* (lset, lset) */
-extern short Lnrelems(); /* (lset) */
+++ /dev/null
-#include <stdio.h>
-
-/* MAKECLASSDEF
- *
- * This program is used by several phases of the optimizer
- * to make the file classdefs.h. It reads two files:
- * - the em_mnem,h file, containing the definitions of the
- * EM mnemonics
- * - the class-file, containing tuples:
- * (mnemonic, src_class, res_class)
- * where src_class and res_class are integers telling how
- * to compute the number of bytes popped and pushed
- * by the instruction.
- * The output (standard output) is a C array.
- */
-
-
-#define TRUE 1
-#define FALSE 0
-
-convert(mnemfile,classfile)
- FILE *mnemfile, *classfile;
-{
- char mnem1[10], mnem2[10],def[10];
- int src,res,newcl,opc;
-
- newcl = TRUE;
- printf("struct class classtab[] = {\n");
- printf("\tNOCLASS,\tNOCLASS,\n");
- /* EM mnemonics start at 1, arrays in C at 0 */
- for (;;) {
- fscanf(mnemfile,"%s%s%d",def,mnem1,&opc);
- /* read a line like "#define op_aar 1" */
- if (feof(mnemfile)) break;
- if (strcmp(def,"#define") != 0) {
- error("bad mnemonic file, #define expected");
- }
- if (newcl) {
- fscanf(classfile,"%s%d%d",mnem2,&src,&res);
- /* read a line like "op_loc 8 1" */
- }
- if (feof(classfile) || strcmp(mnem1,mnem2) != 0) {
- /* there is no line for this mnemonic, so
- * it has no class.
- */
- printf("\tNOCLASS,\tNOCLASS,\n");
- newcl = FALSE;
- } else {
- printf("\tCLASS%d,\t\tCLASS%d,\n",src,res);
- /* print a line like "CLASS8, CLASS1," */
- newcl = TRUE;
- }
- }
- printf("};\n");
-}
-
-
-
-error(s)
- char *s;
-{
- fprintf(stderr,"%s\n",s);
- exit(-1);
-}
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- FILE *f1,*f2;
-
- if (argc != 3) {
- error("usage: makeclassdef mnemfile classfile");
- }
- if ((f1 = fopen(argv[1],"r")) == NULL) {
- error("cannot open mnemonic file");
- }
- if ((f2 = fopen(argv[2],"r")) == NULL) {
- error("cannot open class file");
- }
- convert(f1,f2);
-}
+++ /dev/null
-for file in *.c
-do ofile=`basename $file .c`.o
- grep '^# *include.*"' $file|sed "s/.*\"\(.*\)\".*/$ofile: \1/"
-done | sort -u >depend
-ed - Makefile <<'!'
-/AUTOAUTOAUTO/+,$d
-$r depend
-w
-q
-!
-rm depend
+++ /dev/null
-/* M A P . C */
-
-#include "types.h"
-#include "map.h"
-
-short plength;
-short olength;
-short llength;
-short blength;
-short lplength;
-line_p *lmap;
-bblock_p *lbmap;
-proc_p *pmap ; /* dynamically allocated array that maps
- * every proc_id to a proc_p.
- */
-obj_p *omap; /* maps obj_id to obj_p */
-loop_p *lpmap; /* maps loop_id to loop_p */
-bblock_p *bmap; /* maps block_id to bblock_p */
-
-dblock_p fdblock; /* first dblock */
-proc_p fproc; /* first proc */
+++ /dev/null
-/* M A P . H */
-
-extern short plength; /* length of pmap, i.e. number of procs */
-extern short olength; /* length of omap, i.e. number of objects */
-extern short llength; /* length of lmap and lbmap, i.e.
- * # instruction labels in current proc.
- */
-extern short lplength; /* length of lpmap, i.e. number of loops
- * in current procedure.
- */
-extern short blength; /* length of bmap, i.e. number of basic blocks
- * in current procedure.
- */
-
-
-extern line_p *lmap; /* contains for every label_id its
- * defining occurrence (line structure)
- * label_id --> line_p
- */
-extern bblock_p *lbmap; /* contains for every label_id its
- * basic block.
- * label_id --> bblock_p
- */
-extern proc_p *pmap; /* contains for every proc_id its proc structure
- * proc_id --> proc_p
- */
-extern obj_p *omap; /* contains for every obj_id its object struct
- * obj_id --> obj_p
- */
-extern loop_p *lpmap; /* contains for every loop_id its loop struct
- * loop_id --> loop_p
- */
-extern bblock_p *bmap; /* contains for every block_id its bblock struct
- * block_id --> bblock_p
- */
-
-extern dblock_p fdblock;/* first dblock, heads dblock list */
-extern proc_p fproc; /* first proc, heads proc table */
+++ /dev/null
-
-#include <stdio.h>
-#include "types.h"
-#include "debug.h"
-#include "alloc.h"
-#include "global.h"
-#include "lset.h"
-#include "aux.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-
-struct class {
- byte src_class;
- byte res_class;
-};
-
-typedef struct class *class_p;
-
-
-#define NOCLASS 0
-#define CLASS1 1
-#define CLASS2 2
-#define CLASS3 3
-#define CLASS4 4
-#define CLASS5 5
-#define CLASS6 6
-#define CLASS7 7
-#define CLASS8 8
-#define CLASS9 9
-#define CLASS10 10
-#define CLASS11 11
-
-#include "classdefs.h"
-/* The file classdefs.h contains the table classtab. It is
- * generated automatically from the file classdefs.src.
- */
-
-STATIC bool classes(instr,src_out,res_out)
- int instr;
- int *src_out, *res_out;
-{
- /* Determine the classes of the given instruction */
-
- class_p c;
-
- if (instr < sp_fmnem || instr > sp_lmnem) return FALSE;
- c = &classtab[instr];
- if (c->src_class == NOCLASS) return FALSE;
- *src_out = c->src_class;
- *res_out = c->res_class;
- return TRUE;
-}
-
-
-
-STATIC bool uses_arg(class)
- int class;
-{
- /* See if a member of the given class uses
- * an argument.
- */
-
- switch(class) {
- case CLASS1:
- case CLASS2:
- case CLASS3:
- case CLASS4:
- case CLASS11:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC bool uses_2args(class)
- int class;
-{
- /* See if a member of the given class uses
- * 2 arguments.
- */
-
- return class == CLASS10;
-}
-
-
-STATIC bool parse_locs(l,c1_out,c2_out)
- line_p l;
- offset *c1_out, *c2_out;
-{
- if (INSTR(l) == op_loc && INSTR(PREV(l)) == op_loc) {
- *c1_out = off_set(l);
- *c2_out = off_set(PREV(l));
- return TRUE;
- }
- return FALSE;
-}
-
-
-
-STATIC bool check_args(l,src_class,res_class,arg1_out,arg2_out)
- line_p l;
- int src_class,res_class;
- offset *arg1_out, *arg2_out;
-{
- /* Several EM instructions have an argument
- * giving the size of the operand(s) of
- * the instruction. E.g. a 'adi 4' is a 4-byte
- * addition. The size may also be put on the
- * stack. In this case we give up our
- * efforts to recognize the parameter expression.
- * Some instructions (e.g. CIU) use 2 arguments
- * that are both on the stack. In this case we
- * check if both arguments are LOCs (the usual case),
- * else we give up.
- */
-
- if (uses_2args(src_class) || uses_2args(res_class)) {
- return parse_locs(PREV(l),arg1_out,arg2_out);
- }
- if (uses_arg(src_class) || uses_arg(res_class)) {
- if (TYPE(l) == OPSHORT) {
- *arg1_out = (offset) SHORT(l);
- return TRUE;
- } else {
- if (TYPE(l) == OPOFFSET) {
- *arg1_out = OFFSET(l);
- } else {
- return FALSE;
- }
- }
- }
- return TRUE; /* no argument needed */
-}
-
-
-
-STATIC offset nrbytes(class,arg1,arg2)
- int class;
- offset arg1,arg2;
-{
- /* Determine the number of bytes of the given
- * arguments and class.
- */
-
- offset n;
-
- switch(class) {
- case CLASS1:
- n = arg1;
- break;
- case CLASS2:
- n = 2 * arg1;
- break;
- case CLASS3:
- n = arg1 + ws;
- break;
- case CLASS4:
- n = arg1 + ps;
- break;
- case CLASS5:
- n = ws;
- break;
- case CLASS6:
- n = 2 * ws;
- break;
- case CLASS7:
- n = ps;
- break;
- case CLASS8:
- n = 2 * ps;
- break;
- case CLASS9:
- n = 0;
- break;
- case CLASS10:
- n = arg2 + 2*ws;
- break;
- case CLASS11:
- n = arg1 + 2*ps;
- break;
- default:
- assert(FALSE);
- }
- return n;
-}
-
-
-
-STATIC attrib(l,expect_out,srcb_out,resb_out)
- line_p l;
- offset *expect_out, *srcb_out, *resb_out;
-{
- /* Determine a number of attributes of an EM
- * instruction appearing in an expression.
- * If it is something we don't
- * expect in such expression (e.g. a store)
- * expect_out is set to FALSE. Else we
- * determine the number of bytes popped from
- * the stack by the instruction and the
- * number of bytes pushed on the stack as
- * result.
- */
-
- int src_class,res_class;
- offset arg1, arg2;
-
- if (l == (line_p) 0 || !classes(INSTR(l),&src_class,&res_class) ||
- !check_args(l,src_class,res_class,&arg1,&arg2)) {
- *expect_out = FALSE;
- } else {
- *expect_out = TRUE;
- *srcb_out = nrbytes(src_class,arg1,arg2);
- *resb_out = nrbytes(res_class,arg1,arg2);
- }
-}
-
-
-
-bool parse(l,nbytes,l_out,level,action0)
- line_p l, *l_out;
- offset nbytes;
- int level;
- int (*action0) ();
-{
- /* This is a recursive descent parser for
- * EM expressions.
- * It tries to recognize EM code that loads exactly
- * 'nbytes' bytes on the stack.
- * 'l' is the last instruction of this code.
- * As EM is essentially postfix, this instruction
- * can be regarded as the root node of an expression
- * tree. The EM code is traversed from right to left,
- * i.e. top down. On success, TRUE is returned and
- * 'l_out' will point to the first instruction
- * of the recognized code. On toplevel, when an
- * expression has been recognized, the procedure-parameter
- * 'action0' is called, with parameters: the first and
- * last instruction of the expression and the number of
- * bytes recognized.
- */
-
- offset more, expected, sourcebytes,resultbytes;
- line_p lnp;
-
- more = nbytes; /* #bytes to be recognized */
- while (more > 0) {
- attrib(l,&expected,&sourcebytes,&resultbytes);
- /* Get the attributes of EM instruction 'l'.
- * 'expected' denotes if it is something we can use;
- * 'sourcebytes' and 'resultbytes' are the number of
- * bytes popped resp. pushed by the instruction
- * (e.g. 'adi 2' pops 4 bytes and pushes 2 bytes).
- */
- if (!expected || (more -= resultbytes) < 0) return FALSE;
- if (sourcebytes == 0) {
- /* a leaf of the expression tree */
- lnp = l;
- } else {
- if (!parse(PREV(l),sourcebytes,&lnp,level+1,action0)) {
- return FALSE;
- }
- }
- if (level == 0) {
- /* at toplevel */
- (*action0) (lnp,l,resultbytes);
- }
- l = PREV(lnp);
- }
- /* Now we've recognized a number of expressions that
- * together push nbytes on the stack.
- */
- *l_out = lnp;
- return TRUE;
-}
+++ /dev/null
-bool parse(); /* (line_p l, *l_out; offset nbytes;
- * int level; int (*action0) ())
- * This is a recursive descent parser for
- * EM expressions.
- * It tries to recognize EM code that loads exactly
- * 'nbytes' bytes on the stack.
- * 'l' is the last instruction of this code.
- * On toplevel, when an expression has been
- * recognized, the procedure-parameter
- * 'action0' is called, with parameters: the first and
- * last instruction of the expression and the number of
- * bytes recognized.
- */
+++ /dev/null
-BEGIN {
- print "char *pop_push[]="
- print "{"
- print "\"\","
- switch = 0
-}
-/aar/ {
- switch = 1
-}
- {
- if (switch) printf("\"%s\",\n",$3)
-}
-END {
- print "};"
-}
+++ /dev/null
-/* P U T . C */
-
-#include <stdio.h>
-#include "types.h"
-#include "global.h"
-#include "debug.h"
-#include "def.h"
-#include "map.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "lset.h"
-#include "alloc.h"
-#include "put.h"
-
-FILE *curoutp;
-
-
-/* The output can be either 'typed' or 'untyped'. Typed data
- * consists of a value preceded by a byte specifying what kind
- * of value it is (e.g. 2 bytes constant, 4 bytes constant,
- * proc-id, lab-id, string etc.). Untyped data consists
- * of the value only. We use typed data for the EM text and
- * untyped data for all other files.
- */
-
-/* putlines */
-
-STATIC putargs(ap)
- register arg_p ap;
-{
- while (ap != (arg_p) 0) {
- outbyte((byte) ap->a_type & BMASK);
- switch(ap->a_type) {
- case ARGOFF:
- outoff(ap->a_a.a_offset);
- break;
- case ARGINSTRLAB:
- outlab(ap->a_a.a_instrlab);
- break;
- case ARGOBJECT:
- outobject(ap->a_a.a_obj);
- break;
- case ARGPROC:
- outproc(ap->a_a.a_proc);
- break;
- case ARGSTRING:
- putstr(&ap->a_a.a_string);
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- outshort(ap->a_a.a_con.ac_length);
- putstr(&ap->a_a.a_con.ac_con);
- break;
- }
- ap = ap->a_next;
- }
- outbyte((byte) ARGCEND);
-}
-
-
-
-STATIC 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;
- }
- outshort(length);
- while (abp != (argb_p) 0) {
- for (length=0;length<abp->ab_index;length++)
- outbyte( (byte) abp->ab_contents[length] );
- abp = abp->ab_next;
- }
-}
-
-
-outoff(off) offset off; {
-
- outshort( (short) (off&0177777L) );
- outshort( (short) (off>>16) );
-}
-
-
-outshort(i) short i; {
-
- outbyte( (byte) (i&BMASK) );
- outbyte( (byte) (i>>8) );
-}
-
-
-STATIC outint(i)
- int i;
-{
- /* Write an integer to the output file. This routine is
- * only used when outputting a bitvector-set. We expect an
- * integer to be either a short or a long.
- */
-
- if (sizeof(int) == sizeof(short)) {
- outshort(i);
- } else {
- assert (sizeof(int) == sizeof(offset));
- outoff(i);
- }
-}
-
-STATIC outlab(lid) lab_id lid; {
- outshort((short) lid);
-}
-
-
-STATIC outobject(obj) obj_p obj; {
- outshort((short) obj->o_id);
-}
-
-
-STATIC outproc(p) proc_p p; {
- outshort((short) p->p_id);
-}
-
-
-short putlines(l,lf)
- line_p l;
- FILE *lf;
-{
- /* Output the list of em instructions headed by l.
- * Return the number of instruction written.
- */
-
- register line_p lnp;
- line_p next;
- short instr;
- short count= 0;
-
- curoutp = lf; /* Set f to the EM-text output file */
- for (lnp = l; lnp != (line_p) 0; lnp = next) {
- VL(lnp);
- count++;
- next = lnp->l_next;
- instr = INSTR(lnp);
- outbyte((byte) instr);
- outbyte((byte) TYPE(lnp));
- switch(TYPE(lnp)) {
- case OPSHORT:
- outshort(SHORT(lnp));
- break;
- case OPOFFSET:
- outoff(OFFSET(lnp));
- break;
- case OPINSTRLAB:
- outlab(INSTRLAB(lnp));
- break;
- case OPOBJECT:
- outobject(OBJ(lnp));
- break;
- case OPPROC:
- outproc(PROC(lnp));
- break;
- case OPLIST:
- putargs(ARG(lnp));
- break;
- }
- oldline(lnp);
- }
- return count;
-}
-
-
-
-
-
-/* putdtable */
-
-#define outmark(m) outbyte((byte) m)
-
-
-STATIC putobjects(obj)
- register obj_p obj;
-{
- while (obj != (obj_p) 0) {
- outmark(MARK_OBJ);
- outshort(obj->o_id);
- outoff(obj->o_size);
- outoff(obj->o_off);
- obj = obj->o_next;
- }
-}
-
-
-
-STATIC putvalues(arg)
- register arg_p arg;
-{
- while (arg != (arg_p) 0) {
- assert(arg->a_type == ARGOFF);
- outmark(MARK_ARG);
- outoff(arg->a_a.a_offset);
- arg = arg->a_next;
- }
-}
-putdtable(head,df)
- dblock_p head;
- FILE *df;
-{
- /* Write the datablock table to the data block file df. */
-
- register dblock_p dbl;
- register obj_p obj;
- dblock_p next;
- register short n = 0;
-
- curoutp = df; /* set f to the data block output file */
- /* Count the number of objects */
- for (dbl = head; dbl != (dblock_p) 0; dbl = dbl->d_next) {
- for (obj = dbl->d_objlist; obj != (obj_p) 0;
- obj = obj->o_next) {
- n++;
- }
- }
- outshort(n); /* The table is preceded by #objects . */
- for (dbl = head; dbl != (dblock_p) 0; dbl = next) {
- next = dbl->d_next;
- outmark(MARK_DBLOCK);
- outshort(dbl->d_id);
- outbyte(dbl->d_pseudo);
- outoff(dbl->d_size);
- outshort(dbl->d_fragmnr);
- outbyte(dbl->d_flags1);
- putobjects(dbl->d_objlist);
- putvalues(dbl->d_values);
- olddblock(dbl);
- }
- fclose(curoutp);
- if (omap != (obj_p *) 0) {
- oldmap(omap,olength); /* release memory for omap */
- }
-}
-
-
-
-/* putptable */
-
-
-
-STATIC outcset(s)
- cset s;
-{
- /* A 'compact' set is represented externally as a row of words
- * (its bitvector) preceded by its length.
- */
-
- register short i;
-
- outshort(s->v_size);
- for (i = 0; i <= DIVWL(s->v_size - 1); i++) {
- outint(s->v_bits[i]);
- }
-}
-
-
-
-putptable(head,pf,all)
- proc_p head;
- FILE *pf;
- bool all;
-{
- register proc_p p;
- proc_p next;
- register short n = 0;
- /* Write the proc table */
-
- curoutp = pf;
- /* Determine the number of procs */
- for (p = head; p != (proc_p) 0; p = p->p_next) {
- n++;
- }
- outshort(n); /* The table is preceded by its length. */
- outshort ((all?1:0)); /* if all=false, only some of the attributes
- are written. */
- for (p = head; p != (proc_p) 0; p = next) {
- next = p->p_next;
- outshort(p->p_id);
- outbyte(p->p_flags1);
- if (p->p_flags1 & PF_BODYSEEN) {
- /* If we have no access to the EM text of the
- * body of a procedure, we have no information
- * about it whatsoever, so there is nothing
- * to output in that case.
- */
- outshort(p->p_nrlabels);
- outoff(p->p_localbytes);
- outoff(p->p_nrformals);
- if (all) {
- outcset(p->p_change->c_ext);
- outshort(p->p_change->c_flags);
- outshort(p->p_use->u_flags);
- outcset(p->p_calling);
- Cdeleteset(p->p_change->c_ext);
- oldchange(p->p_change);
- olduse(p->p_use);
- Cdeleteset(p->p_calling);
- }
- }
- oldproc(p);
- }
- fclose(curoutp);
- if (pmap != (proc_p *) 0) {
- oldmap(pmap,plength); /* release memory for pmap */
- }
-}
-
-
-
-/* putunit */
-
-STATIC outloop(l)
- loop_p l;
-{
- outshort((short) l->lp_id);
-}
-
-
-STATIC outblock(b)
- bblock_p b;
-{
- if (b == (bblock_p) 0) {
- outshort((short) 0);
- } else {
- outshort((short) b->b_id);
- }
-}
-
-
-STATIC outid(e,p)
- Lelem_t e;
- int (*p) ();
-{
- /* Auxiliary routine used by outlset. */
-
- /* NOSTRICT */
- (*p) (e);
-}
-
-
-STATIC outlset(s,p)
- lset s;
- int (*p) ();
-{
- /* A 'long' set is represented externally as a
- * a sequence of elements terminated by a 0 word.
- * The procedural parameter p is a routine that
- * prints an id (proc_id, obj_id etc.).
- */
-
- register Lindex i;
-
- for (i = Lfirst(s); i != (Lindex) 0; i = Lnext(i,s)) {
- outid(Lelem(i),p);
- }
- outshort((short) 0);
-}
-
-
-
-putunit(kind,p,l,gf,lf)
- short kind;
- proc_p p;
- line_p l;
- FILE *gf, *lf;
-{
- register bblock_p b;
- register short n = 0;
- Lindex pi;
- loop_p lp;
-
- curoutp = gf;
- if (kind == LDATA) {
- outshort(0); /* No basic blocks */
- n = putlines(l,lf);
- curoutp = gf;
- outshort(n);
- return;
- }
- /* Determine the number of basic blocks */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- n++;
- }
- outshort(n); /* # basic blocks */
- outshort(Lnrelems(p->p_loops)); /* # loops */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- n = putlines(b->b_start,lf);
- curoutp = gf;
- outblock(b); /* put its block_id */
- outshort(n); /* #instructions of the block */
- outlset(b->b_succ, outblock); /* put succ set */
- outlset(b->b_pred, outblock); /* put pred set */
- outblock(b->b_idom); /* put id of immediate dominator */
- outlset(b->b_loops, outloop); /* put loop set */
- outshort(b->b_flags);
- }
- /* The Control Flow Graph of every procedure is followed
- * by a description of the loops of the procedure.
- * Every loop contains an id, an entry block and a level.
- */
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- outloop(lp); /* id */
- outshort(lp->lp_level); /* nesting level */
- outblock(lp->lp_entry); /* loop entry block */
- outblock(lp->lp_end);
- oldloop(lp);
- }
- Ldeleteset(p->p_loops);
- /* We will now release the memory of the basic blocks.
- * Note that it would be incorrect to release a basic block
- * after it has been written, because there may be references
- * to it from other (later) blocks.
- */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- Ldeleteset(b->b_loops);
- Ldeleteset(b->b_succ);
- Ldeleteset(b->b_pred);
- oldbblock(b);
- }
- /* Release the memory for the lmap, lbmap, bmap, lpmap tables */
- if (lmap != (line_p *) 0) oldmap(lmap,llength);
- if (lbmap != (bblock_p *) 0) oldmap(lbmap,llength);
- if (bmap != (bblock_p *) 0) oldmap(bmap,blength);
- if (lpmap != (loop_p *) 0) oldmap(lpmap,lplength);
- curoutp = lf;
-}
+++ /dev/null
- /* O U T P U T R O U T I N E S */
-
-
-extern FILE *curoutp; /* current output file */
-
-#define outbyte(b) putc(b,curoutp)
-extern outshort(); /* (short i)
- * Write a short to curoutp
- */
-extern outoff(); /* (offset off)
- * Write an offset to curoutp
- */
-
-extern putdtable(); /* (dblock_p head, FILE *df)
- * Write the data block table to file df,
- * preceded by its length.
- */
-extern putptable(); /* (proc_p head, FILE *pf, bool all)
- * Write the proc table to file pf,
- * preceded by its length. If all=false,
- * the fields computed by CF will not be
- * written (used by the IC phase).
- */
-extern putunit(); /* (short kind; proc_p p; line_p l;
- * FILE *gf, *lf)
- * If kind = LTEXT, then write
- * the control flow graph to file gf,
- * preceded by its length (#basic blocks);
- * write the EM code of every basic block
- * in the graph to file lf, preceded by
- * the number of instructions in the block.
- * Else, (kind = LDATA) just write the
- * list of instructions (data declarations)
- * to lf.
- */
-extern short putlines(); /* (line_p l; FILE *lf)
- * Output the list of em instructions
- * headed by l. Return the number of
- * instructions written.
- */
+++ /dev/null
-/* S H O W . C */
-
-/* This program can be used to make the output of the 'cf' pass
- * human readable. It will display either the procedure table,
- * the datablock table, the basic block table or the EM text,
- * depending on the flag that is passed as first argument.
- */
-
-
-
-#include <stdio.h>
-#include "../../../h/em_spec.h"
-#include "../../../h/em_flag.h"
-#include "../../../h/em_pseu.h"
-#include "../share/types.h"
-#include "../share/def.h"
-#include "../share/global.h"
-
-
-#define BMASK 0377
-
-
-
-
-
-
-extern byte em_flag[];
-
-#define space1() printf(" ")
-char format[] = " %-11s%d\n";
-char lformat[] = " %-11s%D\n";
-char sformat[] = " %-10s%s\n";
-char dformat[] = " %-11s%d\n";
-char oformat[] = " %-11s%D\n";
-
-
-
-FILE *f; /* input file */
-
-
-#define getbyte() getc(f)
-
-short getshort()
-{
- register n;
-
- n = getbyte();
- n |= getbyte() << 8;
- return n;
-}
-
-offset getoff()
-{
- register offset n;
-
- n = (unsigned) getshort();
- n |= ((offset) getshort() ) << 16;
- return n;
-}
-
-
-int getint()
-{
- /* Read an integer from the input file. This routine is
- * only used when reading a bitvector-set. We expect an
- * integer to be either a short or a long.
- */
-
- if (sizeof(int) == sizeof(short)) {
- return getshort();
- } else {
- return getoff();
- }
-}
-
-
-/* VARARGS 1 */
-error(s,a) char *s,*a; {
-
- fprintf(stderr,"error");
- fprintf(stderr,": ");
- fprintf(stderr,s,a);
- fprintf(stderr,"\n");
- abort();
- exit(-1);
-}
-
-main(argc, argv)
- int argc;
- char *argv[];
-{
- if (argc != 3 || argv[1][0] != '-') {
- error("usage: %s -[ldpbc] filename",argv[0]);
- }
- if ((f = fopen(argv[2], "r")) == NULL) {
- error("cannot open %s", argv[2]);
- }
- switch(argv[1][1]) {
- case 'l':
- showl();
- break;
- case 'd':
- showd();
- break;
- case 'p':
- showp();
- break;
- case 'b':
- showb();
- break;
- case 'c':
- showc();
- break;
- default:
- error("bad flag");
- }
-
- fclose(f);
-}
-
-
-showcset()
-{
- /* print a compact (bitvector) set */
-
- short size;
- register short i,j;
- int w, mask;
-
- size = getshort();
- /* # significant bits in bitvector */
- i = 1;
- printf(" { ");
- if (size == 0) {
- printf("}\n");
- return;
- }
- for (;;) {
- w = getint();
- mask = 1 ;
- for (j = 1; j <= WORDLENGTH; j++) {
- if (w & mask) {
- printf("%d ",i);
- }
- if (i++ == size) {
- printf ("}\n");
- return;
- }
- mask <<= 1;
- }
- }
-}
-
-
-
-showp()
-{
- byte b;
- short n;
- short all;
- printf("total number of procs: %d\n\n",getshort());
- all = getshort();
- while (TRUE) {
- n = getshort();
- if (feof(f)) break;
- printf("PROC\n");
- printf(format,"id =",n);
- printf(format,"flags1 =",b = getbyte());
- if (b & PF_BODYSEEN) {
- printf(format,"# labels =",getshort());
- printf(lformat,"# locals =",getoff());
- printf(lformat,"# formals =",getoff());
- if (all == 1) {
- printf(" changed ="); showcset();
- printf(format,"c_flags =",getshort());
- printf(" used ="); showcset();
- printf(format,"u_flags =",getshort());
- printf(" calling ="); showcset();
- }
- } else {
- printf(" body not available\n");
- }
- }
-}
-
-
-char *pseudo[5] = {"hol", "bss", "rom", "con", "unknown" };
-
-showd()
-{
- short n;
- printf("total number of objects: %d\n\n",getshort());
- while (TRUE) {
- n = getbyte();
- if (feof(f)) break;
- switch(n) {
- case MARK_DBLOCK:
- printf("DBLOCK\n");
- printf(format,"id =",getshort());
- printf(sformat,"pseudo =",
- pseudo[(short) getbyte()]);
- printf(lformat,"size =",getoff());
- printf(format,"fragment =",getshort());
- printf(format,"flags1 =",
- (short) getbyte());
- break;
- case MARK_OBJ:
- printf(" OBJ\n");
- space1();
- printf(format,"id =",getshort());
- space1();
- printf(lformat,"size =",getoff());
- space1();
- printf(lformat,"offset =",getoff());
- break;
- case MARK_ARG:
- printf(" VALUE\n");
- space1();
- printf(lformat,"offset =",getoff());
- break;
- }
- }
-}
-
-
-/* The mnemonics of the EM instructions and pseudos */
-
-
-extern char em_mnem[];
-extern char em_pseu[];
-char lab_mnem[] = "instrlab";
-char sym_mnem[] = "datalab";
-
-showinstr()
-{
- short instr;
- char *s;
-
- instr = (short) getbyte();
- if (feof(f)) return FALSE;
- if (instr >= sp_fmnem && instr <= sp_lmnem) {
- s = &(em_mnem[(instr-sp_fmnem) *4]);
- } else {
- if (instr == op_lab) {
- s = lab_mnem;
- } else {
- if (instr == ps_sym) {
- s = sym_mnem;
- } else {
- s = &(em_pseu[(instr-sp_fpseu)*4]);
- }
- }
- }
- printf("%s",s);
- switch((short) getbyte()) {
- case OPSHORT:
- case OPOBJECT:
- printf(" %d", getshort());
- break;
- case OPPROC:
- printf(" $%d",getshort());
- break;
- case OPINSTRLAB:
- printf(" *%d",getshort());
- break;
- case OPOFFSET:
- printf(" %D", getoff());
- break;
- case OPLIST:
- arglist();
- break;
- }
- printf("\n");
- return TRUE;
-}
-
-
-showl()
-{
- while (showinstr());
-}
-
-
-
-arglist()
-{
- short length;
- for (;;) {
- switch((short) getbyte()) {
- case ARGOBJECT:
- printf(" %d", getshort());
- break;
- case ARGPROC:
- printf(" $%d",getshort());
- break;
- case ARGINSTRLAB:
- printf(" *%d",getshort());
- break;
- case ARGOFF:
- printf(" %D", getoff());
- break;
- case ARGICN:
- case ARGUCN:
- case ARGFCN:
- printf(" %d",getshort());
- /* Fall through !! */
- case ARGSTRING:
- length = getshort();
- putchar(' ');
- putchar('"');
- while (length--) {
- putchar(getbyte());
- }
- putchar('"');
- break;
- case ARGCEND:
- return;
- }
- }
-}
-
-
-
-showlset()
-{
- register short x;
-
- printf("{ ");
- while (x = getshort()) {
- printf("%d ",x);
- }
- printf("}\n");
-}
-
-
-
-
-showb()
-{
- /* basic block file */
-
- short n,m;
-
- while (TRUE) {
- n = getshort();
- if (feof(f)) break;
- if (n == 0) {
- printf("Declaration Unit:\n");
- printf(dformat,"#instrs =",getshort());
- printf("\n");
- continue;
- }
- printf("Control Flow Graph:\n");
- printf("number of basic blocks: %d\n",n);
- m = getshort(); /* #loops */
- while (n--) {
- printf(" BASIC BLOCK\n");
- printf(dformat,"id =",getshort());
- printf(dformat,"# instrs =",getshort());
- printf(" succ =");
- showlset();
- printf(" pred =");
- showlset();
- printf(dformat,"idom =",getshort());
- printf(" loops =");
- showlset();
- printf(dformat,"flags =",getshort());
- }
- printf("number of loops: %d\n",m);
- while (m--) {
- printf(" LOOP\n");
- printf(dformat,"id =",getshort());
- printf(dformat,"level =",getshort());
- printf(dformat,"entry =",getshort());
- printf(dformat,"end =",getshort());
- }
- printf("\n");
- }
-}
-
-
-showc()
-{
- int n,m,cnt,t;
-
- cnt = 1;
- while(TRUE) {
- t = getshort();
- if (feof(f)) break;
- printf("CALL %d\n",cnt++);
- printf(format,"nestlevel =",t);
- printf(format,"calling p. =",getshort());
- printf(format,"call_id =",getshort());
- printf(format,"called p. =",getshort());
- printf(format,"looplevel =",getbyte());
- printf(format,"flags =",getbyte());
- printf(format,"ratio =",getshort());
- printf(" actuals:");
- n = getshort();
- if (n == 0) {
- printf(" ---\n");
- } else {
- while (n--) {
- printf("\n");
- m = getshort();
- printf(oformat,"size =",getoff());
- printf(dformat,"inl =",getbyte());
- while (m--) {
- printf(" ");
- showinstr();
- }
- }
- }
- }
-}
+++ /dev/null
-/* S T A C K _ C H A N G E . C */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../../../h/em_spec.h"
-#include "../../../h/em_mnem.h"
-
-#include "pop_push.h"
-
-#define IS_LOC(l) (l!=(line_p) 0 && INSTR(l)==op_loc && TYPE(l)==OPSHORT)
-
-int stack_change(l,sign)
- line_p l;
- char sign;
-{
- /* Interpret the string in the third column of the em_table file */
-
- char *s;
- bool argdef;
- short arg;
- int sum = 0;
- line_p p = PREV(l);
- line_p pp = (p == (line_p) 0 ? (line_p) 0 : PREV(p));
- short i = INSTR(l);
-
- if (i < sp_fmnem || i > sp_lmnem) {
- return 0;
- } else {
- if (TYPE(l) == OPSHORT) {
- arg = SHORT(l);
- if (arg < ws) {
- /* E.g. a LOI 1 loads word-size bytes,
- * not 1 byte!
- */
- arg = ws;
- }
- argdef = TRUE;
- } else {
- argdef = FALSE;
- }
- }
- s = pop_push[i];
- if (*s == '0') return 0;
- while (*s != '\0') {
- if (*s++ == sign) {
- switch(*s) {
- case 'w':
- sum += ws;
- break;
- case 'd':
- sum += 2 * ws;
- break;
- case 'p':
- sum += ps;
- break;
- case 'a':
- if (!argdef) return -1;
- sum += arg;
- break;
- case 'x':
- if (IS_LOC(p)) {
- sum += SHORT(p);
- break;
- } else {
- return -1;
- }
- case 'y':
- if (IS_LOC(pp)) {
- sum += SHORT(pp);
- break;
- } else {
- return -1;
- }
- case '?':
- return -1;
- default:
- assert(FALSE);
- }
- }
- s++;
- }
- return sum;
-}
-
-
-
-line_change(l,ok_out,pop_out,push_out)
- line_p l;
- bool *ok_out;
- int *pop_out,*push_out;
-{
- short pop,push;
-
- pop = stack_change(l,'-');
- push = stack_change(l,'+');
- *ok_out = (pop != -1 && push != -1);
- *pop_out = pop;
- *push_out = push;
-}
-
-
+++ /dev/null
-
-/* S T A C K _ C H A N G E . H */
-
-extern line_change(); /* ( line_p l; bool *ok_out; int *pop_out,*push_out)
- * Try to determine how the stack-height will be
- * affected by the EM instruction l. 'ok_out' is set
- * to false if we fail to do so. pop_out and
- * push_out are set to the number of bytes popped
- * and pushed. E.g. for an "ADI 2" 4 and 2 are returned.
- */
+++ /dev/null
-/* I N T E R N A L D A T A S T R U C T U R E S O F E G O */
-
-
-/* This file contains the definitions of the global data types.
- */
-
-
-/* TEMPORARY: */
-#define LONGOFF
-
-
-#define IDL 8 /* identifier length */
-#define DYNAMIC 1
-#define NARGBYTES 14
-#define BMASK 0377
-
-typedef struct argbytes argb_t;
-typedef char byte;
-typedef byte bool;
-typedef long offset;
-typedef short obj_id;
-typedef short proc_id;
-typedef short dblock_id;
-typedef short block_id;
-typedef short loop_id;
-typedef short lab_id;
-
-
-typedef struct dblock *dblock_p;
-typedef struct obj *obj_p;
-typedef struct proc *proc_p;
-typedef struct loop *loop_p;
-typedef struct change *change_p;
-typedef struct use *use_p;
-typedef struct bblock *bblock_p;
-typedef struct line *line_p;
-typedef struct arg *arg_p;
-typedef struct argbytes *argb_p;
-typedef struct elemholder *elem_p;
-typedef struct elemholder *lset;
-typedef struct bitvector *cset;
-typedef elem_p Lindex;
-typedef short Cindex;
-typedef char *Lelem_t;
-typedef short Celem_t;
-
-typedef union pext_t *pext_p;
-typedef union bext_t *bext_p;
-typedef union lpext_t *lpext_p;
-
-
-typedef struct call *call_p;
-typedef struct formal *formal_p;
-
-/* Used-Definition Analysis */
-typedef struct local *local_p;
-
-typedef struct cond_tab *cond_p;
-
-#define TRUE 1
-#define FALSE 0
-
-/* DATABLOCKS */
-
-/* A datablock is a block of global data, declared by means of
- * a hol, bss, con or rom pseudo. The declaration may be in a file
- * that is inaccessible to EGO, in which case the pseudo is unknown.
- * Successive rom or con pseudos that are garanteed to be in the
- * same fragment (according to the EM definition) share the
- * same fragment number.
- */
-
-#define DHOL 0
-#define DBSS 1
-#define DROM 2
-#define DCON 3
-#define DUNKNOWN 4
-
-
-/* The following constants are used by the debugging tools: */
-#define D_FIRST DHOL
-#define D_LAST DUNKNOWN
-
-
-struct dblock {
- dblock_id d_id; /* unique integer */
- byte d_pseudo; /* one of DHOL,DBSS,DROM,DCON,DUNKNOWN */
- offset d_size; /* # bytes, -1 if unknown */
- obj_p d_objlist; /* list of objects of the data block */
- byte d_flags1; /* see below */
- byte d_flags2; /* free to be used by phases */
- arg_p d_values; /* values, in case of ROM */
- short d_fragmnr; /* fragment number */
- dblock_p d_next; /* link to next block */
-};
-
-
-#define DF_EXTERNAL 01 /* Is name visible outside its module? */
-
-/* OBJECTS */
-
-/* An object is a row of successive bytes in one datablock
- * that are considered to be a whole. E.g. scalar variables,
- * arrays, I/O buffers etc. are objects.
- */
-
-struct obj {
- offset o_off; /* offset within the block */
- offset o_size; /* size of the object, 0 if not known */
- obj_id o_id; /* unique integer */
- dblock_p o_dblock; /* backlink to data block */
- short o_globnr; /* global variable number */
- obj_p o_next; /* link */
-};
-
-
-/* PROCEDURES */
-
-struct proc {
- proc_id p_id; /* unique integer */
- short p_nrlabels; /* #instruction labels in the proc */
- offset p_localbytes; /* #bytes for locals */
- offset p_nrformals; /* #bytes for formals */
- byte p_flags1; /* see below */
- byte p_flags2; /* free to be used by phases */
- bblock_p p_start; /* pointer to first basic block */
- cset p_calling; /* set of all procs called by this one */
- lset p_loops; /* information about loops */
- change_p p_change; /* variables changed by this proc */
- use_p p_use; /* variables used by this proc */
- pext_p p_extend; /* pointer to any further information */
- proc_p p_next; /* link */
-};
-
-
-union pext_t {
- struct pext_il {
- call_p p_cals; /* candidate calls for in line expansion */
- short p_size; /* length of proc (EM-instrs or bytes) */
- formal_p p_formals; /* description of formals */
- short p_nrcalled; /* # times proc is called (varying) */
- long p_ccaddr; /* address of calcnt info on disk */
- long p_laddr; /* address in EM-text file on disk */
- short p_orglabels; /* original #labels before substitution */
- offset p_orglocals; /* original #bytes for locals */
- } px_il;
-} ;
-
-#define PF_EXTERNAL 01 /* proc is externally visible */
-#define PF_BODYSEEN 02 /* body of proc is available as EM text */
-#define PF_CALUNKNOWN 04 /* proc calls an unavailable procedure */
-#define PF_ENVIRON 010 /* proc does a lxa or lxl */
-#define PF_LPI 020 /* proc may be called indirect */
-#define PF_CALINLOOP 040 /* proc ever called in a loop? (transitively) */
-
-#define CALLED_IN_LOOP(p) p->p_flags1 |= PF_CALINLOOP
-#define IS_CALLED_IN_LOOP(p) (p->p_flags1 & PF_CALINLOOP)
-
-
-/* LOOPS */
-
- struct loop {
- loop_id lp_id; /* unique integer */
- short lp_level; /* nesting level, 0=outermost loop,
- * 1=loop within loop etc. */
- bblock_p lp_entry; /* unique entry block of loop */
- bblock_p lp_end; /* tail of back edge of natural loop */
- lpext_p lp_extend; /* pointer to any further information */
-};
-
-
-
-union lpext_t {
- struct lpext_cf {
- lset lpx_blocks;
- short lpx_count;
- bool lpx_messy;
- } lpx_cf;
- struct lpext_sr {
- lset lpx_blocks; /* basic blocks constituting the loop */
- bblock_p lpx_header; /* header block, 0 if no one allocated yet */
- bool lpx_done; /* TRUE if we've processed this loop */
- line_p lpx_instr; /* current last instruction in header block*/
- } lpx_sr;
- struct lpext_ra {
- lset lpx_blocks; /* basic blocks constituting the loop */
- bblock_p lpx_header; /* header block, 0 if no one allocated yet */
- } lpx_ra;
-} ;
-
-/* CHANGED/USED VARIABLES INFORMATION */
-
-
-struct change {
- cset c_ext; /* external variables changed */
- short c_flags; /* see below */
-};
-
-struct use {
- short u_flags; /* see below */
-};
-
-
-#define CF_INDIR 01
-#define UF_INDIR 01
-
-
-/* SETS */
-
-
-/* There are 2 set representations:
- * - long (lset), which is essentially a list
- * - compact (cset), which is essentially a bitvector
- */
-
-
- struct elemholder {
- char *e_elem; /* pointer to the element */
- elem_p e_next; /* link */
-};
-
-struct bitvector {
- short v_size; /* # significant bits */
- int v_bits[DYNAMIC];/* a row of bits */
-};
-
-
-
-/* BASIC BLOCKS */
-
-
-/* Note that the b_succ and b_pred fields constitute the
- * Control Flow Graph
- */
-
-
- struct bblock {
- block_id b_id; /* unique integer */
- line_p b_start; /* pointer to first instruction */
- lset b_succ; /* set of successor blocks */
- lset b_pred; /* set of predecessor blocks */
- bblock_p b_idom; /* immediate dominator */
- lset b_loops; /* set of loops it is in */
- short b_flags; /* see below */
- bext_p b_extend; /* pointer to any further information */
- bblock_p b_next; /* link to textually next block */
-};
-
-
-union bext_t {
- struct bext_cf {
- short bx_semi; /* dfs number of semi-dominator */
- bblock_p bx_parent; /* parent in dfs spanning tree */
- lset bx_bucket; /* set of vertices whose sdom is b */
- bblock_p bx_ancestor; /* ancestor of b in forest, */
- bblock_p bx_label; /* used by link/eval */
- } bx_cf;
- struct bext_ud {
- cset bx_gen; /* definition generated in b */
- cset bx_kill; /* defs. outside b killed by b */
- cset bx_in; /* defs. reaching beginning of b */
- cset bx_out; /* defs. reaching end of b */
- cset bx_cgen; /* generated copies */
- cset bx_ckill; /* killed copies */
- cset bx_cin; /* copies reaching begin of b */
- cset bx_cout; /* copies reaching end of b */
- cset bx_chgvars; /* variables changed by b */
- } bx_ud;
- struct bext_lv {
- cset bx_use; /* variables used before being defined */
- cset bx_def; /* variables defined before being used */
- cset bx_lin; /* variables live at entry of b */
- cset bx_lout; /* variables live at exit of b */
- } bx_lv;
- struct bext_ra {
- short bx_begin; /* number of first instruction of block */
- short bx_end; /* number of last instruction of block */
- } bx_ra;
-} ;
-
-
-#define BF_STRONG 01
-#define BF_FIRM 02
-
-#define IS_STRONG(b) (b->b_flags&BF_STRONG)
-#define IS_FIRM(b) (b->b_flags&BF_FIRM)
-
-
-/* EM INSTRUCTIONS */
-
-/* Kinds of operand types (l_optype field) */
-
-#define OPNO 0
-#define OPSHORT 1
-#define OPOFFSET 2
-#define OPINSTRLAB 3
-#define OPOBJECT 4
-#define OPPROC 5
-#define OPLIST 6
-
-
-/* The following constants are used by the debugging tools: */
-#define OP_FIRST OPNO
-#define OP_LAST OPLIST
-
-#define LDATA 0
-#define LTEXT 01
-
-struct line {
- line_p l_next; /* link */
- byte l_instr; /* instruction */
- byte l_optype; /* kind of operand, used as tag */
- line_p l_prev; /* backlink to previous instruction */
- union {
- short la_short; /* short: LOC 5 */
- offset la_offset; /* offset: LDC 20 */
- lab_id la_instrlab; /* label: BRA *10 */
- obj_p la_obj; /* object: LOE X+2 */
- proc_p la_proc; /* proc: CAL F3 */
- arg_p la_arg; /* arguments: HOL 10,0,0 */
- } l_a;
-};
-
-
-/* ARGUMENTS */
-
-
-/* String representation of a constant, partitioned into
- * pieces of NARGBYTES bytes.
- */
-
-#define ARGOFF 0
-#define ARGINSTRLAB 1
-#define ARGOBJECT 2
-#define ARGPROC 3
-#define ARGSTRING 4
-#define ARGICN 5
-#define ARGUCN 6
-#define ARGFCN 7
-#define ARGCEND 8
-
-
-struct argbytes {
- argb_p ab_next;
- short ab_index;
- char ab_contents[NARGBYTES];
-};
-
-
-struct arg {
- arg_p a_next; /* link */
- short a_type; /* kind of argument */
- union {
- offset a_offset; /* offset */
- lab_id a_instrlab; /* instruction label */
- proc_p a_proc; /* procedure */
- obj_p a_obj; /* object */
- argb_t a_string; /* string */
- struct { /* int/unsigned/float constant */
- short ac_length; /* size in bytes */
- argb_t ac_con; /* its string repres. */
- } a_con;
- } a_a;
-};
-
-
-
-/* Macros to increase readability: */
-
-#define INSTR(lnp) (lnp->l_instr & BMASK)
-#define TYPE(lnp) lnp->l_optype
-#define PREV(lnp) lnp->l_prev
-#define SHORT(lnp) lnp->l_a.la_short
-#define OFFSET(lnp) lnp->l_a.la_offset
-#define INSTRLAB(lnp) lnp->l_a.la_instrlab
-#define OBJ(lnp) lnp->l_a.la_obj
-#define PROC(lnp) lnp->l_a.la_proc
-#define ARG(lnp) lnp->l_a.la_arg
-
-
-/* Data structures for Use-Definition and Live-Dead Analysis */
-
-struct local {
- offset lc_off; /* offset of local in stackframe */
- short lc_size; /* size of local in bytes */
- short lc_flags; /* see below */
- offset lc_score; /* score in register message, if regvar */
- local_p lc_next; /* link, only used when building the list */
-};
-
-/* values of lc_flags */
-
-#define LCF_BAD 01
-/* Set when no ud-info for this local is maintained, e.g. when it is
- * overlapped by another local.
- */
-#define LCF_REG 02 /* register variable */
-#define LCF_LIVE 04 /* use by live-dead message generation */
-
-
-struct cond_tab {
- short mc_cond; /* Denotes a condition e.g. FITBYTE */
- short mc_tval; /* value for time optimization */
- short mc_sval; /* value for space optimization */
- short mc_dummy; /* allignment */
-};
-
-/* conditions: */
-
-#define DEFAULT 0
-#define FITBYTE 1
-#define IN_0_63 2
-#define IN_0_8 3
-
+++ /dev/null
-
-EMH=../../../h
-EML=../../../lib
-SHARE=../share
-OBJECTS=sp.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o $(SHARE)/stack_chg.o $(SHARE)/go.o
-SRC=sp.c
-all: $(OBJECTS)
-sp: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o sp -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-sp.o: ../share/alloc.h
-sp.o: ../share/aux.h
-sp.o: ../share/debug.h
-sp.o: ../share/files.h
-sp.o: ../share/get.h
-sp.o: ../share/global.h
-sp.o: ../share/go.h
-sp.o: ../share/lset.h
-sp.o: ../share/map.h
-sp.o: ../share/put.h
-sp.o: ../share/stack_chg.h
-sp.o: ../share/types.h
-sp.o: ../../../h/em_mnem.h
-sp.o: ../../../h/em_spec.h
-stack_chg.o: ../share/debug.h
-stack_chg.o: ../share/global.h
-stack_chg.o: ../share/types.h
-stack_chg.o: ../../../h/em_mnem.h
-stack_chg.o: ../../../h/em_spec.h
-stack_chg.o: pop_push.h
+++ /dev/null
-/* S T A C K P O L L U T I O N
- *
- * S P . C
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../share/go.h"
-#include "../share/stack_chg.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_spec.h"
-
-
-/* Stack pollution throws away the ASP instructions after a procedure call.
- * This saves a lot of code, at the cost of some extra stack space.
- * ASPs that are part of a loop are not removed.
- */
-
-#define BF_MARK 04
-#define MARK(b) b->b_flags |= BF_MARK
-#define NOT_MARKED(b) (!(b->b_flags&BF_MARK))
-#define IN_LOOP(b) (Lnrelems(b->b_loops) > 0)
-
-STATIC int Ssp; /* number of optimizations */
-
-/* According to the EM definition, the stack must be cleaned up
- * before any return. However, for some backends it causes no harm
- * if the stack is not cleaned up. If so, we can do Stack Pollution
- * more globally.
- */
-
-STATIC int globl_sp_allowed;
-
-
-#define IS_ASP(l) (INSTR(l) == op_asp && TYPE(l) == OPSHORT && SHORT(l) > 0)
-
-
-STATIC sp_machinit(f)
- FILE *f;
-{
- /* Read target machine dependent information for this phase */
- char s[100];
-
- for (;;) {
- while(getc(f) != '\n');
- fscanf(f,"%s",s);
- if (strcmp(s,"%%SP") == 0)break;
- }
- fscanf(f,"%d",&globl_sp_allowed);
-}
-comb_asps(l1,l2,b)
- line_p l1,l2;
- bblock_p b;
-{
- assert(INSTR(l1) == op_asp);
- assert(INSTR(l2) == op_asp);
- assert(TYPE(l1) == OPSHORT);
- assert(TYPE(l2) == OPSHORT);
-
- SHORT(l2) += SHORT(l1);
- rm_line(l1,b);
-}
-
-
-
-
-stack_pollution(b)
- bblock_p b;
-{
- /* For every pair of successive ASP instructions in basic
- * block b, try to combine the two into one ASP.
- */
-
- register line_p l;
- line_p asp,next = b->b_start;
- bool asp_seen = FALSE;
- int stack_diff,pop,push;
- bool ok;
-
- do {
- stack_diff = 0;
- for (l = next; l != (line_p) 0; l = next) {
- next = l->l_next;
- if (IS_ASP(l)) break;
- if (asp_seen) {
- if (INSTR(l) == op_ret) {
- stack_diff -= SHORT(l);
- } else {
- line_change(l,&ok,&pop,&push);
- if (!ok || (stack_diff -= pop) < 0) {
- /* can't eliminate last ASP */
- asp_seen = FALSE;
- } else {
- stack_diff += push;
- }
- }
- }
- }
- if (asp_seen) {
- if (l == (line_p) 0) {
- /* last asp of basic block */
- if (globl_sp_allowed &&
- NOT_MARKED(b) && !IN_LOOP(b)) {
- Ssp++;
- rm_line(asp,b);
- }
- } else {
- /* try to combine with previous asp */
- if (SHORT(l) == stack_diff) {
- Ssp++;
- comb_asps(asp,l,b);
- }
- }
- }
- asp = l;
- asp_seen = TRUE; /* use new ASP for next try! */
- } while (asp != (line_p) 0);
-}
-
-STATIC bool block_save(b)
- bblock_p b;
-{
-
- register line_p l;
- int stack_diff,pop,push;
- bool ok;
-
- stack_diff = 0;
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (INSTR(l) == op_ret) {
- stack_diff -= SHORT(l);
- break;
- }
- line_change(l,&ok,&pop,&push);
- /* printf("instr %d, pop %d,push %d,ok %d\n",INSTR(l),pop,push,ok); */
- if (!ok || (stack_diff -= pop) < 0) {
- return FALSE;
- } else {
- stack_diff += push;
- }
- }
- return stack_diff >= 0;
-}
-
-
-
-STATIC mark_pred(b)
- bblock_p b;
-{
- Lindex i;
- bblock_p x;
-
- for (i = Lfirst(b->b_pred); i != (Lindex) 0; i = Lnext(i,b->b_pred)) {
- x = (bblock_p) Lelem(i);
- if (NOT_MARKED(x)) {
- MARK(x);
- mark_pred(x);
- }
- }
-}
-
-
-
-
-
-STATIC mark_unsave_blocks(p)
- proc_p p;
-{
- register bblock_p b;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- if (NOT_MARKED(b) && !block_save(b)) {
- MARK(b);
- mark_pred(b);
- }
- }
-}
-
-
-sp_optimize(p)
- proc_p p;
-{
- register bblock_p b;
-
- mark_unsave_blocks(p);
- for (b = p->p_start; b != 0; b = b->b_next) {
- stack_pollution(b);
- }
-}
-
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,no_action,sp_optimize,sp_machinit,no_action);
- report("stack adjustments deleted",Ssp);
- exit(0);
-}
-
-
-
-
-/***** DEBUGGING:
-
-debug_stack_pollution(p)
- proc_p p;
-{
- register bblock_p b;
- register line_p l;
- int lcnt,aspcnt,instr;
-
- for (b = p->p_start; b != 0; b = b->b_next) {
- lcnt = 0; aspcnt = 0;
- for (l = b->b_start; l != 0; l= l->l_next) {
- instr = INSTR(l);
- if (instr >= sp_fmnem && instr <= sp_lmnem) {
- lcnt++;
- if (instr == op_asp && off_set(l) > 0) {
- aspcnt++;
- }
- }
- }
- printf("%d\t%d\n",aspcnt,lcnt);
- }
-}
-
-*/
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=-DVERBOSE
-SHARE=../share
-SR=.
-OBJECTS=sr.o sr_expr.o sr_reduce.o sr_iv.o sr_cand.o sr_xform.o sr_aux.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/files.o $(SHARE)/map.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/aux.o $(SHARE)/go.o
-SRC=sr.h sr_iv.h sr_reduce.h sr_cand.h sr_xform.h sr_expr.h sr_aux.h sr.c sr_iv.c sr_reduce.c sr_cand.c sr_xform.c sr_expr.c sr_aux.c
-all: $(OBJECTS)
-sr: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o sr -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-sr.o: ../share/alloc.h
-sr.o: ../share/debug.h
-sr.o: ../share/files.h
-sr.o: ../share/get.h
-sr.o: ../share/global.h
-sr.o: ../share/lset.h
-sr.o: ../share/map.h
-sr.o: ../share/put.h
-sr.o: ../share/types.h
-sr.o: sr.h
-sr.o: sr_aux.h
-sr.o: sr_iv.h
-sr_aux.o: ../../../h/em_mnem.h
-sr_aux.o: ../../../h/em_pseu.h
-sr_aux.o: ../share/aux.h
-sr_aux.o: ../share/debug.h
-sr_aux.o: ../share/global.h
-sr_aux.o: ../share/lset.h
-sr_aux.o: ../share/types.h
-sr_aux.o: sr.h
-sr_aux.o: sr_aux.h
-sr_aux.o: sr_xform.h
-sr_cand.o: ../../../h/em_mnem.h
-sr_cand.o: ../../../h/em_pseu.h
-sr_cand.o: ../share/aux.h
-sr_cand.o: ../share/cset.h
-sr_cand.o: ../share/debug.h
-sr_cand.o: ../share/global.h
-sr_cand.o: ../share/lset.h
-sr_cand.o: ../share/map.h
-sr_cand.o: ../share/types.h
-sr_cand.o: sr.h
-sr_cand.o: sr_aux.h
-sr_cand.o: sr_cand.h
-sr_expr.o: ../../../h/em_mnem.h
-sr_expr.o: ../share/aux.h
-sr_expr.o: ../share/debug.h
-sr_expr.o: ../share/global.h
-sr_expr.o: ../share/lset.h
-sr_expr.o: ../share/types.h
-sr_expr.o: sr.h
-sr_expr.o: sr_aux.h
-sr_expr.o: sr_iv.h
-sr_iv.o: ../../../h/em_mnem.h
-sr_iv.o: ../../../h/em_pseu.h
-sr_iv.o: ../share/alloc.h
-sr_iv.o: ../share/aux.h
-sr_iv.o: ../share/cset.h
-sr_iv.o: ../share/debug.h
-sr_iv.o: ../share/global.h
-sr_iv.o: ../share/lset.h
-sr_iv.o: ../share/types.h
-sr_iv.o: sr.h
-sr_iv.o: sr_aux.h
-sr_iv.o: sr_cand.h
-sr_iv.o: sr_iv.h
-sr_reduce.o: ../../../h/em_mes.h
-sr_reduce.o: ../../../h/em_mnem.h
-sr_reduce.o: ../../../h/em_pseu.h
-sr_reduce.o: ../../../h/em_reg.h
-sr_reduce.o: ../share/alloc.h
-sr_reduce.o: ../share/aux.h
-sr_reduce.o: ../share/debug.h
-sr_reduce.o: ../share/global.h
-sr_reduce.o: ../share/lset.h
-sr_reduce.o: ../share/types.h
-sr_reduce.o: sr.h
-sr_reduce.o: sr_aux.h
-sr_reduce.o: sr_expr.h
-sr_reduce.o: sr_reduce.h
-sr_reduce.o: sr_xform.h
-sr_xform.o: ../../../h/em_mnem.h
-sr_xform.o: ../../../h/em_pseu.h
-sr_xform.o: ../../../h/em_spec.h
-sr_xform.o: ../share/alloc.h
-sr_xform.o: ../share/aux.h
-sr_xform.o: ../share/debug.h
-sr_xform.o: ../share/def.h
-sr_xform.o: ../share/get.h
-sr_xform.o: ../share/global.h
-sr_xform.o: ../share/lset.h
-sr_xform.o: ../share/types.h
-sr_xform.o: sr.h
-sr_xform.o: sr_aux.h
-sr_xform.o: sr_xform.h
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "sr.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/files.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/lset.h"
-#include "../share/map.h"
-#include "../share/alloc.h"
-#include "../share/go.h"
-#include "sr_aux.h"
-#include "sr_iv.h"
-
-/* Strength reduction tries to change expensive operators occurring
- * in a loop into cheaper operators. The expensive operators considered
- * are multiplication and array referencing.
- * The transformations can be expressed in C as:
- *
- * [1]: for (i = e1; i <= e2; i++)
- * print(118*i);
- * becomes:
- * for (i = e1, t = 118*e1; i <= e2; i++, t += 118)
- * print(t);
- *
- * [2]: for (i = e1; i <= e2; i++)
- * print(a[i]);
- * becomes:
- * for (i = e1, p = &a[i]; i <= e2; i++, p++)
- * print(*p);
- * The latter optimization is suppressed if array bound checking
- * is required.
- */
-
-/* Machine and/or language dependent parameters: */
-
-bool ovfl_harmful;
-bool arrbound_harmful;
-
-int Ssr; /* #optimizations found */
-
-sr_machinit(f)
- FILE *f;
-{
- /* Read target machine dependent information */
- char s[100];
-
-
- for (;;) {
- while(getc(f) != '\n');
- fscanf(f,"%s",s);
- if (strcmp(s,"%%SR") == 0)break;
- }
- fscanf(f,"%d",&ovfl_harmful);
- fscanf(f,"%d",&arrbound_harmful);
-}
-
-STATIC del_ivs(ivs)
- lset ivs;
-{
- /* Delete the set of iv structs */
-
- Lindex i;
-
- for (i = Lfirst(ivs); i != (Lindex) 0; i = Lnext(i,ivs)) {
- oldiv(Lelem(i));
- }
- Ldeleteset(ivs);
-}
-
-
-STATIC do_loop(loop)
- loop_p loop;
-{
- lset ivs, vars;
-
- OUTTRACE("going to process loop %d",loop->lp_id);
- induc_vars(loop,&ivs, &vars);
- /* Build a set of iv_structs, one for every induction
- * variable of the loop, i.e. a variable i that
- * is changed only by i := i + c, where c is a loop constant.
- * Also detects variables that are changed (including induction
- * variables!).
- */
- OUTTRACE("loop has %d induction variables",Lnrelems(ivs));
- if (Lnrelems(ivs) > 0) {
- strength_reduction(loop,ivs,vars);
- /* Perform strength reduction. Reduce:
- * iv * c to addition
- * a[iv] to indirection (*p)
- * (unless array bound checking is required)
- */
- }
- del_ivs(ivs);
- Ldeleteset(vars);
-}
-
-
-
-STATIC loopblocks(p)
- proc_p p;
-{
- /* Compute the LP_BLOCKS sets for all loops of p */
-
- register bblock_p b;
- register Lindex i;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (i = Lfirst(b->b_loops); i != (Lindex) 0;
- i = Lnext(i,b->b_loops)) {
- Ladd(b,&(((loop_p) Lelem(i))->LP_BLOCKS));
- }
- }
-}
-
-
-
-STATIC opt_proc(p)
- proc_p p;
-{
- /* Optimize all loops of one procedure. We first do all
- * outer loops at the lowest nesting level and proceed
- * in the inwards direction.
- */
-
- Lindex i;
- loop_p lp,outermost;
- int min_level;
-
- for (;;) {
- min_level = 1000;
- for (i = Lfirst(p->p_loops); i != (Lindex) 0;
- i = Lnext(i,p->p_loops)) {
- lp = (loop_p) Lelem(i);
- if (!lp->LP_DONE && lp->lp_level < min_level) {
- min_level = lp->lp_level;
- outermost = lp;
- }
- }
- if (min_level == 1000) break;
- do_loop(outermost);
- outermost->LP_DONE = TRUE;
- OUTTRACE("loop %d processed",outermost->lp_id);
- }
-}
-
-
-
-STATIC sr_extproc(p)
- proc_p p;
-{
- /* Allocate the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- lp->lp_extend = newsrlpx();
- }
-}
-
-
-
-STATIC sr_cleanproc(p)
- proc_p p;
-{
- /* Remove the extended data structures for procedure p */
-
- register loop_p lp;
- register Lindex pi;
-
-
- for (pi = Lfirst(p->p_loops); pi != (Lindex) 0;
- pi = Lnext(pi,p->p_loops)) {
- lp = (loop_p) Lelem(pi);
- oldsrlpx(lp->lp_extend);
- }
-}
-
-
-sr_optimize(p)
- proc_p p;
-{
- sr_extproc(p);
- loopblocks(p);
- opt_proc(p);
- sr_cleanproc(p);
-}
-
-
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,no_action,sr_optimize,sr_machinit,no_action);
- report("strength reductions",Ssr);
- exit(0);
-}
+++ /dev/null
-/* I N T E R N A L D A T A S T R U C T U R E S O F
- *
- * S T R E N G T H R E D U C T I O N
- *
- */
-
-
-typedef struct iv *iv_p;
-typedef struct code_info *code_p;
-
-/* An induction variable */
-
-struct iv {
- offset iv_off; /* offset of the induction variable */
- line_p iv_incr; /* pointer to last instr. of EM-code that
- * increments the induction variable */
- offset iv_step; /* step value */
-};
-
-
-/* All information about a reducible piece of code is collected in
- * a single structure.
- */
-
-struct code_info {
- loop_p co_loop; /* the loop the code is in */
- bblock_p co_block; /* the basic block the code is in */
- line_p co_lfirst; /* first instruction of the code */
- line_p co_llast; /* last instruction of the code */
- line_p co_ivexpr; /* start of linear expr. using iv */
- line_p co_endexpr; /* end of the expression */
- int co_sign; /* sign of iv in above expr */
- iv_p co_iv; /* the induction variable */
- offset co_temp; /* temporary variable */
- int co_tmpsize; /* size of the temp. variable (ws or ps)*/
- int co_instr; /* the expensive instruction (mli,lar..)*/
- union {
- line_p co_loadlc; /* LOC lc instruction (for mult.)*/
- line_p co_desc; /* load address of descriptor
- * (for lar etc.) */
- } c_o;
-};
-
-#define LOAD 0
-#define STORE 1
-
-#define DLINK(l1,l2) l1->l_next=l2; l2->l_prev=l1
-
-#define same_local(l1,l2) (off_set(l1) == off_set(l2))
-
-#define LP_BLOCKS lp_extend->lpx_sr.lpx_blocks
-#define LP_DONE lp_extend->lpx_sr.lpx_done
-#define LP_HEADER lp_extend->lpx_sr.lpx_header
-#define LP_INSTR lp_extend->lpx_sr.lpx_instr
-
-/* Parameters to be provided by environment: */
-
-extern bool ovfl_harmful; /* Does overflow during multiplication
- * cause a trap ?
- */
-extern bool arrbound_harmful; /* Is it harmful to take the address of
- * a non-existing array element ?
- */
-extern int Ssr; /* #optimizations found */
-
-/* core allocation macros */
-#define newiv() (iv_p) newstruct(iv)
-#define newcinfo() (code_p) newstruct(code_info)
-#define newsrlpx() (lpext_p) newstruct(lpext_sr)
-#define oldiv(x) oldstruct(iv,x)
-#define oldcinfo(x) oldstruct(code_info,x)
-#define oldsrlpx(x) oldstruct(lpext_sr,x)
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ A U X . C
- *
- */
-
-
-#include "../share/types.h"
-#include "sr.h"
-#include "../share/debug.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "sr_aux.h"
-#include "sr_xform.h"
-
-#define INSIDE_LOOP(b,lp) Lis_elem(b,lp->LP_BLOCKS)
-
-
-bool is_loopconst(lnp,vars)
- line_p lnp;
- lset vars;
-{
- Lindex i;
-
- assert(TYPE(lnp) == OPSHORT || TYPE(lnp) == OPOFFSET);
- if (!is_regvar(off_set(lnp))) return FALSE;
- for (i = Lfirst(vars); i != (Lindex) 0; i = Lnext(i,vars)) {
- if (same_local(Lelem(i),lnp)) {
- return FALSE; /* variable was changed */
- }
- }
- return TRUE;
-}
-
-
-bool is_caddress(lnp,vars)
- line_p lnp;
- lset vars; /* variables changed in loop */
-{
- /* See if lnp is a single instruction (i.e. without arguments)
- * that pushes a loop-invariant entity of size pointer-size (ps)
- * on the stack.
- */
-
- if (lnp == (line_p) 0) return FALSE;
- switch(INSTR(lnp)) {
- case op_lae:
- case op_lal:
- return TRUE;
- case op_lol:
- return ps == ws && is_loopconst(lnp,vars);
- case op_ldl:
- return ps == 2*ws && is_loopconst(lnp,vars);
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-STATIC arg_p find_arg(n,list)
- int n;
- arg_p list;
-{
- /* Find the n-th element of the list */
-
- while (--n) {
- if (list == (arg_p) 0) break;
- list = list->a_next;
- }
- return list;
-}
-
-
-int elemsize(lnp)
- line_p lnp;
-{
- /* lnp is an instruction that loads the address of an array
- * descriptor. Find the size of the elements of the array.
- * If this size cannot be determined (e.g. the descriptor may
- * not be in a rom) then return UNKNOWN_SIZE.
- */
-
- dblock_p d;
- arg_p v;
-
- assert (lnp != (line_p) 0);
- if (INSTR(lnp) == op_lae) {
- d = OBJ(lnp)->o_dblock; /* datablock */
- if (d->d_pseudo == DROM &&
- (v = find_arg(3,d->d_values)) != (arg_p) 0 &&
- v->a_type == ARGOFF) {
- return (int) v->a_a.a_offset;
- }
- }
- return UNKNOWN_SIZE;
-}
-
-
-
-concatenate(list1,list2)
- line_p list1,list2;
-{
- /* Append list2 to the end of list1. list1 may not be empty. */
-
- register line_p l;
-
- assert(list1 != (line_p) 0);
- for (l =list1; l->l_next != (line_p) 0; l = l->l_next);
- l->l_next = list2;
-}
+++ /dev/null
-/* S R _ A U X . H */
-
-
-extern bool is_loopconst(); /* (line_p l; lset vars)
- * See if l is a loop-constant. vars is the
- * set of variables changed in the loop.
- */
-extern bool is_caddress(); /* (line_p l)
- * See if l loads a loop-invariant entity of
- * size pointer-size.
- */
-extern int elemsize(); /* (line_p l)
- * l is an instruction that loads an array
- * descriptor. Try to determine the size
- * of the array elements.
- */
-extern concatenate(); /* (line_p list1,list2)
- * Append list2 to the end of list1
- */
-#define is_const(l) (INSTR(l) == op_loc)
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ C A N D . C
- */
-
-
-#include "../share/types.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/map.h"
-#include "../share/aux.h"
-#include "sr.h"
-#include "sr_aux.h"
-#include "sr_cand.h"
-
-
-/* A candidate induction variable of a loop (hereafter called candidate) is a
- * local variable (of the current procedure) that is assigned a value
- * precisely once within the loop. Furthermore, this assignment must
- * take place in a firm block of the loop.
- * We determine those locals that are assigned precisely once, within
- * a firm block;
- *
- * We represent a local variable via an instruction that references it,
- * e.g. LOL -6 represents the local variable at offset -6 with size=wordsize.
- * We keep track of two sets:
- * cand - the set of all candidate variables
- * dismiss - a set of variables that may not be made a candidate
- * (because they are assigned more than once, or because
- * they are assigned outside a firm block).
- * Only local variables for which a register message is given are considered.
- */
-
-
-STATIC lset cand, /* set of candidates */
- dism; /* set of dismissed variables */
-
-
-#define ALL_LINES(lnp,list) lnp = list; lnp != (line_p) 0; lnp = lnp->l_next
-
-
-
-STATIC un_cand(lnp)
- line_p lnp;
-{
- /* remove the variable stored into by lnp from the list of
- * candidates (if it was there anyway).
- */
-
- Lindex i, next;
-
- for (i = Lfirst(cand); i != (Lindex) 0; i = next) {
- next = Lnext(i,cand);
- if (same_local(lnp,Lelem(i))) {
- OUTTRACE("remove candidate",0);
- Lremove(Lelem(i), &cand);
- }
- }
-}
-
-
-STATIC bool is_cand(lnp)
- line_p lnp;
-{
- /* see if the variable stored into by lnp is a candate */
-
- Lindex i;
-
- for (i = Lfirst(cand); i != (Lindex) 0; i = Lnext(i,cand)) {
- if (same_local(lnp,Lelem(i))) {
- return TRUE;
- }
- }
- return FALSE;
-}
-
-
-STATIC make_cand(lnp)
- line_p lnp;
-{
- /* make the variable stored into by lnp a candidate */
-
-
- OUTTRACE("add a new candidate",0);
- Ladd(lnp,&cand);
-}
-
-
-
-STATIC do_dismiss(lnp)
- line_p lnp;
-{
- Ladd(lnp,&dism);
-}
-
-
-STATIC dismiss(lnp)
- line_p lnp;
-{
- /* The variable referenced by lnp is turned definitely into
- * a non-candidate.
- */
-
- un_cand(lnp); /* remove it from the candidate set,
- * if it was there in the first place.
- */
- do_dismiss(lnp); /* add it to the set of dismissed variables */
-}
-
-
-STATIC bool not_dismissed(lnp)
- line_p lnp;
-{
- Lindex i;
-
- for (i = Lfirst(dism); i != (Lindex) 0; i = Lnext(i,dism)) {
- if (same_local(Lelem(i),lnp)) {
- return FALSE; /* variable was dismissed */
- }
- }
- return TRUE;
-}
-
-
-STATIC try_cand(lnp,b)
- line_p lnp;
- bblock_p b;
-{
- /* If the variable stored into by lnp was not already a candidate
- * and was not dismissed, then it is made a candidate
- * (unless the assignment takes places in a block that is not firm).
- */
-
- if (!is_regvar(off_set(lnp))) return;
- if (is_cand(lnp) || !IS_FIRM(b)) {
- dismiss(lnp);
- } else {
- if (not_dismissed(lnp)) {
- make_cand(lnp);
- }
- }
-}
-
-
-candidates(lp,cand_out,vars_out)
- loop_p lp;
- lset *cand_out, *vars_out;
-{
- /* Find the candidate induction variables.
- */
-
- bblock_p b;
- line_p lnp;
- Lindex i;
-
- OUTTRACE("find candidates of loop %d",lp->lp_id);
- cand = Lempty_set();
- dism = Lempty_set();
-
- for (i = Lfirst(lp->LP_BLOCKS); i != (Lindex) 0;
- i = Lnext(i,lp->LP_BLOCKS)) {
- b = (bblock_p) Lelem(i);
- for ( ALL_LINES(lnp, b->b_start)) {
- OUTTRACE("inspect instruction %d",INSTR(lnp));
- switch(INSTR(lnp)) {
- case op_stl:
- case op_inl:
- case op_del:
- OUTTRACE("it's a store local",0);
- try_cand(lnp,b);
- break;
- case op_zrl:
- OUTTRACE("it's a destroy local",0);
- if (is_regvar(off_set(lnp))) {
- dismiss(lnp);
- }
- break;
- }
- }
- }
- *cand_out = cand;
- *vars_out = dism;
-}
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ C A N D . H
- */
-
-
-extern candidates(); /* (loop_p lp; lset *iv_cand, *vars)
- * Find candidate induction variables,
- * i.e. local variables that are assigned
- * a value precisely once within the loop,
- * within a strong block. Also find the
- * local variables that are changed within
- * the loop, but that are not a candidate.
- */
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ E X P R . C
- *
- */
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "sr.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/aux.h"
-#include "sr_aux.h"
-#include "../share/lset.h"
-#include "sr_iv.h"
-#include "../../../h/em_mnem.h"
-
-
-
-#define ME_NONE 0
-#define ME_UNAIR 1
-#define ME_BINAIR 2
-#define ME_LOOPCONST 3
-#define ME_IV 4
-
-
-
-STATIC iv_p last_iv;
-STATIC int iv_sign;
-STATIC lset ivars, loopvars;
-
-STATIC bool is_loadiv(lnp)
- line_p lnp;
-{
- /* See if lnp is a LOL iv instruction, where iv is an
- * induction variable of the set ivars. If so, set the
- * the global variable last_iv to its descriptor.
- */
-
- Lindex i;
- iv_p iv;
- offset off;
-
- if (INSTR(lnp) == op_lol) {
- off = off_set(lnp);
- for (i = Lfirst(ivars); i != (Lindex) 0; i = Lnext(i,ivars)) {
- iv = (iv_p) Lelem(i);
- if (iv->iv_off == off) {
- last_iv = iv;
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-
-
-
-#define size_ok(l) (TYPE(l) == OPSHORT && SHORT(l) == ws)
-
-
-STATIC int me_kind(l,sign_in,sign_out)
- line_p l;
- int sign_in, *sign_out;
-{
- if (l != (line_p) 0) {
- switch(INSTR(l)) {
- case op_adi:
- case op_adu:
- if (size_ok(l)) {
- *sign_out = sign_in;
- return ME_BINAIR;
- }
- break;
- case op_sbi:
- case op_sbu:
- if (size_ok(l)) {
- *sign_out = - sign_in;
- return ME_BINAIR;
- }
- break;
- case op_ngi:
- if (size_ok(l)) {
- *sign_out = - sign_in;
- return ME_UNAIR;
- }
- break;
- case op_inc:
- case op_dec:
- *sign_out = sign_in;
- return ME_UNAIR;
- case op_loc:
- return ME_LOOPCONST;
- case op_lol:
- if (is_loadiv(l)) {
- iv_sign = sign_in;
- return ME_IV;
- }
- if (is_loopconst(l,loopvars)) return ME_LOOPCONST;
- }
- }
- return ME_NONE;
-}
-
-
-
-STATIC bool match_expr(l,iv_allowed,lbegin,iv_seen,sign)
- line_p l,*lbegin;
- bool iv_allowed, *iv_seen;
- int sign;
-{
- /* This routine is a top down parser for simple
- * EM expressions. It recognizes expressions that
- * have as operators + and - (unary - is also allowed)
- * and that have as operands a number of loop constants
- * (either a constant or a variable that is not
- * changed within the loop) and at most one induction
- * variable.
- * The parameter iv_allowed is propagated downwards
- * in the expression tree, indicating whether the
- * subexpression may use an induction variable as
- * operand. The parameter iv_seen is propagated
- * upwards, indicating if the subexpression has used
- * an induction variable. The parameter sign is
- * propagated downwards; it indicates the sign of
- * the subexpression. lbegin will point to the
- * beginning of the recognized subexpression
- * (it is an out parameter). Note that we scan the
- * EM text from right to left (i.e. top down).
- */
-
- line_p l1;
- bool iv_insubexpr;
- int sign2;
-
- switch(me_kind(l,sign,&sign2)) {
- case ME_UNAIR:
- /* unairy operator, match one subexpression */
- if (match_expr(PREV(l),iv_allowed,&l1,&iv_insubexpr,sign2)) {
- *lbegin = l1;
- *iv_seen = iv_insubexpr;
- return TRUE;
- }
- return FALSE;
- case ME_BINAIR:
- /* binairy operator, match two subexpressions */
- if (match_expr(PREV(l), iv_allowed, &l1, &iv_insubexpr,sign2)) {
- l = PREV(l1);
- iv_allowed = iv_allowed && !iv_insubexpr;
- if (match_expr(l,iv_allowed,&l1,
- &iv_insubexpr,sign)) {
- *lbegin = l1;
- *iv_seen = !iv_allowed || iv_insubexpr;
- return TRUE;
- }
- }
- return FALSE; /* subexpression not recognized */
- case ME_LOOPCONST:
- *lbegin = l; /* expression is a loop constant */
- *iv_seen = FALSE;
- return TRUE;
- case ME_IV:
- if (iv_allowed) {
- *iv_seen = TRUE;
- *lbegin = l;
- return TRUE;
- }
- /* fall through ... */
- default:
- return FALSE;
- }
-}
-
-
-bool is_ivexpr(l,ivs,vars,lbegin_out,iv_out,sign_out)
- line_p l, *lbegin_out;
- lset ivs,vars;
- iv_p *iv_out;
- int *sign_out;
-{
- line_p l2;
- bool iv_seen;
-
-
- loopvars = vars;
- ivars = ivs;
- if (match_expr(l,TRUE,&l2,&iv_seen,1)) {
- if (iv_seen) {
- /* recognized a correct expression */
- *lbegin_out = l2;
- *iv_out = last_iv;
- *sign_out = iv_sign;
- return TRUE;
- }
- }
- return FALSE;
-}
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ E X P R . H
- *
- */
-
-extern bool is_ivexpr();/* (line_p l; lset ivs,vars; line_p *lbegin; iv_p *iv;
- * int *out_sign)
- * Try to recognize an expression that is a linear
- * function of presicely one induction variable.
- * It may only use loop constants (besides the
- * induc. var.).
- */
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ I V . C
- *
- */
-
-
-#include "../share/types.h"
-#include "sr.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "sr_aux.h"
-#include "sr_cand.h"
-#include "sr_iv.h"
-
-
-
-STATIC lset ivvars; /* set of induction variables */
-
-STATIC short nature(lnp)
- line_p lnp;
-{
- /* Auxiliary routine used by inc_or_dec, is_add and plus_or_min.
- * Determine if lnp had INCREMENT/DECREMENT-nature (1),
- * ADD-nature (2), SUBTRACT-nature (3)
- * or Buddha-nature (0).
- */
-
- bool size_ok;
-
- assert(lnp != (line_p) 0);
- size_ok = (TYPE(lnp) == OPSHORT && SHORT(lnp) == ws);
- switch(INSTR(lnp)) {
- case op_inc:
- case op_dec:
- return 1;
- case op_adi:
- case op_adu:
- return (size_ok? 2:0);
- case op_sbi:
- case op_sbu:
- return (size_ok? 3:0);
- }
- return 0;
-}
-
-
-
-#define is_add(l) (nature(l) == 2)
-#define plus_or_min(l) (nature(l) > 1)
-#define inc_or_dec(l) (nature(l) == 1)
-
-
-STATIC bool is_same(l,lnp)
- line_p l, lnp;
-{
- /* lnp is a STL x , where x is a candidate
- * induction variable. See if l is a LOL x
- * (with the same x as the store-instruction)
- */
-
- assert(INSTR(lnp) == op_stl);
- return l != (line_p) 0 && INSTR(l) == op_lol &&
- off_set(l) == off_set(lnp);
-}
-
-
-STATIC ivar(lnp,step)
- line_p lnp;
- int step;
-{
- /* Record the fact that we've found a new induction variable.
- * lnp points to the last instruction of the code that
- * increments the induction variable, i.e. a STL, DEL or INL.
- */
-
- iv_p i;
-
- i = newiv();
- i->iv_off = (TYPE(lnp) == OPSHORT ? (offset) SHORT(lnp) : OFFSET(lnp));
- i->iv_incr = lnp; /* last instruction of increment code */
- i->iv_step = step; /* step value */
- Ladd(i,&ivvars);
-}
-
-
-STATIC int sign(lnp)
- line_p lnp;
-{
- switch(INSTR(lnp)) {
- case op_inc:
- case op_inl:
- case op_adi:
- case op_adu:
- return 1;
- case op_dec:
- case op_del:
- case op_sbi:
- case op_sbu:
- return (-1);
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-STATIC try_patterns(lnp)
- line_p lnp;
-{
- /* lnp is a STL x; try to recognize
- * one of the patterns:
- * 'LOAD const; LOAD x; ADD; STORE x'
- * or 'LOAD x; LOAD const; ADD or SUBTRACT;
- * STORE x'
- * or 'LOAD x; INCREMENT/DECREMENT; STORE x'
- */
-
- line_p l, l2;
-
- l = PREV(lnp); /* instruction before lnp*/
- if (l == (line_p) 0) return; /* no match possible */
- l2 = PREV(l);
- if (inc_or_dec(l)) {
- if (is_same(l2,lnp)) {
- /* e.g. LOL iv ; INC ; STL iv */
- ivar(lnp,sign(l));
- }
- return;
- }
- if (is_add(lnp)) {
- if(is_same(l2,lnp) && is_const(PREV(l2))) {
- ivar(lnp,SHORT(PREV(l2)));
- return;
- }
- }
- if (plus_or_min(l)) {
- if (is_const(l2) && is_same(PREV(l2),lnp)) {
- ivar(lnp,sign(l) * SHORT(l2));
- }
- }
-}
-
-
-induc_vars(loop,ivar_out, vars_out)
- loop_p loop;
- lset *ivar_out, *vars_out;
-{
- /* Construct the set of induction variables. We use several
- * global variables computed by 'candidates'.
- */
-
- Lindex i;
- line_p lnp;
- lset cand_iv, vars;
-
- ivvars = Lempty_set();
- candidates(loop, &cand_iv, &vars);
- /* Find the set of all variables that are assigned precisely
- * once within the loop, within a firm block.
- * Also find all remaining local variables that are changed
- * within the loop.
- */
- if (Lnrelems(cand_iv) > 0) {
- for (i = Lfirst(cand_iv); i != (Lindex) 0; i = Lnext(i,cand_iv)) {
- lnp = (line_p) Lelem(i);
- if (INSTR(lnp) == op_inl || INSTR(lnp) == op_del) {
- ivar(lnp,sign(lnp));
- } else {
- try_patterns(lnp);
- }
- }
- }
- Ljoin(cand_iv, &vars);
- *ivar_out = ivvars;
- *vars_out = vars;
-}
+++ /dev/null
-/* S R _ I V . H */
-
-extern induc_vars(); /* (loop_p loop; lset *ivars, *vars)
- * Find the set of induction variables
- * of the loop. Also find the set of (local)
- * variables that are changed.
- */
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ R E D U C E . C
- *
- */
-
-
-#include "../share/types.h"
-#include "sr.h"
-#include "../../../h/em_mnem.h"
-#include "../share/debug.h"
-#include "../share/alloc.h"
-#include "../share/global.h"
-#include "../share/aux.h"
-#include "sr_aux.h"
-#include "../share/lset.h"
-#include "sr_xform.h"
-#include "sr_reduce.h"
-#include "sr_expr.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_reg.h"
-#include "../../../h/em_mes.h"
-#include "../../../h/em_mnem.h"
-
-
-
-STATIC lset avail;
-/* If an expression such as "iv * const" or "A[iv]" is
- * used more than once in a loop, we only use one temporary
- * local for it and reuse this local each time.
- * After the first occurrence, the expression is said to
- * be available.
- */
-
-STATIC int regtyp(code)
- code_p code;
-{
- switch(code->co_instr) {
- case op_mli:
- case op_mlu:
- return reg_any;
- default:
- return reg_pointer;
- }
- /* NOTREACHED */
-}
-
-
-STATIC gen_regmes(tmp,score,code,p)
- offset tmp;
- int score;
- code_p code;
- proc_p p;
-{
- /* generate a register message for the temporary variable and
- * insert it at the start of the procedure.
- */
-
- line_p l,pro;
-
- l = reg_mes(tmp,code->co_tmpsize,regtyp(code),score);
- pro = p->p_start->b_start; /* every proc. begins with a PRO pseudo */
- l->l_next = pro->l_next;
- PREV(l->l_next) = l;
- pro->l_next = l;
- PREV(l) = pro;
-}
-
-
-STATIC line_p newcode(code,tmp)
- code_p code;
- offset tmp;
-{
- /* Construct the EM code that will replace the reducible code,
- * e.g. iv * c -> tmp
- * a[iv] -> *tmp
- */
-
- line_p l;
-
- switch(code->co_instr) {
- case op_mli:
- case op_mlu:
- /* new code is just a LOL tmp */
- l = int_line(tmp);
- l->l_instr = op_lol;
- break;
- case op_aar:
- /* New code is a LOAD tmp, where tmp is a
- * pointer variable, so the actual EM code
- * depends on the pointer size.
- */
- l = move_pointer(tmp,LOAD);
- break;
- case op_lar:
- /* New code is a load-indirect */
- l = int_line(tmp);
- l->l_instr = op_lil;
- break;
- case op_sar:
- /* New code is a store-indirect */
- l = int_line(tmp);
- l->l_instr = op_sil;
- break;
- default:
- assert(FALSE);
- }
- return l;
-}
-
-
-
-STATIC replcode(code,text)
- code_p code;
- line_p text;
-{
- /* Replace old code (extending from code->co_lfirst to
- * code->co_llast) by new code (headed by 'text').
- */
-
- line_p l, l1, l2;
-
- for (l = text; l->l_next != (line_p) 0; l = l->l_next);
- /* 'l' now points to last instruction of text */
- l1 = PREV(code->co_lfirst); /* instruction just before old code */
- l2 = code->co_llast->l_next; /* instruction just behind old code */
- if (l1 == (line_p) 0) {
- code->co_block->b_start = text;
- PREV(text) = (line_p) 0;
- } else {
- l1->l_next = text;
- PREV(text) = l1;
- }
- if (l2 != (line_p) 0) {
- PREV(l2) = l;
- }
- l->l_next = l2;
- code->co_llast->l_next = (line_p) 0;
- /* Note that the old code is still accessible via code->co_lfirst */
-}
-
-
-
-STATIC init_code(code,tmp)
- code_p code;
- offset tmp;
-{
- /* Generate code to set up the temporary local.
- * For multiplication, its initial value is const*iv_expr,
- * for array operations it is &a[iv_expr] (where iv_expr is
- * an expression that is a linear function of the induc. var.
- * This code is inserted immediately before the loop entry.
- * As the initializing code looks very much like the
- * reduced code, we reuse that (old) code.
- */
-
- line_p l, *p;
-
- l = code->co_llast; /* the mli, lar etc. instruction */
- switch(INSTR(l)) {
- case op_mli:
- case op_mlu:
- /* reduced code is: iv_expr * lc (or lc * iv_expr)
- * init_code is: tmp = iv_expr * lc (or lc*iv_expr)
- * So we just insert a 'STL tmp'.
- */
- l->l_next = int_line(tmp);
- l->l_next->l_instr = op_stl;
- break;
- case op_lar:
- case op_sar:
- /* reduced code is: ...= A[iv_expr] resp.
- * A[iv]_expr = ..
- * init_code is: tmp = &A[iv_expr].
- * So just change the lar or sar into a aar ...
- */
- l->l_instr = (byte) op_aar;
- /* ... and fall through !! */
- case op_aar:
- /* append code to store a pointer in temp. local */
- l->l_next = move_pointer(tmp,STORE);
- break;
- default:
- assert(FALSE); /* non-reducible instruction */
- }
- PREV(l->l_next) = l;
- /* Now insert the code at the end of the header block */
- p = &code->co_loop->LP_INSTR;
- if (*p == (line_p) 0) {
- /* LP_INSTR points to last instruction of header block,
- * so if it is 0, the header block is empty yet.
- */
- code->co_loop->LP_HEADER->b_start =
- code->co_lfirst;
- } else {
- (*p)->l_next = code->co_lfirst;
- PREV(code->co_lfirst) = *p;
- }
- *p = l->l_next; /* new last instruction */
-}
-
-
-
-STATIC incr_code(code,tmp)
- code_p code;
- offset tmp;
-{
- /* Generate code to increment the temporary local variable.
- * The variable is incremented by
- * 1) multiply --> step value of iv * loop constant
- * 2) array --> step value of iv * element size
- * This value can be determined statically.
- * If the induction variable is used in a linear
- * expression in which its sign is negative
- * (such as in: "5-(6-(-iv))" ), this value is negated.
- * The generated code looks like:
- * LOL tmp ; LOC incr ; ADI ws ; STL tmp
- * For pointer-increments we generate a "ADP c", rather than
- * a "LOC c; ADS ws".
- * This code is put just after the code that increments
- * the induction variable.
- */
-
- line_p load_tmp, loc, add, store_tmp, l;
-
- add = newline(OPSHORT);
- SHORT(add) = ws; /* the add instruction, can be ADI,ADU or ADS */
- switch(code->co_instr) {
- case op_mli:
- case op_mlu:
- loc = int_line(
- code->co_sign *
- off_set(code->c_o.co_loadlc) *
- code->co_iv->iv_step);
- loc->l_instr = op_loc;
- add->l_instr = op_adi;
- load_tmp = int_line(tmp);
- load_tmp->l_instr = op_lol;
- store_tmp = int_line(tmp);
- store_tmp->l_instr = op_stl;
- break;
- case op_lar:
- case op_sar:
- case op_aar:
- loc = (line_p) 0;
- add = int_line(
- code->co_sign *
- code->co_iv->iv_step *
- elemsize(code->c_o.co_desc));
- add->l_instr = op_adp;
- load_tmp = move_pointer(tmp,LOAD);
- store_tmp = move_pointer(tmp,STORE);
- break;
- default:
- assert(FALSE);
- }
- /* Now we've got pieces of code to load the temp. local,
- * load the constant, add the two and store the result in
- * the local. This code will be put just after the code that
- * increments the induction variable.
- */
- if (loc != (line_p) 0) concatenate(load_tmp,loc);
- concatenate(load_tmp,add);
- concatenate(load_tmp,store_tmp);
- /* Now load_tmp points to a list of EM instructions */
- l = code->co_iv->iv_incr;
- if (l->l_next != (line_p) 0) {
- DLINK(store_tmp,l->l_next);
- }
- DLINK(l,load_tmp); /* doubly link them */
-}
-
-
-STATIC remcode(c)
- code_p c;
-{
- line_p l, next;
-
- for (l = c->co_lfirst; l != (line_p) 0; l = next) {
- next = l->l_next;
- oldline(l);
- }
- oldcinfo(c);
-}
-
-
-STATIC bool same_address(l1,l2,vars)
- line_p l1,l2;
- lset vars;
-{
- /* See if l1 and l2 load the same address */
-
- if (INSTR(l1) != INSTR(l2)) return FALSE;
- switch(INSTR(l1)) {
- case op_lae:
- return OBJ(l1) == OBJ(l2);
- case op_lal:
- return off_set(l1) == off_set(l2);
- case op_lol:
- return ps == ws &&
- off_set(l1) == off_set(l2) &&
- is_loopconst(l1,vars);
- case op_ldl:
- return ps == 2*ws &&
- off_set(l1) == off_set(l2) &&
- is_loopconst(l1,vars);
- default:
- return FALSE;
- }
-}
-
-
-STATIC bool same_expr(lb1,le1,lb2,le2)
- line_p lb1,le1,lb2,le2;
-{
- /* See if the code from lb1 to le1 is the same
- * expression as the code from lb2 to le2.
- */
-
-
- register line_p l1,l2;
-
- l1 = lb1;
- l2 = lb2;
- for (;;) {
- if (INSTR(l1) != INSTR(l2)) return FALSE;
- switch(TYPE(l1)) {
- case OPSHORT:
- if (TYPE(l2) != OPSHORT ||
- SHORT(l1) != SHORT(l2)) return FALSE;
- break;
- case OPOFFSET:
- if (TYPE(l2) != OPOFFSET ||
- OFFSET(l1) != OFFSET(l2)) return FALSE;
- break;
- case OPNO:
- break;
- default:
- return FALSE;
- }
- if (l1 == le1 ) return l2 == le2;
- if (l2 == le2) return FALSE;
- l1 = l1->l_next;
- l2 = l2->l_next;
- }
-}
-
-STATIC bool same_code(c1,c2,vars)
- code_p c1,c2;
- lset vars;
-{
- /* See if c1 and c2 compute the same expression. Two array
- * references can be the same even if one is e.g a fetch
- * and the other a store.
- */
-
- switch(c1->co_instr) {
- case op_mli:
- return c1->co_instr == c2->co_instr &&
- off_set(c1->c_o.co_loadlc) ==
- off_set(c2->c_o.co_loadlc) &&
- same_expr(c1->co_ivexpr,c1->co_endexpr,
- c2->co_ivexpr,c2->co_endexpr);
- case op_aar:
- case op_lar:
- case op_sar:
- return c2->co_instr != op_mli &&
- c2->co_instr != op_mlu &&
- same_expr(c1->co_ivexpr,c1->co_endexpr,
- c2->co_ivexpr,c2->co_endexpr) &&
- same_address(c1->c_o.co_desc,c2->c_o.co_desc,vars) &&
- same_address(c1->co_lfirst,c2->co_lfirst,vars);
- default:
- assert(FALSE);
- }
- /* NOTREACHED */
-}
-
-
-STATIC code_p available(c,vars)
- code_p c;
- lset vars;
-{
- /* See if the code is already available.
- * If so, return a pointer to the first occurrence
- * of the code.
- */
-
- Lindex i;
- code_p cp;
-
- for (i = Lfirst(avail); i != (Lindex) 0; i = Lnext(i,avail)) {
- cp = (code_p) Lelem(i);
- if (same_code(c,cp,vars)) {
- return cp;
- }
- }
- return (code_p) 0;
-}
-
-
-
-STATIC reduce(code,vars)
- code_p code;
- lset vars;
-{
- /* Perform the actual transformations. The code on the left
- * gets transformed into the code on the right. Note that
- * each piece of code is assigned a name, that will be
- * used to describe the whole process.
- *
- * t = iv * 118; (init_code)
- * do ---> do
- * .. iv * 118 .. .. t .. (new_code)
- * iv++; iv++;
- * t += 118; (incr_code)
- * od od
- */
-
- offset tmp;
- code_p ac;
-
- OUTTRACE("succeeded!!",0);
- if ((ac = available(code,vars)) != (code_p) 0) {
- /* The expression is already available, so we
- * don't have to generate a new temporary local for it.
- */
- OUTTRACE("expression was already available",0);
- replcode(code,newcode(code,ac->co_temp));
- remcode(code);
- } else {
- make_header(code->co_loop);
- /* make sure there's a header block */
- tmp = tmplocal(curproc,code->co_tmpsize);
- code->co_temp = tmp;
- /* create a new local variable in the stack frame
- * of current proc.
- */
- gen_regmes(tmp,3,code,curproc); /* generate register message */
- /* score is set to 3, as TMP is used at least 3 times */
- replcode(code,newcode(code,tmp));
- OUTTRACE("replaced old code by new code",0);
- /* Construct the EM-code that will replace the reducible code
- * and replace the old code by the new code.
- */
- init_code(code,tmp);
- OUTTRACE("emitted initializing code",0);
- /* Emit code to initialize the temporary local. This code is
- * put in the loop header block.
- */
- incr_code(code,tmp); /* emit code to increment temp. local */
- OUTTRACE("emitted increment code",0);
- Ladd(code,&avail);
- }
-}
-
-
-
-STATIC try_multiply(lp,ivs,vars,b,mul)
- loop_p lp;
- lset ivs,vars;
- bblock_p b;
- line_p mul;
-{
- /* See if we can reduce the strength of the multiply
- * instruction. If so, then set up the global common
- * data structure 'c' (containing information about the
- * code to be reduced) and call 'reduce'.
- */
-
- line_p l2,lbegin;
- iv_p iv;
- code_p c;
- int sign;
-
- VL(mul);
- OUTTRACE("trying multiply instruction on line %d",linecount);
- if (ovfl_harmful && !IS_STRONG(b)) return;
- /* If b is not a strong block, optimization may
- * introduce an overflow error in the initializing code.
- */
-
- l2 = PREV(mul); /* Instruction before the multiply */
- if ( (is_ivexpr(l2,ivs,vars,&lbegin,&iv,&sign)) &&
- is_const(PREV(lbegin)) ) {
- /* recognized expression "const * iv_expr" */
- c = newcinfo();
- c->c_o.co_loadlc = PREV(l2);
- c->co_endexpr = l2;
- } else {
- if (is_const(l2) &&
- (is_ivexpr(PREV(l2),ivs,vars,&lbegin,&iv,&sign))) {
- /* recognized "iv * const " */
- c = newcinfo();
- c->c_o.co_loadlc = l2;
- c->co_endexpr = PREV(l2);
- } else {
- OUTTRACE("failed",0);
- return;
- }
- }
- /* common part for both patterns */
- c->co_iv = iv;
- c->co_loop = lp;
- c->co_block = b;
- c->co_lfirst = PREV(l2);
- c->co_llast = mul;
- c->co_ivexpr = lbegin;
- c->co_sign = sign;
- c->co_tmpsize = ws; /* temp. local is a word */
- c->co_instr = INSTR(mul);
- OUTVERBOSE("sr: multiply in proc %d loop %d",
- curproc->p_id, lp->lp_id);
- Ssr++;
- reduce(c,vars);
-}
-
-
-
-STATIC try_array(lp,ivs,vars,b,arr)
- loop_p lp;
- lset ivs,vars;
- bblock_p b;
- line_p arr;
-{
- /* See if we can reduce the strength of the array reference
- * instruction 'arr'.
- */
-
- line_p l2,l3,lbegin;
- iv_p iv;
- code_p c;
- int sign;
-
- /* Try to recognize the pattern:
- * LOAD ADDRES OF A
- * LOAD IV
- * LOAD ADDRESS OF DESCRIPTOR
- */
- VL(arr);
- OUTTRACE("trying array instruction on line %d",linecount);
- if (arrbound_harmful && !IS_STRONG(b)) return;
- /* If b is not a strong block, optimization may
- * introduce an array bound error in the initializing code.
- */
- l2 = PREV(arr);
- if (is_caddress(l2,vars) &&
- (INSTR(arr) == op_aar || elemsize(l2) == ws) &&
- (is_ivexpr(PREV(l2),ivs,vars,&lbegin,&iv,&sign)) ) {
- l3 = PREV(lbegin);
- if (is_caddress(l3,vars)) {
- c = newcinfo();
- c->co_iv = iv;
- c->co_loop = lp;
- c->co_block = b;
- c->co_lfirst = l3;
- c->co_llast = arr;
- c->co_ivexpr = lbegin;
- c->co_endexpr = PREV(l2);
- c->co_sign = sign;
- c->co_tmpsize = ps; /* temp. local is pointer */
- c->co_instr = INSTR(arr);
- c->c_o.co_desc = l2;
- OUTVERBOSE("sr: array in proc %d loop %d",
- curproc->p_id,lp->lp_id);
- Ssr++;
- reduce(c,vars);
- }
- }
-}
-
-
-
-STATIC clean_avail()
-{
- Lindex i;
-
- for (i = Lfirst(avail); i != (Lindex) 0; i = Lnext(i,avail)) {
- oldcinfo(Lelem(i));
- }
- Ldeleteset(avail);
-}
-
-
-
-strength_reduction(lp,ivs,vars)
- loop_p lp; /* description of the loop */
- lset ivs; /* set of induction variables of the loop */
- lset vars; /* set of local variables changed in loop */
-{
- /* Find all expensive instructions (multiply, array) and see if
- * they can be reduced. We branch to several instruction-specific
- * routines (try_...) that check if reduction is possible,
- * and that set up a common data structure (code_info).
- * The actual transformations are done by 'reduce', that is
- * essentially instruction-independend.
- */
-
- bblock_p b;
- line_p l, next;
- Lindex i;
-
- avail = Lempty_set();
- for (i = Lfirst(lp->LP_BLOCKS); i != (Lindex) 0;
- i = Lnext(i,lp->LP_BLOCKS)) {
- b = (bblock_p) Lelem(i);
- for (l = b->b_start; l != (line_p) 0; l = next) {
- next = l->l_next;
- if (TYPE(l) == OPSHORT && SHORT(l) == ws) {
- switch(INSTR(l)) {
- case op_mlu:
- case op_mli:
- try_multiply(lp,ivs,vars,b,l);
- break;
- case op_lar:
- case op_sar:
- case op_aar:
- try_array(lp,ivs,vars,b,l);
- break;
- }
- }
- }
- }
- clean_avail();
-}
+++ /dev/null
-/* S R _ R E D U C E . H */
-
-extern strength_reduction(); /* (loop_p loop; lset ivs, vars)
- * Perform streength reduction.
- */
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ X F O R M . C
- *
- */
-
-
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "sr.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/def.h"
-#include "../share/get.h"
-#include "sr_aux.h"
-#include "../share/lset.h"
-#include "../share/aux.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "sr_xform.h"
-
-/* Transformations on EM texts */
-
-line_p move_pointer(tmp,dir)
- offset tmp;
- int dir;
-{
- /* Generate EM code to load/store a pointer variable
- * onto/from the stack, depending on dir(ection).
- * We accept all kinds of pointer sizes.
- */
-
- line_p l;
-
- l = int_line(tmp);
- if (ps == ws) {
- /* pointer fits in a word */
- l->l_instr = (dir == LOAD ? op_lol : op_stl);
- } else {
- if (ps == 2 * ws) {
- /* pointer fits in a double word */
- l->l_instr = (dir == LOAD ? op_ldl : op_sdl);
- } else {
- /* very large pointer size, generate code:
- * LAL tmp ; LOI/STI ps */
- l->l_instr = op_lal;
- l->l_next = newline(OPSHORT);
- SHORT(l->l_next) = ps;
- l->l_next->l_instr =
- (dir == LOAD ? op_loi : op_sti);
- PREV(l->l_next) = l;
- }
- }
- return l;
-}
-
-
-
-/* make_header */
-
-STATIC copy_loops(b1,b2,except)
- bblock_p b1,b2;
- loop_p except;
-{
- /* Copy the loopset of b2 to b1, except for 'except' */
-
- Lindex i;
- loop_p lp;
- for (i = Lfirst(b2->b_loops); i != (Lindex) 0;
- i = Lnext(i,b2->b_loops)) {
- lp = (loop_p) Lelem(i);
- if (lp != except) {
- Ladd(lp,&b1->b_loops);
- }
- }
-}
-
-
-STATIC lab_id label(b)
- bblock_p b;
-{
- /* Find the label at the head of block b. If there is
- * no such label yet, create one.
- */
-
- line_p l;
-
- assert (b->b_start != (line_p) 0);
- if (INSTR(b->b_start) == op_lab) return INSTRLAB(b->b_start);
- /* The block has no label yet. */
- l = newline(OPINSTRLAB);
- INSTRLAB(l) = freshlabel();
- DLINK(l,b->b_start); /* doubly link them */
- return INSTRLAB(l);
-}
-
-
-STATIC adjust_jump(newtarg,oldtarg,c)
- bblock_p newtarg,oldtarg,c;
-{
- /* If the last instruction of c is a jump to the
- * old target, then change it into a jump to the
- * start of the new target.
- */
-
- line_p l;
-
- if (INSTR(oldtarg->b_start) == op_lab) {
- /* If old target has no label, it cannot be jumped to */
- l = last_instr(c);
- assert(l != (line_p) 0);
- if (TYPE(l) == OPINSTRLAB &&
- INSTRLAB(l) == INSTRLAB(oldtarg->b_start)) {
- INSTRLAB(l) = label(newtarg);
- }
- }
-}
-
-
-make_header(lp)
- loop_p lp;
-{
- /* Make sure that the loop has a header block, i.e. a block
- * has the loop entry block as its only successor and
- * that dominates the loop entry block.
- * If there is no header yet, create one.
- */
-
- bblock_p b,c,entry;
- Lindex i,next;
-
- if (lp->LP_HEADER != (bblock_p) 0) return;
- OUTTRACE("creating a new header block",0);
- /* The loop has no header yet. The main problem is to
- * keep all relations (SUCC, PRED, NEXT, IDOM, LOOPS)
- * up to date.
- */
- b = freshblock(); /* new block with new b_id */
- entry = lp->lp_entry;
-
- /* update succ/pred. Also take care that any jump from outside
- * the loop to the entry block now goes to b.
- */
-
- for (i = Lfirst(entry->b_pred); i != (Lindex) 0; i = next ) {
- next = Lnext(i,entry->b_pred);
- c = (bblock_p) Lelem(i);
- /* c is a predecessor of the entry block */
- if (!Lis_elem(c,lp->LP_BLOCKS)) {
- /* c is outside the loop */
- Lremove(c,&entry->b_pred);
- Lremove(entry,&c->b_succ);
- Ladd(b,&c->b_succ);
- adjust_jump(b,entry,c);
- }
- }
- Ladd(b,&entry->b_pred);
- b->b_succ = Lempty_set();
- b->b_pred = Lempty_set();
- Ladd(entry,&b->b_succ);
- if (curproc->p_start == entry) {
- /* entry was the first block of curproc */
- curproc->p_start = b;
- } else {
- /* find block before entry block */
- for (c = curproc->p_start; c->b_next != entry; c = c->b_next);
- c->b_next = b;
- Ladd(c,&b->b_pred);
- }
- b->b_next = entry;
- copy_loops(b,entry,lp);
- b->b_idom = entry->b_idom;
- entry->b_idom = b;
- lp->LP_HEADER = b;
-}
+++ /dev/null
-/* S T R E N G T H R E D U C T I O N
- *
- * S R _ X F O R M . H
- *
- */
-
-
-
-line_p move_pointer(); /* (offset tmp; int dir ) */
- /* Generate EM code to load/store a pointer variable
- * onto/from the stack, depending on dir(ection).
- * We accept all kinds of pointer sizes.
- */
-make_header() ; /* (loop_p lp) */
- /* Make sure that the loop has a header block, i.e. a block
- * has the loop entry block as its only successor and
- * that dominates the loop entry block.
- * If there is no header yet, create one.
- */
+++ /dev/null
-EMH=../../../h
-EML=../../../lib
-CFLAGS=
-SHARE=../share
-UD=.
-OBJECTS=ud.o ud_const.o ud_copy.o ud_aux.o ud_defs.o
-SHOBJECTS=$(SHARE)/get.o $(SHARE)/put.o $(SHARE)/map.o $(SHARE)/alloc.o $(SHARE)/global.o $(SHARE)/debug.o $(SHARE)/lset.o $(SHARE)/cset.o $(SHARE)/files.o $(SHARE)/aux.o $(SHARE)/locals.o $(SHARE)/init_glob.o $(SHARE)/go.o
-SRC=ud.h ud_defs.h ud_const.h ud_copy.h ud_aux.h ud.c ud_defs.c ud_const.c ud_copy.c ud_aux.c
-all: $(OBJECTS)
-ud: \
- $(OBJECTS) $(SHOBJECTS)
- $(CC) -o ud -i $(OBJECTS) $(SHOBJECTS) $(EML)/em_data.a
-lpr:
- pr $(SRC) | lpr
-# the next lines are generated automatically
-# AUTOAUTOAUTOAUTOAUTOAUTO
-ud.o: ../../../h/em_pseu.h
-ud.o: ../../../h/em_spec.h
-ud.o: ../share/alloc.h
-ud.o: ../share/aux.h
-ud.o: ../share/cset.h
-ud.o: ../share/debug.h
-ud.o: ../share/def.h
-ud.o: ../share/files.h
-ud.o: ../share/get.h
-ud.o: ../share/global.h
-ud.o: ../share/locals.h
-ud.o: ../share/lset.h
-ud.o: ../share/map.h
-ud.o: ../share/put.h
-ud.o: ../share/types.h
-ud.o: ud.h
-ud.o: ud_const.h
-ud.o: ud_copy.h
-ud.o: ud_defs.h
-ud_aux.o: ../../../h/em_mnem.h
-ud_aux.o: ../../../h/em_pseu.h
-ud_aux.o: ../../../h/em_spec.h
-ud_aux.o: ../share/alloc.h
-ud_aux.o: ../share/cset.h
-ud_aux.o: ../share/debug.h
-ud_aux.o: ../share/def.h
-ud_aux.o: ../share/global.h
-ud_aux.o: ../share/locals.h
-ud_aux.o: ../share/lset.h
-ud_aux.o: ../share/types.h
-ud_aux.o: ../ud/ud.h
-ud_aux.o: ../ud/ud_defs.h
-ud_const.o: ../../../h/em_mnem.h
-ud_const.o: ../../../h/em_pseu.h
-ud_const.o: ../../../h/em_spec.h
-ud_const.o: ../share/alloc.h
-ud_const.o: ../share/aux.h
-ud_const.o: ../share/cset.h
-ud_const.o: ../share/debug.h
-ud_const.o: ../share/def.h
-ud_const.o: ../share/global.h
-ud_const.o: ../share/locals.h
-ud_const.o: ../share/lset.h
-ud_const.o: ../share/types.h
-ud_const.o: ../ud/ud.h
-ud_const.o: ../ud/ud_defs.h
-ud_const.o: ud_aux.h
-ud_const.o: ud_const.h
-ud_copy.o: ../../../h/em_mnem.h
-ud_copy.o: ../../../h/em_pseu.h
-ud_copy.o: ../../../h/em_spec.h
-ud_copy.o: ../share/alloc.h
-ud_copy.o: ../share/aux.h
-ud_copy.o: ../share/cset.h
-ud_copy.o: ../share/debug.h
-ud_copy.o: ../share/def.h
-ud_copy.o: ../share/global.h
-ud_copy.o: ../share/locals.h
-ud_copy.o: ../share/lset.h
-ud_copy.o: ../share/types.h
-ud_copy.o: ../ud/ud.h
-ud_copy.o: ../ud/ud_defs.h
-ud_copy.o: ud_aux.h
-ud_copy.o: ud_copy.h
-ud_defs.o: ../../../h/em_mnem.h
-ud_defs.o: ../share/alloc.h
-ud_defs.o: ../share/aux.h
-ud_defs.o: ../share/cset.h
-ud_defs.o: ../share/debug.h
-ud_defs.o: ../share/global.h
-ud_defs.o: ../share/locals.h
-ud_defs.o: ../share/lset.h
-ud_defs.o: ../share/map.h
-ud_defs.o: ../share/types.h
-ud_defs.o: ud.h
-ud_defs.o: ud_defs.h
+++ /dev/null
-/* U S E - D E F I N I T I O N A N A L Y S I S */
-
-#include <stdio.h>
-#include "../share/types.h"
-#include "ud.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/def.h"
-#include "../share/files.h"
-#include "../share/map.h"
-#include "../share/get.h"
-#include "../share/put.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-#include "../share/init_glob.h"
-#include "../share/locals.h"
-#include "../share/go.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "ud_defs.h"
-#include "ud_const.h"
-#include "ud_copy.h"
-
-short nrglobals;
-short nrvars;
-
-int Svalue,Svariable;
-
-cond_p globl_cond_tab,local_cond_tab;
-
-STATIC cond_p getcondtab(f)
- FILE *f;
-{
- int l,i;
- cond_p tab;
-
- fscanf(f,"%d",&l);
- tab = newcondtab(l);
- for (i = 0; i < l; i++) {
- fscanf(f,"%d %d %d",&tab[i].mc_cond,&tab[i].mc_tval,
- &tab[i].mc_sval);
- }
- assert(tab[l-1].mc_cond == DEFAULT);
- return tab;
-}
-
-
-STATIC ud_machinit(f)
- FILE *f;
-{
- char s[100];
-
- for (;;) {
- while(getc(f) != '\n');
- fscanf(f,"%s",s);
- if (strcmp(s,"%%UD") == 0)break;
- }
- globl_cond_tab = getcondtab(f);
- local_cond_tab = getcondtab(f);
-}
-
-
-
-STATIC bool test_cond(cond,val)
- short cond;
- offset val;
-{
- switch(cond) {
- case DEFAULT:
- return TRUE;
- case FITBYTE:
- return val >= -128 && val < 128;
- }
- assert(FALSE);
- /* NOTREACHED */
-}
-
-
-STATIC short map_value(tab,val,time)
- struct cond_tab tab[];
- offset val;
- bool time;
-{
- cond_p p;
-
- for (p = &tab[0]; ; p++) {
- if (test_cond(p->mc_cond,val)) {
- return (time ? p->mc_tval : p->mc_sval);
- }
- }
-}
-
-
-STATIC init_root(root)
- bblock_p root;
-{
- /* Initialise the IN OUT sets of the entry block of the
- * current procedure. Global variables and parameters
- * already have a value at this point, although we do
- * not know which value. Therefor, implicit definitions
- * to all global variables and parameters are
- * put in IN.
- */
-
- short v;
-
- for (v = 1; v <= nrglobals; v++) {
- Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)), &IN(root));
- }
- for (v = 1; v <= nrlocals; v++) {
- if (locals[v]->lc_off >= 0) {
- Cadd(IMPLICIT_DEF(LOC_TO_VARNR(v)),&IN(root));
- }
- }
- /* OUT(root) = IN(root) - KILL(root) + GEN(root) */
- Ccopy_set(IN(root),&OUT(root));
- Csubtract(KILL(root),&OUT(root));
- Cjoin(GEN(root),&OUT(root));
-}
-
-
-
-
-STATIC unite_outs(bbset,setp)
- lset bbset;
- cset *setp;
-{
- /* Take the union of OUT(b), for all b in bbset,
- * and put the result in setp.
- */
-
- Lindex i;
-
- Cclear_set(setp);
- for (i = Lfirst(bbset); i != (Lindex) 0; i = Lnext(i,bbset)) {
- Cjoin(OUT((bblock_p) Lelem(i)), setp);
- }
-}
-
-
-
-STATIC solve_equations(p)
- proc_p p;
-{
- /* Solve the data flow equations for reaching
- * definitions of procedure p.
- * These equations are:
- * (1) OUT(b) = IN(b) - KILL(b) + GEN(b)
- * (2) IN(b) = OUT(p1) + .. + OUT(pn) ;
- * where PRED(b) = {p1, .. , pn}
- * We use the iterative algorithm of Aho&Ullman to
- * solve the equations.
- */
-
- register bblock_p b;
- bool change;
- cset newin;
-
- /* initializations */
- newin = Cempty_set(nrdefs);
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- IN(b) = Cempty_set(nrdefs);
- OUT(b) = Cempty_set(nrdefs);
- Ccopy_set(GEN(b), &OUT(b));
- }
- init_root(p->p_start);
- /* Global variables and parameters have already a value
- * at the procedure entry block.
- */
- change = TRUE;
- /* main loop */
- while (change) {
- change = FALSE;
- for (b = p->p_start->b_next; b != (bblock_p) 0; b = b->b_next) {
- unite_outs(b->b_pred, &newin);
- /* newin = OUT(p1) + .. + OUT(pn) */
- if (!Cequal(newin,IN(b))) {
- change = TRUE;
- Ccopy_set(newin, &IN(b));
- Ccopy_set(IN(b), &OUT(b));
- Csubtract(KILL(b), &OUT(b));
- Cjoin(GEN(b), &OUT(b));
- }
- }
- }
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- Cdeleteset(KILL(b));
- Cdeleteset(OUT(b));
- }
- Cdeleteset(newin);
-}
-
-
-
-short global_addr_cost()
-{
- return add_timespace(map_value(globl_cond_tab,(offset) 0,TRUE),
- map_value(globl_cond_tab,(offset) 0,FALSE));
-}
-
-short local_addr_cost(off)
- offset off;
-{
- return add_timespace(map_value(local_cond_tab,off,TRUE),
- map_value(local_cond_tab,off,FALSE));
-}
-
-
-
-STATIC bool fold_is_desirable(old,new)
- line_p old,new;
-{
- /* See if it is desirable to replace the variable used by the
- * EM instruction 'old' by the variable used by 'new'.
- * We do not replace 'cheaply addressable variables' by 'expensively
- * addressable variables'. E.g. if we're optimizing object code size,
- * we do not replace a local variable by a global variable on a VAX,
- * because the former occupies 1 or 2 bytes and the latter occupies
- * 4 bytes.
- * If 2 local variables are equally expensive to address, we replace
- * the first one by the second only if the first one is used at
- * least as many times as the second one.
- */
-
- local_p oldloc,newloc;
- short old_cost,new_cost,nr;
- bool ok;
-
- if (TYPE(old) == OPOBJECT) {
- /* old variable is a global variable */
- return TYPE(new) != OPOBJECT &&
- global_addr_cost() >=
- local_addr_cost(off_set(new));
- }
- find_local(off_set(old),&nr,&ok);
- assert(ok);
- oldloc = locals[nr];
- old_cost = local_addr_cost(off_set(old));
- if (TYPE(new) == OPOBJECT) {
- return oldloc->lc_score == 2 || /* old var. can be eliminated */
- old_cost > global_addr_cost();
- }
- find_local(off_set(new),&nr,&ok);
- assert(ok);
- newloc = locals[nr];
- new_cost = local_addr_cost(off_set(new));
- return old_cost > new_cost ||
- (old_cost == new_cost && oldloc->lc_score < newloc->lc_score);
-}
-
-
-
-#ifdef TRACE
-/*********** TRACING ROUTINES ***********/
-
-pr_localtab() {
- short i;
- local_p lc;
-
- printf("LOCAL-TABLE (%d)\n\n",nrlocals);
- for (i = 1; i <= nrlocals; i++) {
- lc = locals[i];
- printf("LOCAL %d\n",i);
- printf(" offset= %D\n",lc->lc_off);
- printf(" size= %d\n",lc->lc_size);
- printf(" flags= %d\n",lc->lc_flags);
- }
-}
-
-pr_globals()
-{
- dblock_p d;
- obj_p obj;
-
- printf("GLOBALS (%d)\n\n",nrglobals);
- printf("ID GLOBNR\n");
- for (d = fdblock; d != (dblock_p) 0; d = d->d_next) {
- for (obj = d->d_objlist; obj != (obj_p) 0; obj = obj->o_next) {
- if (obj->o_globnr != 0) {
- printf("%d %d\n", obj->o_id,obj->o_globnr);
- }
- }
- }
-}
-
-extern char em_mnem[];
-
-pr_defs()
-{
- short i;
- line_p l;
-
- printf("DEF TABLE\n\n");
- for (i = 1; i <= nrexpldefs; i++) {
- l = defs[i];
- printf("%d %s ",EXPL_TO_DEFNR(i),
- &em_mnem[(INSTR(l)-sp_fmnem)*4]);
- switch(TYPE(l)) {
- case OPSHORT:
- printf("%d\n",SHORT(l));
- break;
- case OPOFFSET:
- printf("%D\n",OFFSET(l));
- break;
- case OPOBJECT:
- printf("%d\n",OBJ(l)->o_id);
- break;
- default:
- assert(FALSE);
- }
- }
-}
-
-
-pr_set(name,k,s,n)
- char *name;
- cset s;
- short k,n;
-{
- short i;
-
- printf("%s(%d) = {",name,k);
- for (i = 1; i <= n; i++) {
- if (Cis_elem(i,s)) {
- printf("%d ",i);
- }
- }
- printf ("}\n");
-}
-
-pr_blocks(p)
- proc_p p;
-{
- bblock_p b;
- short n;
-
- for (b = p->p_start; b != 0; b = b->b_next) {
- printf ("\n");
- n = b->b_id;
- pr_set("GEN",n,GEN(b),nrdefs);
- pr_set("KILL",n,KILL(b),nrdefs);
- pr_set("IN ",n,IN(b),nrdefs);
- pr_set("OUT",n,OUT(b),nrdefs);
- pr_set("CHGVARS",n,CHGVARS(b),nrvars);
- }
-}
-
-pr_copies()
-{
- short i;
-
- printf("\nCOPY TABLE\n\n");
- for (i = 1; i <= nrdefs; i++) {
- if (def_to_copynr[i] != 0) {
- printf("%d %d\n",i,def_to_copynr[i]);
- }
- }
-}
-
-pr_cblocks(p)
- proc_p p;
-{
- bblock_p b;
- short n;
-
- for (b = p->p_start; b != 0; b = b->b_next) {
- printf ("\n");
- n = b->b_id;
- pr_set("CGEN",n,C_GEN(b),nrcopies);
- pr_set("CKILL",n,C_KILL(b),nrcopies);
- pr_set("CIN ",n,C_IN(b),nrcopies);
- pr_set("COUT",n,C_OUT(b),nrcopies);
- }
-}
-
-/*********** END TRACING ********/
-
-#endif
-
-STATIC ud_analysis(p)
- proc_p p;
-{
- /* Perform use-definition analysis on procedure p */
-
- make_localtab(p); /* See for which local we'll keep ud-info */
-#ifdef TRACE
- pr_localtab();
-#endif
- nrvars = nrglobals + nrlocals;
- make_defs(p); /* Make a table of all useful definitions in p */
-#ifdef TRACE
- pr_defs();
-#endif
- nrdefs = nrexpldefs + nrvars; /* number of definitions */
- gen_sets(p); /* compute GEN(b), for every basic block b */
- kill_sets(p); /* compute KILL(b), for every basic block b */
- solve_equations(p); /* solve data flow equations for p */
-#ifdef TRACE
- pr_blocks(p);
-#endif
-}
-
-
-
-STATIC clean_maps()
-{
- local_p *p;
- cset *v;
-
- oldmap(defs,nrexpldefs);
- for (p = &locals[1]; p <= &locals[nrlocals]; p++) {
- oldlocal(*p);
- }
- oldmap(locals,nrlocals);
- for (v = &vardefs[1]; v <= &vardefs[nrvars]; v++) {
- Cdeleteset(*v);
- }
- oldmap(vardefs,nrvars);
-}
-
-
-
-STATIC bool try_optim(l,b)
- line_p l;
- bblock_p b;
-{
- /* Try copy propagation and constant propagation */
-
- line_p def;
- offset val;
- short defnr;
-
-
- if (is_use(l) && (def = unique_def(l,b,&defnr)) != (line_p) 0) {
- if (is_copy(def)) {
- if (value_retained(def,defnr,l,b) &&
- fold_is_desirable(l,PREV(def))) {
- fold_var(l,PREV(def),b);
- OUTVERBOSE("vp:variable folded in proc %d",
- curproc->p_id,0);
- Svariable++;
- return TRUE;
- }
- } else {
- if (value_known(def,&val)) {
- fold_const(l,b,val);
- OUTVERBOSE("vp:value folded in proc %d",
- curproc->p_id,0);
- Svalue++;
- return TRUE;
- }
- }
- }
- return FALSE;
-}
-
-
-
-value_propagation(p)
- proc_p p;
-{
- /* Apply value propagation to procedure p */
-
- bool changes;
- bblock_p b;
- line_p l, next;
-
- changes = TRUE;
- /* If a statement like A := B is folded to A := constant,
- * new opportunities for constant folding may arise,
- * e.g. the value of A might be statically known too now.
- */
-
- while (changes) {
- changes = FALSE;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = next) {
- next = l->l_next;
- if (try_optim(l,b)) {
- changes = TRUE;
- }
- }
- }
- }
- oldmap(copies,nrcopies);
- oldtable(def_to_copynr,nrdefs);
-}
-
-
-STATIC ud_extend(p)
- proc_p p;
-{
- /* Allocate extended data structures for Use Definition analysis */
-
- register bblock_p b;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- b->b_extend = newudbx();
- }
-}
-
-
-STATIC ud_cleanup(p)
- proc_p p;
-{
- /* Deallocate extended data structures for Use Definition analysis */
-
- register bblock_p b;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- Cdeleteset(GEN(b));
- Cdeleteset(IN(b));
- Cdeleteset(C_GEN(b));
- Cdeleteset(C_KILL(b));
- Cdeleteset(C_IN(b));
- Cdeleteset(C_OUT(b));
- Cdeleteset(CHGVARS(b));
- oldudbx(b->b_extend);
- }
-}
-
-
-ud_optimize(p)
- proc_p p;
-{
- ud_extend(p);
- locals = (local_p *) 0;
- vardefs = (cset *) 0;
- defs = (line_p *) 0;
- ud_analysis(p);
- copy_analysis(p);
-#ifdef TRACE
- pr_copies();
- pr_cblocks(p);
-#endif
- value_propagation(p);
- ud_cleanup(p);
- clean_maps();
-}
-
-main(argc,argv)
- int argc;
- char *argv[];
-{
- go(argc,argv,init_globals,ud_optimize,ud_machinit,no_action);
- report("values folded",Svalue);
- report("variables folded",Svariable);
- exit(0);
-}
-
-
-
+++ /dev/null
-/* U S E - D E F I N I T I O N A N A L Y S I S
- *
- * U D . H
- */
-
-#define GEN(b) (b)->b_extend->bx_ud.bx_gen
-#define KILL(b) (b)->b_extend->bx_ud.bx_kill
-#define IN(b) (b)->b_extend->bx_ud.bx_in
-#define OUT(b) (b)->b_extend->bx_ud.bx_out
-#define C_GEN(b) (b)->b_extend->bx_ud.bx_cgen
-#define C_KILL(b) (b)->b_extend->bx_ud.bx_ckill
-#define C_IN(b) (b)->b_extend->bx_ud.bx_cin
-#define C_OUT(b) (b)->b_extend->bx_ud.bx_cout
-#define CHGVARS(b) (b)->b_extend->bx_ud.bx_chgvars
-
-extern short nrglobals; /* number of global variables for which
- * ud-info is maintained.
- */
-extern short nrvars; /* total number of variables (global + local)
- * for which ud-info is maintained.
- */
+++ /dev/null
-/* C O P Y P R O P A G A T I O N
- *
- * A U X I L I A R Y R O U T I N E S
- */
-
-
-#include "../share/types.h"
-#include "../ud/ud.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/def.h"
-#include "../share/locals.h"
-#include "../share/aux.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../ud/ud_defs.h"
-
-repl_line(old,new,b)
- line_p old,new;
- bblock_p b;
-{
- /* Replace 'old' by 'new' */
-
- if (PREV(old) == (line_p) 0) {
- b->b_start = new;
- } else {
- PREV(old)->l_next = new;
- }
- PREV(new) = PREV(old);
- if ((new->l_next = old->l_next) != (line_p) 0) {
- PREV(new->l_next) = new;
- }
- oldline(old);
-}
-
-
-
-bool same_var(use,def)
- line_p use,def;
-{
- /* 'use' is an instruction that uses a variable
- * for which we maintain ud-info (e.g. a LOL).
- * See if 'def' references the same variable.
- */
-
- if (TYPE(use) == OPOBJECT) {
- return TYPE(def) == OPOBJECT && OBJ(use) == OBJ(def);
- } else {
- return TYPE(def) != OPOBJECT && off_set(use) == off_set(def);
- }
-}
+++ /dev/null
-
-/* C O P Y P R O P A G A T I O N
- *
- * A U X I L I A R Y R O U T I N E S
- */
-
-
-extern repl_line(); /* (line_p old,new; bblock_p b)
- * Replace EM instruction 'old' by a
- * copy of 'new'. Update doubly-linked
- * list.
- */
-extern bool same_var(); /* (line_p use,def)
- * 'use' is an instruction that uses a variable
- * for which we maintain ud-info (e.g. a LOL).
- * See if 'def' references the same variable.
- */
+++ /dev/null
-/* C O N S T A N T P R O P A G A T I O N */
-
-#include "../share/types.h"
-#include "../ud/ud.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/def.h"
-#include "../share/aux.h"
-#include "../share/locals.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../ud/ud_defs.h"
-#include "ud_const.h"
-#include "ud_aux.h"
-
-
-#define CHANGE_INDIR(p) (p->p_change->c_flags & CF_INDIR)
-#define IS_REG(v) (locals[TO_LOCAL(v)]->lc_flags & LCF_REG)
-#define BODY_KNOWN(p) (p->p_flags1 & (byte) PF_BODYSEEN)
-#define CALLS_UNKNOWN(p) (p->p_flags1 & (byte) PF_CALUNKNOWN)
-
-
-bool is_use(l)
- line_p l;
-{
- /* See if 'l' is a use of a variable */
-
- switch(INSTR(l)) {
- case op_lde:
- case op_ldl:
- case op_loe:
- case op_lol:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-
-bool value_known(def,val_out)
- line_p def;
- offset *val_out;
-{
- /* See if the value stored by definition 'def'
- * is known statically (i.e. is a constant).
- */
-
- short sz1, sz2;
- offset v;
- line_p l;
-
- sz1 = ws;
- switch(INSTR(def)) {
- case op_inl:
- case op_ine:
- case op_del:
- case op_dee:
- return FALSE;
- case op_zrl:
- case op_zre:
- v = (offset) 0;
- break;
- case op_sdl:
- case op_sde:
- sz1 += ws;
- /* fall through ... */
- case op_stl:
- case op_ste:
- l = PREV(def);
- if (l == (line_p) 0) return FALSE;
- sz2 = ws;
- switch(INSTR(l)) {
- case op_zer:
- if (SHORT(l) >= sz1) {
- v = (offset) 0;
- break;
- }
- return FALSE;
- case op_ldc:
- sz2 += ws;
- /* fall through ...*/
- case op_loc:
- if (sz1 == sz2) {
- v = off_set(l);
- break;
- }
- /* fall through ... */
- default:
- return FALSE;
- }
- break;
- default:
- assert(FALSE);
- }
- *val_out = v;
- return TRUE;
-}
-
-
-
-
-bool affected(use,v,l)
- line_p use,l;
- short v;
-{
- /* See if the variable referenced by 'use' may be
- * changed by instruction l, which is either a cal, cai or
- * an indirect assignment.
- */
-
- if (INSTR(l) == op_cal &&
- TYPE(use) == OPOBJECT &&
- BODY_KNOWN(PROC(l)) &&
- !CALLS_UNKNOWN(PROC(l)) &&
- !CHANGE_INDIR(PROC(l))) {
- return Cis_elem(OBJ(use)->o_id,PROC(l)->p_change->c_ext);
- }
- return TYPE(use) == OPOBJECT || !IS_REG(v);
-}
-
-
-
-
-STATIC search_backwards(use,v,found,def)
- line_p use, *def;
- short v;
- bool *found;
-{
- /* Search backwards in the current basic block,
- * starting at 'use', trying to find a definition
- * of the variable referenced by 'use', whose variable
- * number is v. If the definition found is an
- * implicit one, return 0 as def.
- */
-
- register line_p l;
-
- for (l = PREV(use); l != (line_p) 0; l = PREV(l)) {
- if (does_expl_def(l) && same_var(use,l)) {
- *found = TRUE;
- *def = l;
- return;
- }
- if (does_impl_def(l) && affected(use,v,l)) {
- *found = TRUE;
- *def = (line_p) 0;
- return;
- }
- }
- *found = FALSE;
-}
-
-
-
-
-STATIC short outer_def(vdefs,in)
- cset vdefs, in;
-{
- /* See if there is a unique definition of variable
- * v reaching the beginning of block b.
- * 'vdefs' is vardefs[v], 'in' is IN(b).
- */
-
- short n,defnr = 0;
- Cindex i;
-
- for (i = Cfirst(vdefs); i != (Cindex) 0; i = Cnext(i,vdefs)) {
- n = Celem(i);
- if (Cis_elem(EXPL_TO_DEFNR(n),in)) {
- if (defnr != 0) return 0;
- /* If there was already a def., there's no unique one */
- defnr = n;
- }
- }
- return defnr;
-}
-
-
-
-
-line_p unique_def(use,b,defnr_out)
- line_p use;
- bblock_p b;
- short *defnr_out;
-{
- /* See if there is one unique explicit definition
- * of the variable used by 'use', that reaches 'use'.
- */
-
- short v;
- bool found;
- line_p def = (line_p) 0;
-
- *defnr_out = 0;
- var_nr(use,&v,&found);
- if (found) {
- /* We do maintain ud-info for this variable.
- * See if there is a previous explicit definition
- * in the current basic block.
- */
- search_backwards(use,v,&found,&def);
- if (!found && !Cis_elem(IMPLICIT_DEF(v),IN(b))) {
- /* See if there is a unique explicit definition
- * outside the current block, reaching the
- * beginning of the current block.
- */
- *defnr_out = outer_def(vardefs[v],IN(b));
- def = (*defnr_out == 0 ? (line_p) 0 : defs[*defnr_out]);
- }
- }
- return def;
-}
-
-
-
-fold_const(l,b,val)
- line_p l;
- bblock_p b;
- offset val;
-{
- /* Perform the substitutions required for constant folding */
-
- line_p n;
-
- n = int_line(val);
- switch(INSTR(l)) {
- case op_lol:
- case op_loe:
- n->l_instr = op_loc;
- break;
- case op_ldl:
- case op_lde:
- n->l_instr = op_ldc;
- break;
- default:
- assert (FALSE);
- }
- repl_line(l,n,b);
-}
+++ /dev/null
-
-/* C O N S T A N T P R O P A G A T I O N */
-
-extern line_p unique_def(); /* ( line_p use; bblock_p b; short *defnr_out;)
- * See if there is a unique explicit definition
- * of the variable used by 'use' that
- * reaches 'use'.
- */
-extern bool value_known(); /* (line_p def; offset *val_out)
- * See if the value stored by definition 'def'
- * is known statically (i.e. is a constant).
- */
-extern fold_const(); /* (line_p l; bblock_p b; offset val)
- * Perform the substitutions required for
- * constant folding.
- */
-extern bool is_use(); /* (line_p l)
- * See if 'l' is a use of a variable.
- */
-extern bool affected(); /* (line_p use,l; short v)
- * See if the variable referenced by 'use' may
- * be changed by instruction l, which is
- * either a cal, cai or an indirect assignment.
- */
+++ /dev/null
-/* C O P Y P R O P A G A T I O N */
-
-#include "../share/types.h"
-#include "../ud/ud.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/alloc.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/def.h"
-#include "../share/aux.h"
-#include "../share/locals.h"
-#include "../../../h/em_mnem.h"
-#include "../../../h/em_pseu.h"
-#include "../../../h/em_spec.h"
-#include "../ud/ud_defs.h"
-#include "ud_copy.h"
-#include "ud_const.h"
-#include "ud_aux.h"
-
-
-
-line_p *copies; /* table of copies; every entry points to the
- * store-instruction.
- */
-short *def_to_copynr; /* table that maps a 'definition'-number to a
- * 'copy' number.
- */
-short nrcopies; /* number of copies in the current procedure
- * (length of copies-table)
- */
-
-#define COPY_NR(c) def_to_copynr[c]
-#define CHANGED(v,b) (Cis_elem(v,CHGVARS(b)) || Cis_elem(IMPLICIT_DEF(v),GEN(b)))
-
-
-#define COUNT 0
-#define MAP 1
-
-STATIC traverse_defs(p,action)
- proc_p p;
- int action;
-{
- bblock_p b;
- line_p l;
- bool found;
- short defcnt,v,cnt;
-
- defcnt = 1;
- if (action == COUNT) {
- nrcopies = 0;
- } else {
- copies = (line_p *) newmap(nrcopies);
- def_to_copynr = newtable(nrdefs);
- cnt = 1;
- }
- if (defcnt > nrdefs) return;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (defs[defcnt] == l) {
- if (is_copy(l)) {
- var_nr(PREV(l),&v,&found);
- if (found) {
- if (action == COUNT) {
- nrcopies++;
- } else {
- copies[cnt] = l;
- def_to_copynr[defcnt] =
- cnt++;
- }
- }
- }
- if (++defcnt > nrdefs) return;
- }
- }
- }
-}
-
-
-
-STATIC make_copytab(p)
- proc_p p;
-{
- /* Make a table of all copies appearing in procedure p.
- * We first count how many there are, because we
- * have to allocate a dynamic array of the correct size.
- */
-
- traverse_defs(p,COUNT);
- traverse_defs(p,MAP);
-}
-
-
-
-STATIC bool is_changed(varl,start,stop)
- line_p varl, start, stop;
-{
- /* See if the variable used by instruction varl
- * is changed anywhere between 'start' and 'stop'
- */
-
- register line_p l;
- short v;
- bool found;
-
- var_nr(varl,&v,&found);
- if (!found) {
- return TRUE; /* We don't maintain ud-info for this variable */
- }
- for (l = start; l != (line_p) 0 && l != stop; l = l->l_next) {
- if (does_expl_def(l) && same_var(varl,l)) return TRUE;
- if (does_impl_def(l) && affected(varl,v,l)) return TRUE;
- }
- return FALSE;
-}
-
-
-
-STATIC gen_kill_copies(p)
- proc_p p;
-{
- /* Compute C_GEN and C_KILL for every basic block
- * of p.
- */
-
- register line_p l;
- register bblock_p b,n;
- short v;
- bool found;
- short copycnt = 1, defcnt = 1;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- C_GEN(b) = Cempty_set(nrcopies);
- C_KILL(b) = Cempty_set(nrcopies);
- }
- if (nrcopies == 0) return;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (copies[copycnt] == l) {
- var_nr(PREV(l),&v,&found);
- assert(found);
- for (n = p->p_start; n != (bblock_p) 0;
- n = n->b_next) {
- if (n != b && CHANGED(v,n) &&
- Cis_elem(EXPL_TO_DEFNR(defcnt),IN(n))) {
- Cadd(copycnt,&C_KILL(n));
- }
- }
- if (is_changed(PREV(l),l,(line_p) 0)) {
- Cadd(copycnt,&C_KILL(b));
- } else {
- Cadd(copycnt,&C_GEN(b));
- }
- if (++copycnt > nrcopies) return;
- }
- if (defs[defcnt] == l) defcnt++;
- }
- }
-}
-
-
-
-STATIC intersect_outs(bbset,setp,full_set)
- lset bbset;
- cset *setp,full_set;
-{
- /* Take the intersection of C_OUT(b), for all b in bbset,
- * and put the result in setp.
- */
-
- Lindex i;
-
- Ccopy_set(full_set,setp);
- for (i = Lfirst(bbset); i != (Lindex) 0; i = Lnext(i,bbset)) {
- Cintersect(C_OUT((bblock_p) Lelem(i)), setp);
- }
-}
-
-
-
-STATIC init_cin(p,full_set)
- proc_p p;
- cset full_set;
-{
- /* Initialize C_IN(b) and C_OUT(b), for every basic block b.
- * C_IN of the root of the CFG (i.e. the procedure entry block)
- * will contain every copy, as it trivially holds that for
- * every copy "s: A := B" there is no assignment to B on any
- * path from s to the beginning of the root (because PRED(root)=empty).
- * C_IN and C_OUT of the root will never be changed.
- * For all remaining blocks b, C_IN(b) is initialized to the set of
- * all copies, and C_OUT is set to all copies but those killed in b.
- */
-
- bblock_p b;
- bblock_p root = p->p_start;
-
- C_IN(root) = Cempty_set(nrcopies);
- Ccopy_set(full_set,&C_IN(root)); /* full_set is the set of all copies */
- /* C_OUT(root) = {all copies} - C_KILL(root) + C_GEN(root) */
- C_OUT(root) = Cempty_set(nrcopies);
- Ccopy_set(full_set,&C_OUT(root));
- Csubtract(C_KILL(root),&C_OUT(root));
- Cjoin(C_GEN(root),&C_OUT(root));
- for (b = root->b_next; b != (bblock_p) 0; b = b->b_next) {
- C_IN(b) = Cempty_set(nrcopies);
- Ccopy_set(full_set,&C_IN(b));
- C_OUT(b) = Cempty_set(nrcopies);
- Ccopy_set(full_set,&C_OUT(b));
- Csubtract(C_KILL(b),&C_OUT(b));
- }
-}
-
-
-
-STATIC solve_cin(p)
- proc_p p;
-{
- /* Solve the data flow equations for reaching
- * definitions of procedure p.
- * These equations are:
- * (1) C_OUT(b) = C_IN(b) - C_KILL(b) + C_GEN(b)
- * (2) C_IN(b) = C_OUT(p1) * .. * C_OUT(pn)
- * (3) C_IN(root) = {all copies} ;
- * where PRED(b) = {p1, .. , pn}
- * and '*' denotes set intersection.
- * We use the iterative algorithm of Aho&Ullman to
- * solve the equations.
- */
-
- register bblock_p b;
- bool change;
- cset newin,full_set;
- short n;
-
- /* initializations */
- full_set = Cempty_set(nrcopies);
- for (n = 1; n <= nrcopies; n++) {
- Cadd(n,&full_set);
- }
- newin = Cempty_set(nrcopies);
- init_cin(p,full_set);
- change = TRUE;
- /* main loop */
- while (change) {
- change = FALSE;
- for (b = p->p_start->b_next; b != (bblock_p) 0; b = b->b_next) {
- intersect_outs(b->b_pred, &newin,full_set);
- /* newin = C_OUT(p1) * .. * C_OUT(pn) */
- if (!Cequal(newin,C_IN(b))) {
- change = TRUE;
- Ccopy_set(newin, &C_IN(b));
- Ccopy_set(C_IN(b), &C_OUT(b));
- Csubtract(C_KILL(b), &C_OUT(b));
- Cjoin(C_GEN(b), &C_OUT(b));
- }
- }
- }
- Cdeleteset(newin);
- Cdeleteset(full_set);
-}
-
-
-
-copy_analysis(p)
- proc_p p;
-{
- /* Determine which copies procedure p has. Compute C_IN(b),
- * for every basic block b.
- */
-
- make_copytab(p); /* Make a table of all copies */
- gen_kill_copies(p); /* Compute C_GEN(b) and C_KILL(b), for every b */
- solve_cin(p); /* Solve equations for C_IN(b) */
-}
-
-
-
-bool is_copy(def)
- line_p def;
-{
- /* See if the definition def is also a 'copy', i.e. an
- * statement of the form 'A := B' (or, in EM terminology:
- * a sequence 'Load Variable; Store Variable').
- */
-
-
- line_p lhs;
- int instr;
-
- lhs = PREV(def);
- if (lhs == (line_p) 0) return FALSE;
- instr = INSTR(def);
- switch(INSTR(lhs)) {
- case op_lol:
- case op_loe:
- return instr == op_stl || instr == op_ste;
- case op_ldl:
- case op_lde:
- return instr == op_sdl || instr == op_sde;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-fold_var(old,new,b)
- line_p old, new;
- bblock_p b;
-{
- /* The variable referenced by the EM instruction 'old'
- * must be replaced by the variable referenced by 'new'.
- */
-
- line_p l;
-
-/* DEBUGGING:
- local_p loc;
- short nr;
- bool ok;
- if (TYPE(old) == OPOBJECT) {
- printf("global var.");
- } else {
- printf("local var. with off. %D",off_set(old));
- find_local(off_set(old),&nr,&ok);
- assert(ok);
- loc = locals[nr];
- printf(",score %D",loc->lc_score);
- }
- printf(" replaced by ");
- if (TYPE(new) == OPOBJECT) {
- printf("global var.");
- } else {
- printf("local var. with off. %D",off_set(new));
- find_local(off_set(new),&nr,&ok);
- assert(ok);
- loc = locals[nr];
- printf(",score %D",loc->lc_score);
- }
- printf("\n");
-END DEBUG */
- l = old;
- if (TYPE(l) != TYPE(new)) {
- l = newline(TYPE(new));
- l->l_instr = INSTR(new);
- repl_line(old,l,b);
- }
- switch(TYPE(new)) {
- case OPOBJECT:
- OBJ(l) = OBJ(new);
- break;
- case OPSHORT:
- SHORT(l) = SHORT(new);
- break;
- case OPOFFSET:
- OFFSET(l) = OFFSET(new);
- break;
- default:
- assert(FALSE);
- }
-}
-
-
-
-bool value_retained(copy,defnr,use,b)
- line_p copy,use;
- short defnr;
- bblock_p b;
-{
- /* See if the right hand side variable of the
- * copy still has the same value at 'use'.
- * If the copy and the use are in the same
- * basic block (defnr = 0), search from the
- * copy to the use, to see if the rhs variable
- * is changed. If the copy is in another block,
- * defnr is the definition-number of the copy.
- * Search from the beginning of the block to
- * the use, to see if the rhs is changed; if not,
- * check that the copy is in C_IN(b).
- */
-
- line_p rhs, start;
-
- rhs = PREV(copy);
- start = (defnr == 0 ? copy : b->b_start);
- return !is_changed(rhs,start,use) &&
- (defnr == 0 || Cis_elem(COPY_NR(defnr), C_IN(b)));
-}
+++ /dev/null
-
-/* C O P Y P R O P A G A T I O N */
-
-extern line_p *copies; /* table of copies; every entry points to the
- * store-instruction.
- */
-extern short *def_to_copynr; /* Table that maps a 'definition'-number to a
- * 'copy' number.
- */
-extern short nrcopies; /* number of copies in the current procedure
- * (length of copies-table)
- */
-
-extern copy_analysis(); /* (proc_p p)
- * Determine which copies procedure p has.
- * Compute C_IN(b), for every basic block b.
- */
-extern bool is_copy(); /* (line_p def)
- * See if the definition def is also a 'copy',
- * i.e. an statement of the form
- * 'A := B' (or, in EM terminology:
- * a sequence 'Load Variable; Store Variable').
- */
-extern fold_var(); /* (line_p old,new; bblock_p b)
- * The variable referenced by the
- * EM instruction 'old' must be replaced
- * by the variable referenced by 'new'.
- */
-extern bool value_retained(); /* (line_p copy; short defnr; line_p use;
- * bblock_p b)
- * See if the right hand side variable of the
- * copy still has the same value at 'use'.
- * If the copy and the use are in the same
- * basic block (defnr = 0), search from the
- * copy to the use, to see if the rhs variable
- * is changed. If the copy is in another block,
- * defnr is the definition-number of the copy.
- * Search from the beginning of the block to
- * the use, to see if the rhs is changed;
- * if not, check that the copy is in C_IN(b).
- */
+++ /dev/null
-
-/* U S E - D E F I N I T I O N A N A L Y S I S
- *
- * U D _ D E F S . C
- */
-
-#include "../share/types.h"
-#include "ud.h"
-#include "../share/debug.h"
-#include "../share/global.h"
-#include "../share/lset.h"
-#include "../share/cset.h"
-#include "../share/map.h"
-#include "../share/locals.h"
-#include "../../../h/em_mnem.h"
-#include "ud_defs.h"
-#include "../share/alloc.h"
-#include "../share/aux.h"
-
-#define BODY_KNOWN(p) (p->p_flags1 & (byte) PF_BODYSEEN)
-#define CHANGE_INDIR(p) (p->p_change->c_flags & CF_INDIR)
-
-short nrdefs; /* total number of definitions */
-short nrexpldefs; /* number of explicit definitions */
-line_p *defs;
-cset *vardefs;
-
-STATIC cset all_globl_defs, all_indir_defs;
-/* auxiliary sets, used by gen_sets */
-
-
-bool does_expl_def(l)
- line_p l;
-{
- /* See if instruction l does an explicit definition */
-
- switch(INSTR(l)) {
- case op_stl:
- case op_sdl:
- case op_ste:
- case op_sde:
- case op_inl:
- case op_del:
- case op_ine:
- case op_dee:
- case op_zrl:
- case op_zre:
- return TRUE;
- default:
- return FALSE;
- }
- /* NOTREACHED */
-}
-
-
-
-bool does_impl_def(l)
- line_p l;
-{
- /* See if instruction l does an implicit definition */
-
- switch(INSTR(l)) {
- case op_cal:
- case op_cai:
- case op_sil:
- case op_stf:
- case op_sti:
- case op_sts:
- case op_sdf:
- case op_sar:
- case op_blm:
- case op_bls:
- case op_zrf:
- return TRUE;
- default:
- return FALSE;
- }
-}
-
-
-make_defs(p)
- proc_p p;
-{
- /* Make a map of all explicit definitions
- * occurring in p.
- * Determine the set of explicit definitions
- * of variable v (i.e. vardefs[v]), for all
- * v from 1 to nrvars.
- * For every basic block b, compute CHGVARS(b),
- * i.e. the set of variables changed in b by an
- * explicit definition.
- */
-
- register bblock_p b;
- register line_p l;
- short v, i, cnt = 0;
- bool found;
-
- /* first count the number of definitions */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- for (l = b->b_start; l != (line_p) 0 ; l = l->l_next) {
- if (does_expl_def(l)) {
- var_nr(l,&v,&found);
- if (!found) continue; /* no ud for this var */
- cnt++;
- }
- }
- }
- nrexpldefs = cnt;
- /* now allocate the defs table and the vardefs table*/
- defs = (line_p *) newmap(nrexpldefs);
- vardefs = (cset *) newmap(nrvars);
- for (i = 1; i <= nrvars; i++) {
- vardefs[i] = Cempty_set(nrexpldefs);
- }
- cnt = 1;
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- CHGVARS(b) =Cempty_set(nrvars);
- for (l = b->b_start; l != (line_p) 0 ; l = l->l_next) {
- if (does_expl_def(l)) {
- var_nr(l,&v,&found);
- if (!found) continue;
- assert (v <= nrvars);
- Cadd(v,&CHGVARS(b));
- defs[cnt] = l;
- Cadd(cnt,&vardefs[v]);
- cnt++;
- }
- }
- }
-}
-
-
-
-STATIC init_gen(nrdefs)
- short nrdefs;
-{
- /* Initializing routine of gen_sets. Compute the set
- * of all implicit definitions to global variables
- * (all_globl_defs) and the set of all implicit
- * definition generated by an indirect assignment
- * through a pointer (all_indir_defs).
- */
-
- short v;
-
- all_globl_defs = Cempty_set(nrdefs);
- all_indir_defs = Cempty_set(nrdefs);
- for (v = 1; v <= nrglobals; v++) {
- Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)), &all_globl_defs);
- Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)), &all_indir_defs);
- }
- for (v = 1; v <= nrlocals; v++) {
- if (!IS_REGVAR(locals[v])) {
- Cadd(IMPLICIT_DEF(LOC_TO_VARNR(v)), &all_indir_defs);
- }
- }
-}
-
-
-
-STATIC clean_gen()
-{
- Cdeleteset(all_globl_defs);
- Cdeleteset(all_indir_defs);
-}
-
-
-
-STATIC bool same_target(l,defnr)
- line_p l;
- short defnr;
-{
- /* See if l defines the same variable as def */
-
- line_p def;
- short v;
-
- if (IS_IMPL_DEF(defnr)) {
- /* An implicitly generated definition */
- v = IMPL_VAR(TO_IMPLICIT(defnr));
- if (IS_GLOBAL(v)) {
- return TYPE(l) == OPOBJECT &&
- OBJ(l)->o_globnr == TO_GLOBAL(v);
- } else {
- return TYPE(l) != OPOBJECT &&
- locals[TO_LOCAL(v)]->lc_off == off_set(l);
- }
- }
- /* explicit definition */
- def = defs[TO_EXPLICIT(defnr)];
- if (TYPE(l) == OPOBJECT) {
- return TYPE(def) == OPOBJECT && OBJ(def) == OBJ(l);
- } else {
- return TYPE(def) != OPOBJECT && off_set(def) == off_set(l);
- }
-}
-
-
-
-STATIC rem_prev_defs(l,gen_p)
- line_p l;
- cset *gen_p;
-{
- /* Remove all definitions in gen that define the
- * same variable as l.
- */
-
- cset gen;
- Cindex i,next;
-
- gen = *gen_p;
- for (i = Cfirst(gen); i != (Cindex) 0; i = next) {
- next = Cnext(i,gen);
- if (same_target(l,Celem(i))) {
- Cremove(Celem(i),gen_p);
- }
- }
-}
-
-
-
-
-STATIC impl_globl_defs(p,gen_p)
- proc_p p;
- cset *gen_p;
-{
- /* Add all definitions of global variables
- * that are generated implicitly by a call
- * to p to the set gen_p.
- */
-
- Cindex i;
- short v;
- cset ext = p->p_change->c_ext;
-
- for (i = Cfirst(ext); i != (Cindex) 0; i = Cnext(i,ext)) {
- if (( v = omap[Celem(i)]->o_globnr) != (short) 0) {
- /* the global variable v, for which we do
- * maintain ud-info is changed by p, so a
- * definition of v is generated implicitly.
- */
- Cadd(IMPLICIT_DEF(GLOB_TO_VARNR(v)),gen_p);
- }
- }
-}
-
-
-
-STATIC impl_gen_defs(l,gen_p)
- line_p l;
- cset *gen_p;
-{
- /* Add all definitions generated implicitly by instruction l
- * to gen_p. l may be a call or some kind of indirect
- * assignment.
- */
-
- proc_p p;
-
- switch(INSTR(l)) {
- case op_cal:
- p = PROC(l);
- if (BODY_KNOWN(p)) {
- impl_globl_defs(p,gen_p);
- if (!CHANGE_INDIR(p)) return;
- break;
- }
- /* else fall through ... */
- case op_cai:
- /* Indirect subroutine call or call to
- * a subroutine whose body is not available.
- * Assume worst case; all global
- * variables are changed and
- * the called proc. does a store-
- * indirect.
- */
- Cjoin(all_globl_defs,gen_p);
- break;
- /* default: indir. assignment */
- }
- Cjoin(all_indir_defs,gen_p);
-}
-
-
-
-
-gen_sets(p)
- proc_p p;
-{
- /* Compute for every basic block b of p the
- * set GEN(b) of definitions in b (explicit as
- * well as implicit) that reach the end of b.
- */
-
- register bblock_p b;
- register line_p l;
- short defnr = 1;
-
- init_gen(nrdefs); /* compute all_globl_defs and all_indir_defs */
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- GEN(b) = Cempty_set(nrdefs);
- for (l = b->b_start; l != (line_p) 0; l = l->l_next) {
- if (does_impl_def(l)) {
- impl_gen_defs(l,&GEN(b));
- /* add definitions implicitly
- * generated by subroutine call
- * or indir. pointer assignment.
- */
- } else {
- if (does_expl_def(l)) {
- if (defnr <= nrdefs && defs[defnr] == l) {
- rem_prev_defs(l,&GEN(b));
- /* previous defs. of same var
- * don't reach the end of b.
- */
- Cadd(EXPL_TO_DEFNR(defnr),&GEN(b));
- defnr++;
- }
- }
- }
- }
- }
- clean_gen(); /* clean up */
-}
-
-
-
-
-STATIC killed_defs(v,b)
- short v;
- bblock_p b;
-{
- /* Put all definitions of v occurring outside b
- * in KILL(b). In fact, we also put explicit
- * definitions occurring in b, but not reaching the
- * end of b, in KILL(b). This causes no harm.
- */
-
- Cindex i;
- short d;
-
- for (i = Cfirst(vardefs[v]); i != (Cindex) 0; i = Cnext(i,vardefs[v])) {
- d = Celem(i); /* d is an explicit definition of v */
- if (!Cis_elem(EXPL_TO_DEFNR(d),GEN(b))) {
- Cadd(EXPL_TO_DEFNR(d),&KILL(b));
- }
- }
- /* Also add implicit definition of v to KILL(b) */
- Cadd(IMPLICIT_DEF(v),&KILL(b));
-}
-
-
-
-
-kill_sets(p)
- proc_p p;
-{
- /* For every basic block b of p compute the set
- * KILL(b) of definitions outside b that define
- * variables redefined by b.
- * KILL(b) contains explicit as well as implicit
- * definitions.
- */
-
- register bblock_p b;
- Cindex i;
- short v;
-
- for (b = p->p_start; b != (bblock_p) 0; b = b->b_next) {
- KILL(b) = Cempty_set(nrdefs);
- for (i = Cfirst(CHGVARS(b)); i != (Cindex) 0;
- i = Cnext(i,CHGVARS(b))) {
- v = Celem(i); /* v is a variable changed in b */
- killed_defs(v,b);
- }
- }
-}
+++ /dev/null
-/* U S E - D E F I N I T I O N A N A L Y S I S
- *
- * U D _ D E F S . H
- */
-
-extern short nrdefs; /* total number of definitions */
-extern short nrexpldefs; /* number of explicit definitions */
-extern line_p *defs; /* map of explicit definitions */
-extern cset *vardefs; /* set of explicit defs. of all variables */
-
-extern make_defs(); /* (proc_p p)
- * Compute defs[], vardefs[]
- * and CHGVARS(b) (for every b).
- */
-extern gen_sets(); /* (proc_p p)
- * Compute GEN(b) (for every b).
- */
-extern kill_sets(); /* (proc_p p)
- *Compute KILL(b) (for every b).
- */
-extern bool does_expl_def(); /* (line_p l)
- * See if instruction l does an explicit
- * definition (e.g. a STL).
- */
-extern bool does_impl_def(); /* (line_p l)
- * See if instruction l does an implicit
- * definition (e.g. a CAL).
- */
-
-
-/* Two kinds of definitions exist:
- * - an explicit definition is an assignment to a single
- * variable (e.g. a STL, STE, INE).
- * - an implicit definition is an assignment to a variable
- * performed via a subroutine call or an
- * indirect assignment (through a pointer).
- * Every explicit definition has an 'explicit definition number',
- * which is its index in the 'defs' table.
- * Every implicit definition has an 'implicit definition number',
- * which is the 'variable number' of the changed variable.
- * Every such definition also has a 'definition number'.
- * Conversions exist between these numbers.
- */
-
-#define TO_EXPLICIT(defnr) (defnr - nrvars)
-#define TO_IMPLICIT(defnr) (defnr)
-#define EXPL_TO_DEFNR(explnr) (explnr + nrvars)
-#define IMPL_TO_DEFNR(implnr) (implnr)
-#define IMPLICIT_DEF(v) (v)
-#define IMPL_VAR(defnr) (defnr)
-#define IS_IMPL_DEF(defnr) (defnr <= nrvars)
+++ /dev/null
-/* U S E - D E F I N I T I O N A N A L Y S I S
- *
- * U D _ L O C A L S . H
- */
-
-extern local_p *locals; /* table of locals, index is local-number */
-extern short nrlocals; /* number of locals for which we keep ud-info */
-
-extern make_localtab(); /* (proc_p p)
- * Analyse the text of procedure p to determine
- * which local variable p has. Make a table of
- * these variables ('locals') and count them
- * ('nrlocals'). Also collect register messages.
- */
-extern var_nr(); /* (line_p l; short *nr_out;bool *found_out)
- * Compute the 'variable number' of the
- * variable referenced by EM instruction l.
- */
+++ /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
-.\" $Header$
-.TH EM_DECODE VI
-.ad
-.SH NAME
-em_decode,em_encode \- compact to readable EM and v.v.
-.SH SYNOPSIS
-/usr/em/lib/em_decode [ inputfile [ outputfile ] ]
-.br
-/usr/em/lib/em_encode [ inputfile [ outputfile ] ]
-.SH DESCRIPTION
-Most programs involved with the EM project only produce and accept
-EM programs in compact form.
-These files are only machine readable.
-A description of this compact form can be found in [1].
-To inspect the code produced by compilers or to patch them for one reason
-or another, you need human readable assembly code.
-Em_decode will do the job for you.
-.PP
-Em_decode accepts the normal compact form in both optimized and
-unoptimized form
-.PP
-Sometimes you have to make some special routines directly
-in EM, for instance the routines implementing the system calls.
-At these times you may use em_encode to produce compact routines
-out of these human readable assembly modules.
-.PP
-The first argument is the input file.
-The second argument is the output file.
-Both programs can act as a filter.
-.SH "SEE ALSO"
-.IP [1]
-A.S.Tanenbaum, Ed Keizer, Hans van Staveren & J.W.Stevenson
-"Description of a machine architecture for use of
-block structured languages" Informatica rapport IR-81.
-.IP [2]
-ack(I)
-.SH DIAGNOSTICS
-Error messages are intended to be self-explanatory.
-.SH AUTHOR
-Johan Stevenson, Vrije Universiteit.
+++ /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$
-.TH EM_OPT VI
-.ad
-.SH NAME
-em_opt \- EM peephole optimizer
-.SH SYNOPSIS
-/usr/em/lib/em_opt [-Ln] [ argument ]
-.SH DESCRIPTION
-Em_opt reads a compact EM-program, argument or standard input,
-and produces another compact EM program on standard output
-that is functionally equivalent,
-but smaller.
-Some other functions are here that make this program mandatory
-before running a codegenerator,
-it may be left out when interpretation is wanted.
-Flags recognized are:
-.IP -L
-Make a library module.
-This means that the output will start with a message giving
-the names of all exported entities in this module.
-.IP -n
-Do not optimize.
-No peephole optimizations will be performed,
-other functions will be carried out.
-.SH "FILES"
-/usr/tmp/emopt??????, is used when the -L flag is given only.
-.SH "SEE ALSO"
-ack(I)
-.PD 0
-.IP [1]
-A.S. Tanenbaum, Hans van Staveren, Ed Keizer and Johan
-Stevenson "Description of a machine architecture for use with
-block structured languages" Informatica report IR-81.
-.SH AUTHOR
-Hans van Staveren, Vrije Universiteit
+++ /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;
-char patid[128];
-%}
-
-%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,STRING
-%token <y_int> MNEM
-%token <y_int> NUMBER
-%type <y_int> expr,argno,optexpr
-
-%start patternlist
-
-%%
-patternlist
- : /* empty */
- | STRING '\n'
- | 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);
- if (patid[0])
- printf("static char rcsid[] = %s;\n",patid);
-}
-
-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
-loc adi loc mli $2==w && $4==w: loc $3 mli w loc $1*$3 adi w
-loc adi loc sli $2==w && $4==w && $3==1: loc $3 sli w loc 2*$1 adi 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 $1>1 && $3==$1 && $4==$2: dup w lxa $1 stf $2
-lxa sdf lxa ldf $1>1 && $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 $1>1 && $3==$1 && $4==$2: dup w lxl $1 stf $2
-lxl sdf lxl ldf $1>1 && $3==$1 && $4==$2: dup 2*w lxl $1 sdf $2
-lxa sti lxa loi $1>1 && $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 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 lol adi $1==1 && $3==w: lol $2 inc
-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 mlu $1==2 && $2==w: loc 1 slu w
-loc mlu $1==4 && $2==w: loc 2 slu w
-loc mlu $1==8 && $2==w: loc 3 slu w
-loc mlu $1==16 && $2==w: loc 4 slu w
-loc mlu $1==32 && $2==w: loc 5 slu w
-loc mlu $1==64 && $2==w: loc 6 slu w
-loc mlu $1==128 && $2==w: loc 7 slu w
-loc mlu $1==256 && $2==w: loc 8 slu 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
-loc sbi loc mli $2==w && $4==w: loc $3 mli w loc $1*$3 sbi w
-loc sbi loc sli $2==w && $4==w && $3==1: loc $3 sli w loc 2*$1 sbi 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 cui
-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
-#ifdef INT
-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
-#endif
-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
-#ifdef INT
-dup SLP loi $1==p && $3==w: SLP $2 lil $2
-dup SLP sti $1==p && $3==w: SLP $2 sil $2
-#endif
-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
-LLP LLP adp SLP sti $2==$4 && (!notreg($2) || $5!=p):
- LLP $1 sti $5 LLP $2 adp $3 SLP $4
-LEP LEP adp SEP sti $2==$4 && $5!=p:
- LEP $1 sti $5 LEP $2 adp $3 SEP $4
-#ifndef INT
-dup stl $1==w : stl $2 lol $2
-dup ste $1==w : ste $2 loe $2
-dup sil $1==w : sil $2 lil $2
-dup LEP sti $1==w && $3==w : LEP $2 sti w LEP $2 loi w
-dup LLP stf $1==w : LLP $2 stf $3 LLP $2 lof $3
-dup LEP stf $1==w : LEP $2 stf $3 LEP $2 lof $3
-dup sdl $1==2*w : sdl $2 ldl $2
-dup sde $1==2*w : sde $2 lde $2
-dup LLP sti $1==2*w && $3==2*w : LLP $2 sti 2*w LLP $2 loi 2*w
-dup LEP sti $1==2*w && $3==2*w : LEP $2 sti 2*w LEP $2 loi 2*w
-dup LLP sdf $1==2*w : LLP $2 sdf $3 LLP $2 ldf $3
-dup LEP sdf $1==2*w : LEP $2 sdf $3 LEP $2 ldf $3
-lol dup $2==w : lol $1 lol $1
-loe dup $2==w : loe $1 loe $1
-lil dup $2==w : lil $1 lil $1
-LEP loi dup $2==w && $3==2 : LEP $1 loi w LEP $1 loi w
-ldl dup $2==2*w : ldl $1 ldl $1
-lde dup $2==2*w : lde $1 lde $1
-#endif
-adp SLP LLP adp $1+$4==0 && $2==$3 : dup p adp $1 SLP $2
-adp SEP LEP adp $1+$4==0 && $2==$3 : dup p adp $1 SEP $2
-adp sil lil adp $1+$4==0 && $2==$3 && w==p : dup p adp $1 sil $2
-adp LLP sti LLP loi adp $1+$6==0 && $2==$4 && $3==p && $5==p :
- dup p adp $1 LLP $2 sti p
-adp LEP sti LEP loi adp $1+$6==0 && $2==$4 && $3==p && $5==p :
- dup p adp $1 LEP $2 sti p
+++ /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:
- if ((em_flag[instr-sp_fmnem]&EM_FLO)==FLO_P)
- curlin = -2;
- 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;
-
-#ifndef GLOBAL_OPT
- /* If we're optimizing the output of the global optimizer
- * we must not change the count fields of the register messages.
- */
- for(rp=curpro.freg; rp != (reg_p) 0; rp=rp->r_next)
- if (rp->r_par[0]==off) {
- rp->r_par[3]++;
- return;
- }
-#endif
-}
+++ /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();
-%}
-%%
-\"[^"]*\" { strncpy(patid,yytext,sizeof(patid)); return(STRING); }
-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
- ack -Ropt=${1-opt} -O -c.m t.e;ack -c.e t.m
- cat t.e
- echo '===== next case (interrupt to stop) ====='
-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 */
+++ /dev/null
-: '$Header$'
-
-case $# in
-3) makecmd=$3 ;;
-2) makecmd=compmodule ;;
-*) echo "Usage: $0 srcdir archname [ makecmd ]"; exit 1 ;;
-esac
-
-errors=no
-if test -r $1/LIST
-then
- <$1/LIST (
- read archname
- if test -r $1/$archname
- then
- arch x $1/$archname
- for file in `arch t $1/$archname`
- do
- suffix=`expr $file : '.*\(\..*\)'`
- ofile=`$makecmd $file $suffix`
- if test $? != 0
- then errors=yes
- fi
- rm $file
- OFILES="$OFILES $ofile"
- done
- else
- while read file
- do
- suffix=`expr $file : '.*\(\..*\)'`
- ofile=`$makecmd $1/$file $suffix`
- if test $? != 0
- then errors=yes
- fi
- OFILES="$OFILES $ofile"
- done
- fi
- if test $errors = no
- then
- ${ASAR-arch} cr $2 $OFILES
- rm $OFILES
- else
- echo $2 not made, due to compilation errors
- exit 1
- fi
- )
-else
- echo no LIST file in directory $1
- exit 1
-fi
public / ack.git / commitdiff