diff --git a/Action b/Action new file mode 100644 index 00000000..c3c03fc0 --- /dev/null +++ b/Action @@ -0,0 +1,131 @@ +name "System definition" +dir first +action did_first +failure "You have to run the shell script first in the directory first" +fatal +end +name "EM definition" +dir etc +end +name "C preprocessor" +dir util/cpp +end +name "EM definition library" +dir util/data +end +name "Encode/Decode" +dir util/misc +end +name "Shell files in bin" +dir util/shf +end +name "EM assembler" +dir util/ass +end +name "EM Peephole optimizer" +dir util/opt +end +name "ACK archiver" +dir util/arch +end +name "Program 'ack'" +dir util/ack +end +name "Bootstrap for backend tables" +dir util/cgg +end +name "LL(1) Parser generator" +dir util/LLgen +end +name "Bootstrap for newest form of backend tables" +dir util/ncgg +end +name "C frontend" +dir lang/cem/comp +end +name "Basic frontend" +dir lang/basic/src +end +name "Intel 8086 support" +dir mach/i86 +indir +end +name "MSC6500 support" +dir mach/6500 +indir +end +name "Motorola 6800 support" +dir mach/6800 +indir +end +name "Motorola 6805 support" +dir mach/6805 +indir +end +name "Motorola 6809 support" +dir mach/6809 +indir +end +name "Intel 8080 support" +dir mach/8080 +indir +end +name "2-2 Interpreter support" +dir mach/int22 +indir +end +name "2-4 Interpreter support" +dir mach/int24 +indir +end +name "4-4 Interpreter support" +dir mach/int44 +indir +end +name "IBM PC/IX support" +dir mach/ix +indir +end +name "Motorola 68000 2-4 support" +dir mach/m68k2 +indir +end +name "NS16032 support" +dir mach/ns +indir +end +name "PDP 11 support" +dir mach/pdp +indir +end +name "PMDS support" +dir mach/pmds +indir +end +name "Signetics 2650 support" +dir mach/s2650 +indir +end +name "Vax 2-4 support" +dir mach/vax2 +indir +end +name "Vax 4-4 support" +dir mach/vax4 +indir +end +name "Z80 support" +dir mach/z80 +indir +end +name "Zilog Z8000 support" +dir mach/z8000 +indir +end +name "Nascom support" +dir mach/z80a +indir +end +name "Pascal frontend" +dir lang/pc/pem +end diff --git a/Copyright b/Copyright new file mode 100644 index 00000000..2c794d37 --- /dev/null +++ b/Copyright @@ -0,0 +1,17 @@ +/* + * (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 + * + */ + diff --git a/DistrAction b/DistrAction new file mode 100755 index 00000000..e36bee44 --- /dev/null +++ b/DistrAction @@ -0,0 +1 @@ +exec sh TakeAction distr distr/Action diff --git a/Makefile b/Makefile new file mode 100644 index 00000000..bf4572b2 --- /dev/null +++ b/Makefile @@ -0,0 +1,35 @@ +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 ) \ + ) diff --git a/README b/README new file mode 100644 index 00000000..58e870f2 --- /dev/null +++ b/README @@ -0,0 +1,2 @@ +Before starting installation you should read +the file doc/install.pr diff --git a/TakeAction b/TakeAction new file mode 100755 index 00000000..7902f293 --- /dev/null +++ b/TakeAction @@ -0,0 +1,102 @@ +case $# in +0) PAR=install ; CMD=Action ;; +1) PAR="$1" ; CMD=Action ;; +2) PAR="$1" ; CMD="$2" ;; +*) echo Syntax: "$0" [param [file]] ; exit 1 ;; +esac +if test -r "$CMD" +then : +else + case "$CMD" in + Action) echo No Action file present ;; + *) echo No Action file "($CMD)" present ;; + esac +fi +THISFILE=`pwd`/$0 +SYS= +RETC=0 +{ while read LINE +do + eval set $LINE + case x"$1" in + x#*) ;; + xname) SYS="$2" + ACTION='make $PAR' + DIR=. + FAIL='Failed for $SYS, see $DIR/Out' + SUCC='$SYS -- done' + ATYPE= + FATAL=no + DOIT=yes + ;; + xfatal) FATAL=yes ;; + xaction|xindir) case x$ATYPE in + x) ACTION=$2 ; ATYPE=$1 ;; + *) echo Already specified an $ATYPE for this name + RETC=-1 ;; + esac ;; + xfailure) FAIL="$2" ;; + xsuccess) SUCC="$2" ;; + xdir) DIR="$2" ;; + xsystem) case `ack_sys` in + $2) ;; + *) echo "Sorry, $SYS can only be made on $2 systems" + DOIT=no + ;; + esac ;; + xend) case $DOIT in + no) continue ;; + esac + case x$SYS in + x) echo Missing name line; RETC=-1 ;; + *) if test -d $DIR + then ( + cd $DIR + X= + case $ATYPE in + indir) + if sh $THISFILE $PAR $ACTION + then eval echo $SUCC + else RETC=2 ; eval echo $FAIL + fi ;; + *) + if eval "$ACTION >Out 2>&1 /dev/null 1>&- 1>&3 + exit $RETC + ) + case $? in + 0) ;; + *) case $RETC in + 0) RETC=$? ;; + esac ;; + esac + else + echo Directory $DIR for $SYS is inaccessible + RETC=-2 + fi ;; + esac + case $FATAL$RETC in + yes0) ;; + yes*) echo Fatal error, installation stopped. + exit $RETC ;; + esac + SYS= + ;; + *) echo Unknown keyword "$1" + RETC=-3 ;; + esac +done +} <$CMD +RETX=$? +case $RETX in +0) exit $RETC ;; +*) exit $RETX ;; +esac diff --git a/distr/todistr b/distr/todistr new file mode 100644 index 00000000..968ec954 --- /dev/null +++ b/distr/todistr @@ -0,0 +1,26 @@ +REV= +FILE= +while : +do + case $# in + 0) break ;; + esac + ARG="$1" + shift + case "$ARG" in + -r*) REV=`echo "$ARG"| sed s/-r//` ;; + -*) FLAGS="$FLAGS $ARG" ;; + *) case x$FILE in + x) FILE="$ARG" ;; + *) echo todistr can only be done on one file at the time + exit 1 ;; + esac + esac +done +case x$REV in +x) REV=`rlog -h "$FILE"|sed -n -e '/head/s/^head:[ ]*//p'` ;; +esac +case x$REV in +x) exit 2 ;; +esac +rcs -ndistr2:$REV $FLAGS $FILE diff --git a/doc/6500.doc b/doc/6500.doc new file mode 100644 index 00000000..aeef24a9 --- /dev/null +++ b/doc/6500.doc @@ -0,0 +1,2163 @@ +. \" $Header$" +.po +10 +.ND +.TL +.B +A backend table for the 6500 microprocessor +.R +.AU +Jan van Dalen +.AB +The backend table is part of the Amsterdam Compiler Kit (ACK). +It translates the intermediate language family EM to a machine +code for the MCS6500 microprocessor family. +.AE +.PP +.bp +.NH +Introduction. +.PP +As more and more organizations aquire many micro and minicomputers, +the need for portable compilers is becoming more and more acute. +The present situation, in which each harware 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 integerated +system is being built at the Vrije Universiteit. +.PP +The 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 [5], +but which never really caught on then. The problem which UNCOL +attemps to solve is how to make a compiler for each of +.B +N +.R +languages on +.B +M +.R +different machines without having to write +.B +N +.R +x +.B +M +.R +programs. +.PP +As shown in Fig. 1, the UNCOL approach is to write +.B +N +.R +"front ends," each of which translates +one source language to a common +intermediate language, UNCOL (UNiversal Computer Oriented +Language), and +.B +M +.R +"back ends," each of which translates programs +in UNCOL to a specific machine language. Under these conditions, +only +.B +N +.R ++ +.B +M +.R +programs must be written to provide all +.B +N +.R +languages on all +.B +M +.R +machines, instead of +.B +N +.R +x +.B +M +.R +programs. +.PP +Various reseachers have attempted to design a suitable UNCOL [1,6], +but none of these have become popular. It is the believe of the +designers of the Amsterdam Compiler Kit that previous attemps +have failed because they have been too ambitious, that is, they have +tried to cover all languages and all machines using a single UNCOL. +The approach of the designers is more modest: +they cater only to algebraic languages and machines whose memory +consist 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, where 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, MOS Technology MCS6500 family and IBM but not the Burroughs +6700, CDC Cyber or Univac 1108 (because they are not byte_oriented). +With these restrictions the designers believe that the old UNCOL +idea can be used as the basis of a practical compiler-building +system. +.sp 10 +.bp +.NH +An overview of the Amsterdam Compiler kit +.PP +The tool kit consists of eight components: +.IP 1. +The preprocessor. +.IP 2. +The front ends. +.IP 3. +The peephole optimizer. +.IP 4. +The global optimizer. +.IP 5. +The back end. +.IP 6. +The target machine optimizer. +.IP 7. +The universal assembler/linker. +.IP 8. +The utility package. +.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. +.sp 20 +.PP +In the following paragraphs a brief decription of each component +is given. +A more detailed description of the back end will be given in the +rest of this document. For a more detailed descripiton on the rest +of the components see [7]. A program to be compiled is first fed +into the (language independed) preprocessor, which provides a +simple macro facility and similar textual facilities. +The preprocessor's ouput is a legal program in one of the programming +languages supported, whereas the input is a program possibly +augmented with macro's, etc. +.PP +This output goes into the appropriate front end, whose job it is to +produce intermediate cade. +This intermediate code (the UNCOL of ACK) is the machine language +for a simple stack machine EM (Encoding Machine). +A typical front end might build a parse tree from the input +and then use the parse tree to generate EM cade, +which is similar to reverse Polish. +In order to perform this work, the front end has to maintain tables of declare +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 view 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 just one peephole optimizer. +By handeling 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 [2], +which unlike the peephole optimizer, examines the program as a whole. +It builts 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 EM code is +mapped onto the machine's assembly language. +Although a simple driving table just might macro expand each +EM instruction into a sequence of target machine instructions, +a much more sophisticated translation strategy is normaly used, +as described later. +For speech, 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 binairy 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 idiosyncrasies of the +target machine that cannot be performed by the machine-independent +EM-to-EM peephole optimizer. +Typically these optimizations take advantage of the 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. +.bp +.DS C +.B +THE MCS6500 MICROPROCESSOR. +.R +.DE +.NH 0 +Introduction +.PP +Why a back end table for the MCS6500 microprocessor family. +Although the MCS6500 microprocessor family has an simple +instruction set and internal structure, it is used in a +variety of microcomputers and homecomputers. +This is because of is low cost. +As an example the Apple II, a well known and width spread +microprocessor, uses the MCS6502 CPU. +Also the BBC homecomputer, whose popularity is growing day +by day uses the MCS6502 CPU. +The BBC homecomputer is based on the MCS6502 CPU although +better and stronger microprocessors are available. +The designers of Acorn computer Industries have probably +choosen for the MCS6502 because of the amount of software +available for this CPU. +Since its width spreaded use, a variaty of software +will be needed for it. +One can think of games!!, administration programs, +teaching programs, basic interpreters and other application +programs. +Even do it will not be possible to run the total compiler kit +on a MCS6500 based computer, it is possible to write application +programs in a high level language, such as Pascal or C on a +minicomputer. +These application programs can be tested and compiled on that +minicomputer and put in a ROM (Read Only Memory), for example, +cso that it an be executed by a MCS6500 CPU. +The strategy of writing testprograms on a minicomputer, +compile it and then execute it on a MCS6500 based +microprocessor is used by the development of the back end. +The minicomputer used is M68000 based one, manufactured by +Bleasdale Computer Systems Ltd.. +The micro- or homecomputer used is a BBC microcomputer, +manufactured by Acorn Computer Ltd.. +.NH +The MOS Technology MCS6500 +.PP +The MCS6500 is as a family of CPU devices developed by MOS +Technology. +The members of the MCS6500 family are the same chips in a +different housing. +The MCS6502, the big brother in the family, can handle 64k +bytes of memory, while for example the MCS6504 can only handle +8k bytes of memory. +This difference is due to the fact that the MCS6502 is in a +40 pins house and the MCS6504 has a 28 pins house, so less +address lines are available. +.bp +.NH +The MCS6500 CPU programmable registers +.PP +The MCS6500 series is based on the same chip so all have the +same programmable registers. +.sp 9 +.NH 2 +The accumulator A. +.PP +The accumulator A is the only register on which the arithmetic +and logical instructions can be used. +For example, the instruction ADC (add with carry) adds the +contents of the accumulator A and a byte from memory or data. +.NH 2 +The index register X. +.PP +As the name suggests this register can be used for some +indirect addressing modes. +The modes are explaned below. +.NH 2 +The index register Y. +.PP +This register is, just as the index register X, used for +certain indirect addressing modes. +These addressing modes are different from the modes which +use index register X. +.NH 2 +The program counter PC +.PP +This is the only 16-bit register available. +It is used to point to the next instruction to be +carried out. +.NH 2 +The stack pointer SP +.PP +The stack pointer is an 8-bit register, so the stack can contain +at most 256 bytes. +The CPU always appends 00000001 as highbyte of any stack address, +which means that memory locations +.B +0100 +.R +through +.B +01FF +.R +are permanently assigned to the stack. +.sp 12 +.NH 2 +The status register +.PP +The status register maintains six status flags and a master +interrupt control bit. +.br +These are the six status flags: + Carry (c) + Zero (z) + Overflow (o) + Sign (n) + Decimal mode (d) + Break (b) + + + + + +The bit (i) is the master interrupt control bit. +.NH +The MCS6500 memory layout. +.PP +In the MCS6500 memory space three area's have special meaning. +These area's are: +.IP 1) +Top page. +.IP 2) +Zero page. +.IP 3) +The stack. +.PP +MCS6500 memory is divided up into pages. +These pages consist 256 bytes. +So in a memory address the highbyte denotes the page number +and the lowbyte the offset within the page. +.NH 2 +Top page. +.PP +When a MCS6500 is restared it jumps indirect via memory address +.B +FFFC. +.R +At +.B +FFFC +.R +(lowbyte) and +.B +FFFD +.R +(highbyte) there must be the address of the bootstrap subroutine. +When a break instruction (BRK) occurs or an interrupt takes place, +the MCS6500 jumps indirect through memory address +.B +FFFE. +.R +.B +FFFE +.R +and +.B +FFFF +.R +thus, must contain the address of the interrupt routine. +The former only goes for maskeble interrupt. +There also exist a nonmaskeble interrupt. +This cause the MCS6500 to jump indirect through memory address +.B +FFFA. +.R +So the top six bytes of memory are used by the operating system +and therefore not available for the back end. +.NH 2 +Zero page. +.PP +This page has a special meaning in the sence that addressing +this page uses special opcodes. +Since a page consists of 256 bytes, only one byte is needed +for addressing zero page. +So an instruction which uses zero page occupies two bytes. +It also uses less clock cycle's while carrying out the instruction. +Zero page is also needed when indirect addressing is used. +This means that when indirect addressing is used, the address must +reside in zero page (two consecutive bytes). +In this case (the back end), zero page is used, for example +to hold the local base, the second local base, the stack pointer +etc. +.NH 2 +The stack. +.PP +The stack is described in paragraph 3.5 about the MCS6500 +programmable registers. +.NH +The memory adressing modes +.PP +MCS6500 memory reference instructions use direct addressing, +indexed addressing, and indirect addressing. +.NH 2 +direct addressing. +.PP +Three-byte instructions use the second and third bytes of the +object code to provide a direct 16-bit address: +therefore, 65.536 bytes of memory can be addressed directly. +The commonly used memory reference instructions also have a two-byte +object code variation, where the second byte directly addresses +one of the first 256 bytes. +.NH 2 +Base page, indexed addressing. +.PP +In this case, the instruction has two bytes of object code. +The contents of either the X or Y index registers are added to the +second object code byte in order to compute a memory address. +This may be illustrated as follows: +.sp 15 +Base page, indexed addressing, as illustrated above, is +wraparound - which means that there is no carry. +If the sum of the index register and second object code byte contents +is more than +.B +FF +.R +, the carry bit will be dicarded. +This may be illustrated as follows: +.sp 9 +.NH 2 +Absolute indexed addressing. +.PP +In this case, the contents of either the X or Y register are added +to a 16-bit direct address provided by the second and third bytes +of an instruction's object code. +This may be illustrated as follows: +.sp 10 +.NH 2 +Indirect addressing. +.PP +Instructions that use simple indirect addressing have three bytes of +object code. +The second and third object code bytes provide a 16-bit address; +therefore, the indirect address can be located anywhere in +memory. +This is straightforward indirect addressing. +.NH 3 +Pre-indexed indirect addressing. +.PP +In this case, the object code consists of two bytes and the +second object code byte provides an 8-bit address. +Instructions that use pre-indexed indirect addressing add the contents +of the X index register and the second object code byte to access +a memory location in the first 256 bytes of memory, where the +indirect address will be found: +.sp 18 +When using pre-indexed indirect addressing, once again wraparound +addition is used, which means that when the X index register contents +are added to the second object code byte, any carry will be discarded. +Note that only the X index register can be used with pre-indexed +addressing. +.NH 3 +Post-indexed indirect addressing. +.PP +In this case, the object code consists of two bytes and the +second object code byte provides an 8-bit address. +Now the second object code byte indentifies a location +in the first 256 bytes of memory where an indirect address +will be found. +The contents of the Y index register are added to this indirect +address. +This may be illustrated as follows: +.sp 18 +Note that only the Y index register can be used with post-indexed +indirect addressing. +.bp +.NH +What the CPU has and doesn't has. +.PP +Although the designers of the MCS6500 CPUs family state that +there is nothing very significant about the short stack (only +256 bytes) this stack caused problems for the back end. +The designers say that a 256-byte stack usually is sufficient +for any typical microcomputer, this is only true if the stack +is used only for return addresses of the JSR (jump to +subroutine) instruction. +But since the EM machine is suppost to be a stack machine and +high level languages need the ability of parameters and +locals in there procedures and function, this short stack +is unsufficiant. +So an software stack is implemented in this back end, requiring two +additional subroutines for stack handling. +These two stack handling subroutines slow down the processing time +of a program since the stack is used heavely. +.PP +Since parameters and locals of EM procedures are offseted +from the localbase of that procedure, indirect addressing +is havily used. +Offsets are positive (for parameters) and negative (for +local variables). +As explaned before the addressing modes the MCS6500 have a +post indexed indirect addressing mode. +This addressing mode can only handle positive offsets. +This raises a problem for accessing the local variables +I have chosen for the next solution. +A second local base is introduced. +This second local base is the real local base subtracted by +a constant BASE. +In the present situation of the back end the value of BASE +is 240. +This means that there are 240 bytes reseved for local +variables to be indirect addressed and 14 bytes for +the parameters. +.DS C +.B +THE CODE GENERATOR. +.R +.DE +.NH 0 +Description of the machine table. +.PP +The machine description table consists of the following sections: +.IP 1. +The macro definitions. +.IP 2. +Constant definitions. +.IP 3. +Register definitions. +.IP 4. +Token definitions. +.IP 5. +Token expressions. +.IP 6. +Code rules. +.IP 7. +Move definitions. +.IP 8. +Test definitions. +.IP 9. +Stack definitions. +.NH 2 +Macro definitions. +.PP +The macro definitions at the top of the table are expanded +by the preprocessor on occurence in the rest of the table. +.NH 2 +Constant definitions. +.PP +There are three constants which must be defined at first. +The are: +.IP EM_WSIZE: 11 +Number of bytes in a machine word. +This is the number of bytes a simple +.B +loc +.R +instruction will put on the stack. +.IP EM_PSIZE: +Number of bytes in a pointer. +This is the number of bytes a +.B +lal +.R +instruction will put on the stack. +.IP EM_BSIZE: +Number of bytes in the hole between AB and LB. +The calling sequence only saves LB on the stack so this +constant is equal to the pointer size. +.NH 1 +Register definitions. +.PP +The only important register definition is the definition of +the registerpair AX. +Since the rest of the machine's registers Y, PC, ST serve +special purposes, the code generator cannot use them. +.NH 2 +Token definitions +.PP +There is a fake token. +This token is put in the table, since the code generator generator +complains if it cannot find one. +.NH 2 +Token expression definitions. +.PP +The token expression is also a fake one. +This token expression is put in the table, since the code generator +generator complains if it cannot find one. +.NH 2 +Code rules. +.PP +The code rule section is the largest section in the table. +They specify EM patterns, stack patterns, code to be generated, +etc. +The syntax is: +.IP code rule: +EM pattern '|' stack pattern '|' code '|' +stack replacement '|' EM replacement '|' +.PP +All patterns are optional, however there must be at least one +pattern present. +If the EM pattern is missing the rule becomes a rewriting +rule or a +.B +coercion +.R +to be used when code generation cannot continue because of an +invalid stack pattern. +The code rules are preceeded by the word CODE:. +.NH 3 +The EM pattern. +.PP +The EM pattern consists of a list of EM mnemonics followed by +a boolean expression. Examples: +.sp 1 +.br +.B +loe +.R +.sp 1 +will match a single +.B +loe +.R +instruction, +.sp 1 +.br +.B +loc loc cif +.R +$1==2 && $2==8 +.sp 1 +is a pattern that will match +.sp 1 +.br +.B +loc +.R +2 +.br +.B +loc +.R +8 +.br +.B +cif +.R +.sp 1 +and +.sp 1 +.br +.B +lol +inc +stl +.R +$1==$3 +.sp 1 +will match for example +.sp 1 +.br +.B +lol +.R +6 +.br +.B +inc +.R +.br +.B +stl +.R +6 +.sp 1 +A missing boolean expession evaluates to TRUE. +.PP +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 only stack pattern that can occur is R16, which means that the +registerpair AX contains the word on top of the stack. +If this is not the case a coersion occurs. +This coersion generates a "jsr Pop", which means that the top +of the stack is popped and stored in the registerpair AX. +.NH 3 +The code part. +.PP +The code part consists of three parts, stack cleanup, register +allocation, and code to be generated. +All of these may be omitted. +.NH 4 +Stack cleanup. +.PP +When generating something like a branch instruction it might be +needed to empty the fake stack, that is, remove the AX registerpair. +This is done by the instruction remove(ALL) +.NH 4 +Register allocation. +.PP +If the machine code to be generated uses the registerpair AX, +this is signaled to the code generator by the allocate(R16) +instruction. +If the registerpair AX resides on the fake stack, this will result +in a "jsr Push", which means that the registerpair AX is pushed on +the stack and will be free for further use. +If registerpair AX is not on the fake stack nothing happens. +.NH 4 +Code to be generated. +.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"). +This is copied to the codefile and a newline ('\n') 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 operand of the corresponding EM +instructions and are printed according to there type. +To put a real '$' inside the string it must be doubled ('$$'). +.IP b) +%[1], %[2.reg], %[b.1] etc. these have there obvious meaning. +If they describe a complete token (%[1]) the printformat for +the token is used. +If they stand fo 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 akward notation +is not too bad. +Note that %(%[1]%) is equivalent to %[1]. +.RE +.NH 3 +stack replacement. +.PP +The stack replacement is a possibly empty list of items to be +pushed on the fake stack. +Three things can occur: +.IP 1) +%[1] is used if the registerpair AX was on the fake stack and is +to be pushed back onto it. +.IP 2) +%[a] is used if the registerpair AX is allocated with allocate(R16) +and is to be pushed onto the fake stack. +.IP 3) +It can also be empty. +.NH 3 +EM replacement. +.PP +In exeptional cases it might be useful to leave part of the an EM +pattern undone. +For example, a +.B +sdl +.R +instruction might be split into two +.B +stl +.R +instructions when there is no 4-byte quantity on the stack. +The EM replacement part allows one to express this. +Example: +.sp 1 +.br +.B +stl +.R +$1 +.B +stl +.R +$1+2 +.sp 1 +The instructions are inserted in the stream so 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 +.sp 1 +.br +.B +loc +stl +.R +$1==0 +.sp1 +and the input is +.sp 1 +.br +.B +loc +.R +0 +.B +sdl +.R +4 +.sp 1 +the +.B +loc +.R +0 +will be processed first, then the +.B +sdl +.R +might be split into two +.B +stl +.R +'s but the pattern cannot match now. +.NH 3 +Move definitions. +.PP +This definition is a fake. This definition is put in the +table, since the code generator generator complains if it +cannot find one. +.NH 3 +Test definitions. +.PP +Test definitions aren't used by the table. +.NH 3 +Stack definitions. +.PP +When the generator has to push the registerpair AX, it must +know how to do so. +The machine code to be generated is defined here. +.NH 1 +Some remarks. +.PP +The above description of the machine table is +a description of the table for the MCS6500. +It uses only a part of the possibilities which the code generator +generator offers. +For a more precise and detailed description see [4]. +.DS C +.B +THE BACK END TABLE. +.R +.DE +.NH 0 +Introduction. +.PP +The code rules are divided in 15 groups. +These groups are: +.IP 1. +Load instructions. +.IP 2. +Store instructions. +.IP 3. +Integer arithmetic instructions. +.IP 4. +Unsigned arithmetic instructions. +.IP 5. +Floating point arithmetic instructions. +.IP 6. +Pointer arithmetic instructions. +.IP 7. +Increment, decrement and zero instructions. +.IP 8. +Convert instructions. +.IP 9. +Logical instructions. +.IP 10. +Set manipulation instructions. +.IP 11. +Array instructions. +.IP 12. +Compare instructions. +.IP 13. +Branch instructions. +.IP 14. +Procedure call instructions. +.IP 15. +Miscellaneous instructions. +.PP +From all of these groups one or two typical EM pattern will be explained +in the next paragraphs. +Comment is placed between /* and */ (/* This is a comment */). +.NH +The instructions. +.NH 2 +The load instructions. +.PP +In this group a typical instruction is +.B +lol +.R +. +A +.B +lol +.R +instruction pushes the word at local base + offset, where offset +is the instructions argument, onto the stack. +Since the MCS6500 can only offset by 256 bytes, as explaned at the +memory addressing modes, there is a need for two code rules in the +table. +One which can offset directly and one that must explicit +calculate the address of the local. +.NH 3 +The lol instruction with indirect offsetting. +.PP +In this case an indirect offsetted load from the second local base +is possible. +The table content is: +.sp 1 +.br +.B +lol +.R +IN($1) | | +.br +allocate(R16) /* allocate registerpair AX */ +.br +"ldy #BASE+$1" /* load Y with the offset from the second +.br + local base */ +.br +"lda (LBl),y" /* load indirect the lowbyte of the word */ +.br +"tax" /* move register A to register X */ +.br +"iny" /* increment register Y (offset) */ +.br +"lda (LBl),y" /* load indirect the highbyte of the word */ +.br +| %[a] | | /* push the word onto the fake stack */ +.NH 3 +The lol instruction whose offset is to big. +.PP +In this case, the library subroutine "Lol" is used. +This subroutine expects the offset in registerpair AX, then +calculates the address of the local or parameter, and loads +it into registerpair AX. +The table content is: +.sp 1 +.br +.B +lol +.R +| | +.br +allocate(R16) /* allocate registerpair AX */ +.br +"lda #[$1].h" /* load highbyte of offset into register A */ +.br +"ldx #[$1].l" /* load lowbyte of offset into register X */ +.br +"jsr Lol" /* perform the subroutine */ +.br +| %[a] | | /* push word onto the fake stack */ +.NH 2 +The store instructions. +.PP +In this group a typical instruction is +.B +stl. +.R +A +.B +stl +.R +instruction poppes a word from the stack and stores it in the word +at local base + offset, where offset is the instructions argument. +Here also is the need for two code rules in the table as a result +of the offset limits. +.NH 3 +The stl instruction with indirect offsetting. +.PP +In this case it an indirect offsetted store from the second local +base is possible. +The table content is: +.sp 1 +.br +.B +stl +.R +IN($1) | R16 | /* expect registerpair AX on top of the +.br + fake stack */ +.br +"ldy #BASE+1+$1" /* load Y with the offset from the +.br + second local base */ +.br +"sta (LBl),y" /* store the highbyte of the word from A */ +.br +"txa" /* move register X to register A */ +.br +"dey" /* decrement offset */ +.br +"sta (LBl),y" /* store the lowbyte of the word from A */ +.br +| | | +.NH 3 +The stl instruction whose offset is to big. +.PP +In this case the library subroutine 'Stl' is used. +This subroutine expects the offset in registerpair AX, then +calculates the address, poppes the word stores it at its place. +The table content is: +.sp 1 +.br +.B +stl +.R +| | +.br +allocate(R16) /* allocate registerpair AX */ +.br +"lda #[$1].h" /* load highbyte of offset in register A */ +.br +"ldx #[$1].l" /* load lowbyte of offset in register X */ +.br +"jsr Stl" /* perform the subroutine */ +.br +| | | +.NH 2 +Integer arithmetic instructions. +.PP +In this group typical instructions are +.B +adi +.R +and +.B +mli. +.R +These instructions, in this table, are implemented for 2-byte +and 4-byte integers. +The only arithmetic instructions available on the MCS6500 are +the ADC (add with carry), and SBC (subtract with not(carry)). +Not(carry) here means that in a subtraction, the one's complement +of the carry is taken. +The absence of multiply and division instructions forces the +use of subroutines to handle these cases. +Because there are no registers left to perform on the multiply +and division, zero page is used here. +The 4-byte integer arithmetic is implemented, because in C there +exists the integer type long. +A user is freely to use the type long, but will pay in performance. +.NH 3 +The adi instruction. +.PP +In case of the +.B +adi +.R +2 (and +.B +sbi +.R +2) instruction there are many EM +patterns, so that the instruction can be performed in line in +most cases. +For the worst case there exists a subroutine in the library +which deals with the EM instruction. +In case of a +.B +adi +.R +4 (or +.B +sbi +.R +4) there only is a subroutine to deal with it. +A table content is: +.sp 1 +.br +.B +lol lol adi +.R +(IN($1) && IN($2) && $3==2) | | /* is it in range */ +.br +allocate(R16) /* allocate registerpair AX */ +.br +"ldy #BASE+$1+1" /* load Y with offset for first operand */ +.br +"lda (LBl),y" /* load indirect highbyte first operand */ +.br +"pha" /* save highbyte first operand on hard_stack */ +.br +"dey" /* decrement offset first operand */ +.br +"lda (LBl),y" /* load indirect lowbyte first operand */ +.br +"ldy #BASE+$2" /* load Y with offset for second operand */ +.br +"clc" /* clear carry for addition */ +.br +"adc (LBl),y" /* add the lowbytes of the operands */ +.br +"tax" /* store lowbyte of result in place */ +.br +"iny" /* increment offset second operand */ +.br +"pla" /* get highbyte first operand */ +.br +"adc (LBl),y" /* add the highbytes of the operands */ +.br +| %[a] | | /* push the result onto the fake stack */ +.NH 3 +The mli instruction. +.PP +The +.B +mli +.R +2 instruction uses most the subroutine 'Mlinp'. +This subroutine expects the multiplicand in zero page +at locations ARTH, ARTH+1, while the multiplier is in zero +page locations ARTH+2, ARTH+3. +For a description of the algorithms used for multiplication and +division, see [9]. +A table content is: +.sp 1 +.br +.B +lol lol mli +.R +(IN($1) && IN($2) && $3==2) | | +.br +allocate(R16) /* allocate registerpair AX */ +.br +"ldy #BASE+$1" /* load Y with offset of multiplicand */ +.br +"lda (LBl),y" /* load indirect lowbyte of multiplicand */ +.br +"sta ARTH" /* store lowbyte in zero page */ +.br +"iny" /* increment offset of multiplicand */ +.br +"lda (LBl),y" /* load indirect highbyte of multiplicand */ +.br +"sta ARTH+1" /* store highbyte in zero page */ +.br +"ldy #BASE+$2" /* load Y with offset of multiplier */ +.br +"lda (LBl),y" /* load indirect lowbyte of multiplier */ +.br +"sta ARTH+2" /* store lowbyte in zero page */ +.br +"iny" /* increment offset of multiplier */ +.br +"lda (LBl),y" /* load indirect highbyte of multiplier */ +.br +"sta ARTH+3" /* store highbyte in zero page */ +.br +"jsr Mlinp" /* perform the multiply */ +.br +| %[a] | | /* push result onto fake stack */ +.NH 2 +The unsgned arithmetic instructions. +.PP +Since unsigned addition an subtraction is performed in the same way +as signed addition and subtraction, these cases are dealt with by +an EM replacement. +For mutiplication and division there are special subroutines. +.NH 3 +Unsigned addition. +.PP +This is an example of the EM replacement strategy. +.sp 1 +.br +.B +lol lol adu +.R + | | | | +.B +lol +.R +$1 +.B +lol +.R +$2 +.B +adi +.R +$3 | +.NH 2 +Floating point arithmetic. +.PP +Floating point arithmetic isn't implemented in this table. +.NH 2 +Pointer arithmetic instructions. +.PP +A typical pointer arithmetic instruction is +.B +adp +.R +2. +This instruction adds an offset and a pointer. +A table content is: +.sp 1 +.br +.B +adp +.R + | | | | +.B +loc +.R +$1 +.B +adi +.R +2 | +.NH 2 +Increment, decrement and zero instructions. +.PP +In this group a typical instruction is +.B +inl +.R +, which increments a local or parameter. +The MCS6500 doesn't have an instruction to increment the +accumulator A, so the 'ADC' instruction must be used. +A table content is: +.sp 1 +.br +.B +inl +.R +IN($1) | | +.br +allocate(R16) /* allocate registerpair AX */ +.br +"ldy #BASE+$1" /* load Y with offset of the local */ +.br +"clc" /* clear carry for addition */ +.br +"lda (LBl),y" /* load indirect lowbyte of local */ +.br +"adc #1" /* increment lowbyte */ +.br +"sta (LBl),y" /* restore indirect the incremented lowbyte */ +.br +"bcc 1f" /* if carry is clear then ready */ +.br +"iny" /* increment offset of local */ +.br +"lda (LBl),y" /* load indirect highbyte of local */ +.br +"adc #0" /* add carry to highbyte */ +.br +"sta (LBl),y\\n1:" /* restore indirect the highbyte */ +.PP +If the offset of the local or parameter is to big, first the +local or parameter is fetched, than incremented, and then +restored. +.NH 2 +Convert instructions. +.PP +In this case there are two convert instructions +which really do something. +One of them is in line code, and deals with the extension of +a character (1-byte) to an integer. +The other one is a subroutine which handles the conversion +between 2-byte integers and 4-byte integers. +.NH 3 +The in line conversion. +.PP +The table content is: +.sp 1 +.br +.B +loc loc cii +.R +$1==1 && $2==2 | R16 | +.br +"txa" /* see if sign extension is needed */ +.br +"bpl 1f" /* there is no need for sign extension */ +.br +"lda #0FFh" /* sign extension here */ +.br +"bne 2f" /* conversion ready */ +.br +"1: lda #0\\n2:" /* no sign extension here */ +.NH 2 +Logical instructions. +.PP +A typical instruction in this group is the logical +.B +and +.R +on two 2-byte words. +The logical +.B +and +.R +on groups of more than two bytes (max 254) +is also possible and uses a library subroutine. +.NH 3 +The logical and on 2-byte groups. +.PP +The table content is: +.sp 1 +.br +.B +and +.R +$1==2 | R16 | /* one group must be on the fake stack */ +.br +"sta ARTH+1" /* temporary save of first group highbyte */ +.br +"stx ARTH" /* temporary save of first group lowbyte */ +.br +"jsr Pop" /* pop second group from the stack */ +.br +"and ARTH+1" /* logical and on highbytes */ +.br +"pha" /* temporary save the result's highbyte */ +.br +"txa" /* logical and can only be done in A */ +.br +"and ARTH" /* logical and on lowbytes */ +.br +"tax" /* restore results lowbyte */ +.br +"pla" /* restore results highbyte */ +.br +| %[1] | | /* push result onto fake stack */ +.NH 2 +Set manipulation instructions. +.PP +A typical EM pattern in this group is +.B +loc inn zeq +.R +$1>0 && $1<16 && $2==2. +This EM pattern works on sets of 16 bits. +Sets can be bigger (max 256 bytes = 2048 bits), but than a +library routine is used instead of in line code. +The table content of the above EM pattern is: +.sp 1 +.br +.B +loc inn zeq +.R +$1>0 && $1<16 && $2==2 | R16 | +.br +"ldy #$1+1" /* load Y with bit number */ +.br +"stx ARTH" /* cannot rotate X, so use zero page */ +.br +"1: lsr a" /* right shift A */ +.br +"ror ARTH" /* right rotate zero page location */ +.br +"dey" /* decrement Y */ +.br +"bne 1b" /* shift $1 times */ +.br +"bcc $1" /* no carry, so bit is zero */ +.NH 2 +Array instructions. +.PP +In this group a typical EM pattern is +.B +lae lar +.R +defined(rom(1,3)) | | | | +.B +lae +.R +$1 +.B +aar +.R +$2 +.B +loi +.R +rom(1,3). +This pattern uses the +.B +aar +.R +instruction, which is part of a typical EM pattern: +.sp 1 +.br +.B +lae aar +.R +$2==2 && rom(1,3)==2 && rom(1,1)==0 | R16 | /* registerpair AX contains +the index in the array */ +.br +"pha" /* save highbyte of index */ +.br +"txa" /* move lowbyte of index to A */ +.br +"asl a" /* shift left lowbyte == 2 times lowbyte */ +.br +"tax" /* restore lowbyte */ +.br +"pla" /* restore highbyte */ +.br +"rol a" /* rotate left highbyte == 2 times highbyte */ +.br +| %[1] | adi 2 | /* push new index, add to lowerbound array */ +.NH 2 +Compare instructions. +.PP +In this group all EM patterns are performed by calling +a subroutine. +Subroutines are used here because comparison is only +possible byte by byte. +This means a lot of code, and since compare are used frequently +a lot of in line code would be generated, and thus reducing +the space left for the software stack. +These subroutines can be found in the library. +.NH 2 +Branch instructions. +.PP +A typical branch instruction is +.B +beq. +.R +The table content for it is: +.sp 1 +.br +.B +beq +.R +| R16 | +.br +"sta BRANCH+1" /* save highbyte second operand in zero page */ +.br +"stx BRANCH" /* save lowbyte second operand in zero page */ +.br +"jsr Pop" /* pop the first operand */ +.br +"cmp BRANCH+1" /* compare the highbytes */ +.br +"bne 1f" /* there not equal so go on */ +.br +"cpx BRANCH" /* compare the lowbytes */ +.br +"beq $1\\n1:" /* lowbytes are also equal, so branch */ +.PP +Another typical instruction in this group is +.B +zeq. +.R +The table content is: +.sp 1 +.br +.B +zeq +.R +| R16 | +.br +"tay" /* move A to Y for setting testbits */ +.br +"bmi $1" /* highbyte s minus so branch */ +.br +"txa" /* move X to A for setting testbits */ +.br +"beq $1\\n1:" /* lowbyte also zero, thus branch */ +.NH 2 +Procedure call instructions. +.PP +In this group one code generation might seem a little +akward. +It is the EM instruction +.B +cai +.R +which generates a 'jsr Indir'. +This is because there is no indirect jump_subroutine in the +MCS6500. +The only solution is to store the address in zero page, and then +do a 'jsr' to a known label. +At this label there must be an indirect jump instruction, which +perform a jump to the address stored in zero page. +In this case the label is Indir, and the address is stored in +zero page at the addresses ADDR, ADDR+1. +The tabel content is: +.sp 1 +.br +.B +cai +.R +| R16 | +.br +"stx ADDR" /* store lowbyte of address in zero page */ +.br +"sta ADDR+1" /* store highbyte of address in zero page */ +.br +"jsr Indir" /* use the indirect jump */ +.br +| | | +.NH 2 +Miscellaneous instructions. +.PP +In this group, as the name suggests, there is no +typical EM instruction or EM pattern. +Most of the MCS6500 code to be generated uses a library subroutine +or is straightforward. +.DS C +.B +PERFORMANCE. +.R +.DE +.NH 0 +Introduction. +.PP +To measure the performance of the back end table some timing +tests are done. +What to time? +In this case, the execution time of several Pascal statements +are timed. +Statements in C, which have a Pascal equivalence are timed also. +The statements are timed as follows. +A test program is been written, which executes two +nested for_loops from 1 to 1.000. +Within these for_loops the statement, which is to be tested, is placed, +so the statement will be executed 1.000.000 times. +Then the same program is executed without the test statement. +The time difference between the two executions is the time +neccesairy to execute the test statement 1.000.000 times. +The total time to execute the test statement requires thus the +time difference divided by 1.000.000. +.NH 0 +Testing Pascal statements. +.PP +The next statements are tested. +.IP 1) +int1 := 0; +.IP 2) +int1 := int2 - 1; +.IP 3) +int1 := int1 + 1; +.IP 4) +int1 := icon1 - icon2; +.IP 5) +int1 := icon2 div icon1; +.IP 6) +int1 := int2 * int3; +.IP 7) +bool := (int1 < 0); +.IP 8) +bool := (int1 < 3); +.IP 9) +bool := ((int1 > 3) or (int1 < 3)) +.IP 10) +case int1 of 1: bool := false; 2: bool := true end; +.IP 11) +if int1 = 0 then int2 := 3; +.IP 12) +while int1 > 0 do int1 := int1 - 1; +.IP 13) +m := a[k]; +.IP 14) +let2 := ['a'..'c']; +.IP 15) +P3(x); +.IP 16) +dum := F3(x); +.IP 17) +s.overhead := 5400; +.IP 18) +with s do overhead := 5400; +.PP +These statement were tested in a procedure test. +.sp 1 +.br +procedure test; +.br +var i, j, ... : integer; +.br + bool : boolean; +.br + let2 : set of char; +.br +begin +.br + for i := 1 to 1000 +.br + for j := 1 to 1000 +.br + STATEMENT +.br +end; +.sp 1 +.PP +STATEMENT is one of the statements as shown above, or it is +the empty statement. +The assignment of used variables, if neccesairy, is done before +the first for_loop. +In case of the statement which uses the procedure call, statement +15, a dummy procedure is declared whose body is empty. +In case of the statement which uses the function, statement 16, +this function returns its argument. +for the timing of C statements a similar test program was +written. +.sp 1 +.br +main() +.br +{ +.br + int i, j, ...; +.br + for (i = 1; i <= 1000; i++) +.br + for (j = 1; j <= 1000; j++) +.br + STATEMENT +.br +} +.sp 1 +.NH +The results. +.PP +Here are tables with the results of the time measurments. +Times are in microseconds (10^-6). +Some statements appear twice in the tables. +In the second case an array of 200 integers was declerated +before the variable to be tested, so this variable cannot +be accessed by indirect addressing from the second local base. +This results in a larger execution time of the statement to be +tested. +The column 68000 contains the times measured on a Bleasdale, +M68000 based, computer. +The times in column pdp are measured on a DEC pdp11/44, where +the times from column 6500 come from a BBC microcomputer. +.bp +.TS +expand; +c s s s +c c c c +lw35 nw7 nw7 nw7. +Pascal timing results +statement 68000 pdp 6500 +_ +T{ +int1 := 0; +T} 4.0 5.8 16.7 + 4.0 4.2 97.8 +_ +T{ +int1 := int2 - 1; +T} 7.2 7.1 27.2 + 6.9 7.1 206.5 +_ +T{ +int1 := int1 + 1; +T} 6.9 6.8 27.2 + 6.4 6.7 106.5 +_ +T{ +int1 := icon1 + icon2; +T} 6.2 6.2 25.6 + 6.2 6.0 106.6 +_ +T{ +int1 := icon2 div icon1; +T} 14.9 14.3 372.6 + 14.9 14.7 453.7 +_ +T{ +int1 := int2 * int3; +T} 11.5 12.0 558.1 + 11.3 11.6 728.6 +_ +T{ +bool := (int1 < 0); +T} 7.2 6.9 122.8 + 7.8 8.1 453.2 +_ +T{ +bool := (int1 < 3); +T} 7.3 7.6 126.0 + 7.2 8.1 232.2 +_ +T{ +bool := ((int1 > 3) or (int1 < 3)) +T} 10.1 12.0 307.8 + 10.2 11.9 440.1 +_ +T{ +case int1 of 1: bool := false; 2: bool := true end; +T} 18.3 17.9 165.7 +_ +T{ +if int1 = 0 then int2 := 3; +T} 9.5 8.5 133.8 +_ +T{ +while int1 > 0 do int1 := int1 - 1; +T} 6.9 6.9 126.0 +_ +T{ +m := a[k]; +T} 7.2 6.8 134.3 +_ +T{ +let2 := ['a'..'c']; +T} 38.4 38.8 447.4 +_ +T{ +P3(x); +T} 18.9 18.8 180.3 +_ +T{ +dum := F3(x); +T} 26.8 27.1 343.3 +_ +T{ +s.overhead := 5400; +T} 4.6 4.1 16.7 +_ +T{ +with s do overhead := 5400; +T} 4.2 4.3 16.7 +.TE +.TS +expand; +c s s s +c c c c +lw35 nw7 nw7 nw7. +C timing results +statement 68000time pdptime 6500time +_ +T{ +int1 = 0; +T} 4.1 3.6 17.2 + 4.1 4.1 97.7 +_ +T{ +int1 = int2 - 1; +T} 6.6 6.9 27.2 + 6.1 6.5 206.4 +_ +T{ +int1 = int1 + 1; +T} 6.4 7.3 27.2 + 6.3 6.2 206.4 +_ +T{ +int1 = int2 * int3; +T} 11.4 12.3 522.6 + 9.6 10.1 721.2 +_ +T{ +int1 = (int2 < 0); +T} 7.2 7.6 126.4 + 7.4 7.7 232.5 +_ +T{ +int1 = (int2 < 3); +T} 7.0 7.5 126.0 + 7.8 7.8 232.6 +_ +T{ +int1 = ((int2 > 3) || (int2 < 3)); +T} 11.8 12.2 193.4 + 11.5 13.2 245.6 +_ +T{ +switch (int1) { case 1: int1 = 0; break; case 2: int1 = 1; break; } +T} 28.3 29.2 164.1 +_ +T{ +if (int1 == 0) int2 = 3; +T} 4.8 4.8 19.4 +_ +T{ +while (int2 > 0) int2 = int2 - 1; +T} 5.8 6.0 125.9 +_ +T{ +int2 = a[int2]; +T} 4.8 5.1 192.8 +_ +T{ +P3(int2); +T} 18.8 18.4 180.3 +_ +T{ +int2 = F3(int2); +T} 27.0 27.2 309.4 +_ +T{ +s.overhead = 5400; +T} 5.0 4.1 16.7 +.TE +.NH +Pascal statements which don't have a C equivalent. +.PP +At first, the two statements who perform an operation on constants +are left out. +These are left out while the C front end does constant folding, +while the Pascal front end doesn't. +So in C the statements int1 = icon1 + icon2; and int1 = icon1 / icont2; +will use the same amount of time since the expression is evaluated +by the front end. +The two other statements (let2 := ['a'..'c']; and +.B +with +.R +s +.B +do +.R +overhead := 5400;), aren't included in the C statement timing table, +because there constructs do not exist in C. +Although in C there can be direct bit manipulation, and thus can +be used to implement sets I have not used it here. +The +.B +with +.R +statement does not exists in C and there is nothing with the slightest +resemblance to it. +.PP +At first sight in the table , it looked if there is no much difference +in the times for the M68000 and the pdp11/44, in comparison with the +times needed by the MCS6500. +To verify this impression, I calculated the correlation coefficient +between the times of the M68000 and pdp11/44. +It turned out to be 0.997 for both the Pascal time tests and the C +time tests. +Since the correlation coefficient is near to one and the difference +between the times is small, they can be considered to be the same +as seen from the times of the MCS6500. +Then I have tried to make a grafic of the times from the M68000 and +the MCS6500. +Well, there was't any correlation to been seen, taken all the times. +The only correlation one could see, with some effort, was in the +times for the first three Pascal statements. +The two first C statements show also a correlation, which two points +always do. +.PP +Also the three Pascal statements +.B +case +.R +, +.B +if +.R +, +and +.B +while +.R +have a correlation coefficient of 0.999. +This is probably because the +.B +case +.R +statement uses a subroutine in both cases and the other two +statements +.B +if +.R +and, +.B +while +.R +generate in line code. +The last two Pascal statements use the same time, since the front +end wil generate the same EM code for both. +.PP +The independence between the rest of the test times is because +in these cases the object code for the MCS6500 uses library +subroutines, while the other processors can handle the EM code +with in line code. +.PP +It is clear that the MCS6500 is a slower device, it needs longer +execution times, the need of more library subroutines, but +there is no constant factor between it execution times and those +of other processors. +.PP +The slowing down of the MCS6500 as result of the need of a +library subroutine is illustrated by the muliplication +statement. +The MCS6500 needs a library subroutine, while the other +two processors have a machine instruction to perform the +multiply. +This results in a factor of 48.5, when the operands can be accessed +indirect by the MCS6500. +When the MCS6500 cannot access the operands indirectly the situation +is even worse. +The slight differences between the MCS6500 execution times for +Pascal statements and C statements is probably the result of the +front end, and thus beyond the scope of this discussion. +.PP +Another timing test is done in C on the statement k = i + j + 1983. +This statement is tested on many UNIX* +.FS +* UNIX is a Trademark of Bell Laboratories. +.FE +systems. +For a complete list see appendix A. +The slowest one is the IBM XT, which runs on a 8088 microprocessor. +The fasted one is the Amdahl computer. +Here is short table to illustrate the performance of the +MCS6500. +.TS +c c c +c n n. +machine short int +IBM XT 53.4 53.4 +Amdahl 0.5 0.3 +MCS6500 150.2 150.2 +.TE +The MCS6500 is three times slower than the IBM XT, but threehundred +times slower than the Amdahl. +The reason why the times on the IBM XT and the MCS6500 are the +same for short's and int's, is that most C compilers make the types +short and integer the same size on 16-bit machines. +In this project the MCS6500 is regarded as a 16-bit machine. +.NH +Length tests. +.PP +I have also compiled several programs written in Pascal and C to +see if there is a resemblance between the number of bytes generated +in the machine's language. +In the tables: +.IP length: 9 +The number of bytes of the source program. +.IP 68000: +The number of bytes of the a.out file for a M68000. +.IP pdp: +The number of bytes of the a.out file for a pdp11/44. +.IP 6500: +The number of bytes of the a.out file for a MCS6500. +.LP +These are the results: +.TS +c s s s +c c c c +n n n n. +Pascal programs +length 68000 pdp 6500 +_ +19946 14383 16090 26710 +19484 20169 20190 35416 +10849 10469 11464 18949 +273 4221 5106 7944 +1854 5807 6610 10301 +.TE +.TS +c s s s +c c c c +n n n n. +C progams +length 68000 pdp 6500 +_ +9444 6927 8234 11559 +7655 14353 18240 26251 +4775 11309 15934 19910 +639 6337 9660 12494 +.TE +.PP +In contrast to the execution times of the test statements, the +object code files sizes show a constant factor between them. +After calculating the correlation coefficient, I have calculated +the line fitted between sizes. +.FS +* x is the number of bytes +.FE +.TS +c s s +c c c +l c c. +Pascal programs +processor corr. coef. fitted line +_ +68000-pdp 0.996 +68000-6500 0.999 1.76x + 502* +pdp-6500 0.999 1.80x - 1577 +.TE +.TS +c s s +c c c +l c c. +C programs +processor corr. coef. fitted line +_ +68000-pdp 0.974 +68000-6500 0.992 1.80x + 502* +pdp-6500 0.980 1.40x - 1577 +.TE +.PP +As seen from the tables above the correlation coefficient for +Pascal programs is better than the ones for C programs. +Thus the line fits best for Pascal programs. +With the formula of the best fitted line one can now estimate +the size of the object code, which a program needs, for a MCS6500 +without having the compiler at hand. +One also can see from these formula that the object code +generated for a MCS6500 is about 1.8 times more than for the other +processors. +Since the number of bytes in the source file havily depends on the +programmer, how many spaces he or she uses, the size of the indenting +in structured programs, etc., there is no correlation between the +size of the source file and the size of the object file. +Also the use of comments has its influence on the size. +.bp +.DS C +.B +SUMMARY. +.R +.DE +.NH 0 +Summary +.PP +In this chapter some final conclusions are made. +.PP +In spite of its simplicity, the MCS6500 is strong enough to +implement a EM machine. +A serious deficy of the MCS6500 is the missing of 16-bit +general purpose registers, and especially the missing of a +16-bit stackpointer. +As pointed out before, one 16-bit register can be simulated +by a pair of 8-bit registers, in fact, the accumulator A to +hold the highbyte, and the index register X to hold the lowbyte +of the word. +By lack of a 16-bit stackpointer, zero page must be used to hold +a stackpointer and there are also two subroutines needed for +manipulating the stack (Push and Pop). +.PP +As seen at the time tests, the simple instruction set of the +MCS6500 forces the use of library subroutines. +These library subroutines increas the execution time of the +programs. +.PP +The sizes of the object code files show a strong correlation +in contrast to the execution times. +With this correlatiuon one canestimate the size of a program +if it is to be used on a MCS6500. +.bp +.NH 0 +.B +REFERENCES. +.R +.IP 1. +Haddon. B.K., and Waite, W.M. +Experience with the Universal Intermediate Language Janus. +.B +Software Practice & Experience 8 +.R +, +5 (Sept.-Oct. 1978), 601-616. +.RS +.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. +.RE +.IP 2. +Lowry, E.S., and Medlock, C.W. Object Code Optimization. +.B +Commun. ACM 12 +.R +, +(Jan. 1969), 13-22. +.RS +.PP +A classical paper on global object code optimization. +It covers data flow analysis, common subexpressions, code motion, +register allocation and other techniques. +.RE +.IP 3. +Osborn, A., Jacobson, S., and Kane, J. The Mos Technology MCS6500. +.B +An Introduction to Microcomputers , +.R +Volume II, Some Real Products (june 1977) chap. 9. +.RS +.PP +A hardware description of some real existing CPU's, such as +the Intel Z80, MCS6500, etc. is given in this book. +.RE +.IP 4. +van Staveren, H. +The table driven code generator from the Amsterdam Compiler Kit. +Vrije Universiteit, Amsterdam, (July 11, 1983). +.RS +.PP +The defining document for writing a back end table. +.RE +.IP 5. +Steel, T.B., Jr. UNCOL: The Myth and the Fact. in +.B +Ann. Rev. Auto. Prog. +.R +Goodman, R. (ed.), vol 2., (1960), 325-344. +.RS +.PP +An introduction to the UNCOL idea by its originator. +.RE +.IP 6. +Steel. T.B., Jr. A first Version of UNCOL. +.B +Proc. Western Joint Comp. Conf. +.R +, +(1961), 371-377. +.IP 7. +Tanenbaum, A.S., Stevenson, J.W., Keizer, E.G., and van Staveren, +H. +A Practical Tool Kit for Making Portable Compilers. +Informatica Rapport 74, Vrije Universiteit, Amsterdam, 1983. +.RS +.PP +An overview on the Amsterdam Compiler Kit. +.RE +.IP 8. +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. +.RS +.PP +The defining document for EM. +.RE +.IP 9. +Tanenbaum, A.S. Structured Computer Organization. +Prentice Hall. (1976). +.RS +.PP +In this book computers are described as a hierarchy of levels, +with each one performing some well-defined function. +.RE diff --git a/doc/Makefile b/doc/Makefile new file mode 100644 index 00000000..18989353 --- /dev/null +++ b/doc/Makefile @@ -0,0 +1,53 @@ +# $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) 6500.$(SUF) ncg.$(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) $? >$@ +ncg.$(SUF): ncg.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) >$@ +6500.$(SUF): 6500.doc + $(NROFF) $(MS) $? >$@ + +install cmp: + +distr: install.doc + nroff -Tlp install.doc >install.pr +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 diff --git a/doc/ack.doc b/doc/ack.doc new file mode 100644 index 00000000..3067ac96 --- /dev/null +++ b/doc/ack.doc @@ -0,0 +1,420 @@ +.\" $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 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 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. +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 diff --git a/doc/basic.doc b/doc/basic.doc new file mode 100644 index 00000000..43947d64 --- /dev/null +++ b/doc/basic.doc @@ -0,0 +1,854 @@ +.\" $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 [()] +.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 [[#][,[#]]] +.PU +To terminate I/O on a disk file. + 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 +.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 [()]= +.PU +To define and name a function that is written by the user. + must be an identifier and should be preceded by FN, +which is considered integral part of the function name. + 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 +.PU +Any undefined variable starting with the letter included in the range of +letters is declared of type unless a type declaration character +is appended. +The range of letters is a comma separated list of characters and +character ranges (-). +.NH 2 +DIM +.Sy +DIM +.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 +.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 = TO[STEP] +.br + ...... +.br +NEXT [][,...] +.PU +The FOR statements allows a series of statements to be performed +repeatedly. is used as a counter. During the first +execution pass it is assigned the value , +an arithmetic expression. After each pass the counter +is incremented with the step 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 is greater than +.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 [#][, ] +.PU +To be implemented. +.NH 2 +GOSUB...RETURN +.Sy +GOSUB +.PU +To branch unconditionally to a specified line in the program. +If 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 THEN {|} +[ELSE {|}] +.br +.Sy +IF GOTO +[ELSE {|}] +.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 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">;] +.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 #, +.PU +The purpose of the INPUT# statement is to read data items from a sequential +file and assign them to program variables. + 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]= +.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">;] +.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 #, +.PU +Read an entire line of text from a sequential file +and assign it to a string variable. +.NH 2 +LSET and RSET +.PU +To be implemented +.NH 2 +MID$ +.Sy +MID$(,n[,m])= +.PU +To replace a portion of a string with another string value. +The characters of replaces characters in +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 +.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 . +.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 GOSUB +ON GOTO +.PU +To branch to one of several specified line numbers or subroutines, based +on the result of the . 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 , +.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 [] +.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 +.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 +.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 [] +.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 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 , +.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 + ..... +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 [] +.PU +To write data at the terminal in DATA statement layout conventions. +The expressions should be separated by commas. +.NH 2 +WRITE # +.Sy +WRITE # , +.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[()] 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() 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 diff --git a/doc/cg.doc b/doc/cg.doc new file mode 100644 index 00000000..9fe39b17 --- /dev/null +++ b/doc/cg.doc @@ -0,0 +1,1857 @@ +.\" $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. diff --git a/doc/cref.doc b/doc/cref.doc new file mode 100644 index 00000000..ccbb4f80 --- /dev/null +++ b/doc/cref.doc @@ -0,0 +1,324 @@ +.\" $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.3 Keywords" +The word \fBvoid\fP is also reserved as a keyword. +.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 +pointers 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) +The size of pointers is a multiple of +(or equal to) the size of an \fIint\fP. +.PT (b) +The following relations exist for the sizes of the types +mentioned: +.br +.ti +5 +\fIchar<=short<=int<=long\fP +.PT (c) +Objects of type \fIchar\fP use one 8-bit byte of storage, +although several bytes are allocated sometimes. +.PT (d) +All sizes are in multiples of bytes. +.PT (e) +Most EM implementations use 4 bytes for floats and 8 bytes +for doubles, but exceptions to this rule occur. +.IE +.IT "4 What's in a name" +The type \fIvoid\fP is added. +Objects of type void do not exist. +Functions declared as returning void, do not return a value at all. +.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 pointers the \fIlong\fP is converted to an +\fIint\fP before the operation is performed. +.IT "7.2 Unary operators" +It is allowed to cast any expression to the type \fIvoid\fP. +.IT "8.2 Type specifiers" +One type is added to the type-specifiers: +.br +.IS +void +.IE +.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 same size as a pointer. +Conversions altering the size of the address expression are not allowed. +.IT "9.10 Return statement" +Return statements of the form: +.IS + return ; +.IE +are the only form of return statement allowed in a function of type +function returning void. +.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. +When converting pointers to an integral type or vice-versa, +the pointers is seen as an unsigned int. +.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). diff --git a/doc/em/Makefile b/doc/em/Makefile new file mode 100644 index 00000000..81cc36dc --- /dev/null +++ b/doc/em/Makefile @@ -0,0 +1,31 @@ +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 + +distr: $(FILES) itables em.i + tbl $(FILES) | nroff -Tlp >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 diff --git a/doc/em/READ_ME b/doc/em/READ_ME new file mode 100644 index 00000000..1511d1dd --- /dev/null +++ b/doc/em/READ_ME @@ -0,0 +1 @@ +Sorry, the kun macro package is not ours to distribute. diff --git a/doc/em/addend.n b/doc/em/addend.n new file mode 100644 index 00000000..05685c9f --- /dev/null +++ b/doc/em/addend.n @@ -0,0 +1,1121 @@ +.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 +LOL 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 +~~=~~an integer number in the range -32768..32767 +.ti -11 +~~=~~an offset -2**31..2**31~-~1 +.ti -11 +~~=~~an identifier +.ti -11 +~~=~~ or or + or - +.ti -11 +~~=~~integer constant, +unsigned constant, +floating point constant +.ti -11 +~~=~~string constant (surrounded by double quotes), +.ti -11 +~~=~~instruction label ('*' followed by an integer in the range +0..32767). +.ti -11 +~~=~~procedure number ('$' followed by a procedure name) +.ti -11 +~~=~~, +, + or +. +.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 ,, +.IN +Reserve bytes. + is the value used to initialize the area. + must be a multiple of the size of . + is 0 if the initialization is not strictly necessary, +1 otherwise. +.OU +.sp + HOL ,, +.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 + +.IN +Assemble global data words initialized with the constants. +.OU +.sp + ROM + +.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 [,] +.IN +Start of procedure. + is the procedure name. + 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 [] +.IN +End of Procedure. + 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 +.IN +External name. + is external to this module. +Note that may be defined in the same module. +.OU +.sp + EXP +.IN +External procedure identifier. +Note that may be defined in the same module. +.OU +.sp + INA +.IN +Internal name. + is internal to this module and must be defined in this module. +.OU +.sp + INP +.IN +Internal procedure. + 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 , +.IN +Two blocks of instructions preceding this one are +interchanged before being processed. + gives the number of lines of the first block. + gives the number of lines of the second one. +Blank and pure comment lines do not count. +.OU +.sp + MES ,* +.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,, +.IN +Use word-size and pointer size . +.OU +.br + MES 3,,, - +.IN +Indicates that a local variable is never referenced indirectly. + is offset in bytes from LB if positive +and offset from AB if negative. + gives the size of the variable. + indicates the class of the variable. +.OU +.br + MES 4,, +.IN +Number of source lines in file (for profiler). +.OU +.br + MES 5 - +.IN +Floating point used. +.OU +.br + MES 6,* - +.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 + 240 b1 Instruction label b1 (Not used for branches) + 241 b1 b2 16 bit instruction label (256*b2 + b1) + 242 b1 Global label .0-.255, with b1 being the label + 243 b1 b2 Global label .0-.32767 + with 256*b2+b1 being the label + 244 Global symbol not of the form .nnn +. \" Only the previous can occur in neutral state. + 245 b1 b2 (16 bit constant) 256*b2+b1 + 246 b1 b2 b3 b4 (32 bit constant) (256*(256*(256*b4)+b3)+b2)+b1 + 247 Global label + (possibly negative) constant + 248 Procedure name (not including $) + 249 String used in CON or ROM (no quotes) + 250 Integer constant, size bytes + 251 Unsigned constant, size bytes + 252 Floating constant, size bytes + 255 Delimiter for argument lists or + indicates absence of optional argument + +.fi +.PP +The notation consists first of a length field, and then an +arbitrary string of bytes. +The length is specified by a . +.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 byte after the +last argument to indicate the end of the list. +Group 4 uses +a 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 diff --git a/doc/em/app.nr b/doc/em/app.nr new file mode 100644 index 00000000..78e082fc --- /dev/null +++ b/doc/em/app.nr @@ -0,0 +1,488 @@ +.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 +shortie with as high order argument byte +.PT .sw +shortie with argument divided by the wordsize +.PT . +mini with as argument +.PT .W +mini with *wordsize as argument +.PE 3 + 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 diff --git a/doc/em/assem.nr b/doc/em/assem.nr new file mode 100644 index 00000000..c1987f6e --- /dev/null +++ b/doc/em/assem.nr @@ -0,0 +1,773 @@ +.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. +:\&=:integer constant (current range -2**31..2**31-1) +:\&=:data label +:\&=: or or + or - +:\&=:integer constant, unsigned constant, floating-point constant +:\&=:string constant (surrounded by double quotes), +:\&=:instruction label +::'*' followed by an integer in the range 0..32767. +:\&=:procedure number ('$' followed by a procedure name) +:\&=:, , or . +:\&=: or +<...>*:\&=: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 ,," +Reserve bytes. + is the value used to initialize the area. + must be a multiple of the size of . + is 0 if the initialization is not strictly necessary, +1 if it is. +.PT "HOL ,," +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 +" +Assemble global data words initialized with the constants. +.PT "ROM +" +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 [,]" +Start of procedure. + is the procedure name. + 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 []" +End of Procedure. + 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 " +External name. + is known, possibly defined, outside this module. +Note that may be defined in the same module. +.PT "EXP " +External procedure identifier. +Note that may be defined in the same module. +.PT "INA " +Internal name. + is internal to this module and must be defined in this module. +.PT "INP " +Internal procedure. + 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 ," +Two blocks of instructions preceding this one are +interchanged before being processed. + gives the number of lines of the first block. + gives the number of lines of the second one. +Blank and pure comment lines do not count. +.PT "MES [,]*" +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,," +Use wordsize and pointer size . +.PT "MES 3,,,," +Indicates that a local variable is never referenced indirectly. +Used to indicate that a register may be used for a specific +variable. + is offset in bytes from AB if positive +and offset from LB if negative. + gives the size of the variable. + 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 + gives the priority of the variable, +higher numbers indicate better candidates. +.PT "MES 4,," +Number of source lines in file (for profiler). +.PT "MES 5" +Floating point used. +.PT "MES 6,*" +Comment. Used to provide comments in compact assembly language. +.PT "MES 7,....." +Reserved. +.PT "MES 8,[,]..." +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," +Guarantees that no more than bytes of parameters are +accessed, either directly or indirectly. +.PT "MES 10,[,]* +This message number is reserved for the global optimizer. +It inserts these messages in its output as hints to backends. + indicates the type of hint. +.PT "MES 11" +Procedures containing this message are possible destinations of +non-local goto's with the GTO instruction. +Some backends keep locals in registers, +the locals in this procedure should not be kept in registers and +all registers containing locals of other procedures should be +saved upon entry to this procedure. +.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 + +:240:b1:Instruction label b1 (Not used for branches) +:241:b1 b2:16 bit instruction label (256*b2 + b1) +:242:b1:Global label .0-.255, with b1 being the label +:243:b1 b2:Global label .0-.32767 +:::with 256*b2+b1 being the label +:244::Global symbol not of the form .nnn +:245:b1 b2:16 bit constant +:246:b1 b2 b3 b4:32 bit constant +:247:b1 .. b8:64 bit constant +:248::Global label + (possibly negative) constant +:249::Procedure name (not including $) +:250::String used in CON or ROM (no quotes-no escapes) +:251::Integer constant, size bytes +:252::Unsigned constant, size bytes +:253::Floating constant, size bytes +:254::unused +: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 consists of a inmediatly followed by +a sequence of bytes with length . +.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 byte after the +last argument to indicate the end of the list. +Group 4 uses +an 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 diff --git a/doc/em/descr.nr b/doc/em/descr.nr new file mode 100644 index 00000000..a377e55d --- /dev/null +++ b/doc/em/descr.nr @@ -0,0 +1,163 @@ +.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 diff --git a/doc/em/dspace.nr b/doc/em/dspace.nr new file mode 100644 index 00000000..7d58dea1 --- /dev/null +++ b/doc/em/dspace.nr @@ -0,0 +1,377 @@ +.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. diff --git a/doc/em/em.i b/doc/em/em.i new file mode 100644 index 00000000..23d821c0 --- /dev/null +++ b/doc/em/em.i @@ -0,0 +1,1665 @@ +{ 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=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 s0 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 (a0) then trap(ESTACK); sp:=a end; + +procedure newlb(a:adr); +begin if (a0) 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= 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 (i0 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 tmaxsint 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 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+wsize))) then trap(ERANGE); + 2: if (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. diff --git a/doc/em/even.c b/doc/em/even.c new file mode 100644 index 00000000..645d9b6b --- /dev/null +++ b/doc/em/even.c @@ -0,0 +1,9 @@ +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") ; +} diff --git a/doc/em/exam.e b/doc/em/exam.e new file mode 100644 index 00000000..b4af8e7c --- /dev/null +++ b/doc/em/exam.e @@ -0,0 +1,178 @@ + 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 diff --git a/doc/em/exam.p b/doc/em/exam.p new file mode 100644 index 00000000..5d2e985c --- /dev/null +++ b/doc/em/exam.p @@ -0,0 +1,40 @@ + 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. diff --git a/doc/em/int/Makefile b/doc/em/int/Makefile new file mode 100644 index 00000000..54f79298 --- /dev/null +++ b/doc/em/int/Makefile @@ -0,0 +1,32 @@ +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/' 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 diff --git a/doc/em/int/READ_ME b/doc/em/int/READ_ME new file mode 100644 index 00000000..bd14ade3 --- /dev/null +++ b/doc/em/int/READ_ME @@ -0,0 +1,5 @@ +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 - diff --git a/doc/em/int/em.p b/doc/em/int/em.p new file mode 100644 index 00000000..72fcd51a --- /dev/null +++ b/doc/em/int/em.p @@ -0,0 +1,1766 @@ +# +{ 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=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 s0 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 (a0) then trap(ESTACK); sp:=a end; + +procedure newlb(a:adr); +begin if (a0) 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= 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; { Do not 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 (i0 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 minis) 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 tmaxsint 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 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+wsize))) then trap(ERANGE); + 2: if (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. diff --git a/doc/em/int/emdmp.c b/doc/em/int/emdmp.c new file mode 100644 index 00000000..60588668 --- /dev/null +++ b/doc/em/int/emdmp.c @@ -0,0 +1,210 @@ +/* + * (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 +#include + +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 +#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-- ; +} diff --git a/doc/em/intro.nr b/doc/em/intro.nr new file mode 100644 index 00000000..4b9c2667 --- /dev/null +++ b/doc/em/intro.nr @@ -0,0 +1,180 @@ +.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. diff --git a/doc/em/iotrap.nr b/doc/em/iotrap.nr new file mode 100644 index 00000000..c5a5fa2d --- /dev/null +++ b/doc/em/iotrap.nr @@ -0,0 +1,376 @@ +.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 diff --git a/doc/em/ip.awk b/doc/em/ip.awk new file mode 100644 index 00000000..53839457 --- /dev/null +++ b/doc/em/ip.awk @@ -0,0 +1,6 @@ +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" } diff --git a/doc/em/ispace.nr b/doc/em/ispace.nr new file mode 100644 index 00000000..a2c59246 --- /dev/null +++ b/doc/em/ispace.nr @@ -0,0 +1,62 @@ +.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. +(see also MES~11 in paragraph 11.1.4.4) +.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. diff --git a/doc/em/itables b/doc/em/itables new file mode 100644 index 00000000..27d9c41c --- /dev/null +++ b/doc/em/itables @@ -0,0 +1,2525 @@ +.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 \waar +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wadp +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wadp +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wasp +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbeq +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wble +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbne +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbra +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcff +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcmf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcms +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdec +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdup +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wfil +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wine +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \winn +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlae +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlal +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlal +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wldc +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wldl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlfr +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlil +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlni +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wloc +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wloe +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlof +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wloi +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlol +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlol +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlxa +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmli +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wret +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsbf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wset +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsli +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wstf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsti +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wstl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wstl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wtgt +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzeq +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzge +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzlt +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzre +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzrl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \waar +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wadi +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wads +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wand +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wass +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbgt +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbls +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wbne +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcfi +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcmf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcmi +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcmu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcom +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcsb +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wcui +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdel +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdus +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdvf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdvu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wfef +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \winl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \winn +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlar +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wldf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlfr +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlim +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlor +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wlxl +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmli +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmlu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wngf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wnop +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wret +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wrmu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wrol +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wrtt +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsbf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsbi +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsbu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsdf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wset +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsil +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsli +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wslu +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsru +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wsts +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wtge +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wxor +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzer +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzle +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wzrf +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wdch +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wexg +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wldc +.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 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsN +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsw +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wN2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wswP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmN +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \ww2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wwP2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwN +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmPo +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wwP2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wmwN +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wsP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \ww2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wswN +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wewP2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wewP2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wesP +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \wewP2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we2 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \we- +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w4 +.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 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w5 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w2 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w2 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w4 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w8 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w2 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w5 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w1 +.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 \w34 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w38 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w42 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w45 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w52 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w55 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w58 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w62 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w93 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w96 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w100 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w103 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w106 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w109 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w112 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w117 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w120 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w129 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w132 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w136 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w139 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w143 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w146 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w150 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w152 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w155 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w162 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w168 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w174 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w180 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w190 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w194 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w199 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w202 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w206 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w209 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w214 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w218 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w224 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w228 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w235 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w238 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w242 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w245 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w248 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w252 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w1 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w4 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w7 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w10 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w13 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w16 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w19 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w22 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w25 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w28 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w31 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w34 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w37 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w40 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w43 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w46 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w49 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w52 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w55 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w58 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w61 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w64 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w67 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w70 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w73 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w76 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w79 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w82 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w85 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w88 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w91 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w94 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w97 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w100 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w103 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w106 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w109 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w112 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w115 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w118 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w121 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w124 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w127 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w130 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w133 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w136 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w139 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w142 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w145 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w148 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w151 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w154 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w157 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w0 +.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 \wadf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wadp +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wads +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wasp +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wbge +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wblm +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wbra +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcal +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcif +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcmi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcsa +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdee +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdvf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \winc +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \winl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wior +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlae +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlal +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlal +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlde +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wldl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlil +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlin +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wloc +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wloc +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wloe +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlof +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wloi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlol +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlol +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlxl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wrck +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wrmi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsbi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsil +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wste +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wstf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsti +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wstl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wstl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wtlt +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzeq +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzgt +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzne +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzre +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzrl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wadf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wadi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wadu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wand +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wass +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wble +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wbls +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcai +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcfu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcmf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcms +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcmu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcsa +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcsb +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wcuu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdel +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdus +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdvi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wdvu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wfif +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \winl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wior +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlar +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wldl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlil +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlos +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlpi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wmlf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wmli +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wmon +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wngi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wrck +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wrmi +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wrmu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wror +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsar +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsbf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsbs +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsbu +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsdl +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wset +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsil +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsli +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsri +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsru +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wsts +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wtle +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wxor +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzge +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzlt +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wzrf +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wexg +.if \n(84<\n(38 .nr 84 \n(38 +.nr 38 \wlpb +.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 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsw +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsw +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wm +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \ww2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsw +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wwN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \ww2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wmwPo +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wwN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wswN +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \w- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wsw +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wwN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewP2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewP2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewP2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wewN2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we2 +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \wesP +.if \n(85<\n(38 .nr 85 \n(38 +.nr 38 \we- +.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 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w28 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w3 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w7 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w5 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w4 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w4 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w2 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.if \n(86<\n(38 .nr 86 \n(38 +.nr 38 \w1 +.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 \w35 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w39 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w43 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w50 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w53 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w56 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w59 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w64 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w94 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w97 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w101 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w104 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w107 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w110 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w113 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w118 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w121 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w130 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w133 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w137 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w140 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w144 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w148 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w151 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w153 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w156 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w166 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w169 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w175 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w188 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w191 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w196 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w200 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w203 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w207 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w210 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w215 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w219 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w225 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w233 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w236 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w239 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w243 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w246 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w249 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w253 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w2 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w5 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w8 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w11 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w14 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w17 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w20 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w23 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w26 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w29 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w32 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w35 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w38 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w41 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w44 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w47 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w50 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w53 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w56 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w59 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w62 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w65 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w68 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w71 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w74 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w77 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w80 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w83 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w86 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w89 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w92 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w95 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w98 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w101 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w104 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w107 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w110 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w113 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w116 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w119 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w122 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w125 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w128 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w131 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w134 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w137 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w140 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w143 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w146 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w149 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w152 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w155 +.if \n(87<\n(38 .nr 87 \n(38 +.nr 38 \w158 +.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 \wadi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wadp +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wand +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wbeq +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wbgt +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wblt +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wbra +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcal +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcii +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcmp +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcsb +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdel +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdvi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wine +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \winl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wior +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlal +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlal +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlar +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlde +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlfr +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlil +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlin +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wloc +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wloc +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlof +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wloi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wloi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlol +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlol +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wmlf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wret +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsar +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsdl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsil +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wste +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wstf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsti +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wstl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wteq +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wtne +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzer +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzle +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzne +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzrl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \waar +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wadf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wads +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wadu +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wasp +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wbge +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wblm +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wblt +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcal +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wciu +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcmi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcms +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcom +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcsa +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wcuf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdee +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdup +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdvf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wdvi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wfef +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wfif +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \winn +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wior +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wldc +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wldl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlil +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlos +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wlxa +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wmlf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wmlu +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wngf +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wngi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wrck +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wrmi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wrol +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wror +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsar +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsbi +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsbs +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsde +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsdl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsig +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsim +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wslu +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsri +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wsti +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wstr +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wtrp +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzer +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzgt +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzne +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wzrl +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wexg +.if \n(88<\n(38 .nr 88 \n(38 +.nr 38 \wgto +.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 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \ww2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wP2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsw +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwPo +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wswP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsw +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \w- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wsN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wmwN +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wew2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wew2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wewN2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wewN2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wewN2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wesP +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we- +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \wewP2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.if \n(89<\n(38 .nr 89 \n(38 +.nr 38 \we2 +.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 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w34 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w4 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w3 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w2 +.if \n(90<\n(38 .nr 90 \n(38 +.nr 38 \w1 +.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 \w36 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w41 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w44 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w51 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w54 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w57 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w60 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w92 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w95 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w99 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w102 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w105 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w108 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w111 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w116 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w119 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w128 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w131 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w135 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w138 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w141 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w145 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w149 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w0 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w154 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w161 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w167 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w173 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w176 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w189 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w193 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w197 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w201 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w205 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w208 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w211 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w217 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w223 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w226 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w234 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w237 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w241 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w244 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w247 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w250 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w0 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w3 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w6 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w9 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w12 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w15 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w18 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w21 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w24 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w27 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w30 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w33 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w36 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w39 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w42 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w45 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w48 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w51 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w54 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w57 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w60 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w63 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w66 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w69 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w72 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w75 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w78 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w81 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w84 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w87 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w90 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w93 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w96 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w99 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w102 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w105 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w108 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w111 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w114 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w117 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w120 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w123 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w126 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w129 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w132 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w135 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w138 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w141 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w144 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w147 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w150 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w153 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w156 +.if \n(91<\n(38 .nr 91 \n(38 +.nr 38 \w159 +.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   +.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'aar\h'|\n(41u'mwPo\h'|\n(42u'1\h'|\n(43u'34\h'|\n(44u'adf\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'35\h'|\n(48u'adi\h'|\n(49u'mwPo\h'|\n(50u'2\h'|\n(51u'36 +.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'adp\h'|\n(41u'2\h'|\n(42u'\h'|\n(43u'38\h'|\n(44u'adp\h'|\n(45u'mPo\h'|\n(46u'2\h'|\n(47u'39\h'|\n(48u'adp\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'41 +.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'adp\h'|\n(41u'sN\h'|\n(42u'1\h'|\n(43u'42\h'|\n(44u'ads\h'|\n(45u'mwPo\h'|\n(46u'1\h'|\n(47u'43\h'|\n(48u'and\h'|\n(49u'mwPo\h'|\n(50u'1\h'|\n(51u'44 +.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'asp\h'|\n(41u'mwPo\h'|\n(42u'5\h'|\n(43u'45\h'|\n(44u'asp\h'|\n(45u'swP\h'|\n(46u'1\h'|\n(47u'50\h'|\n(48u'beq\h'|\n(49u'2\h'|\n(50u'\h'|\n(51u'51 +.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'beq\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'52\h'|\n(44u'bge\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'53\h'|\n(48u'bgt\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'54 +.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'ble\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'55\h'|\n(44u'blm\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'56\h'|\n(48u'blt\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'57 +.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'bne\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'58\h'|\n(44u'bra\h'|\n(45u'2\h'|\n(46u'\h'|\n(47u'59\h'|\n(48u'bra\h'|\n(49u'sN\h'|\n(50u'2\h'|\n(51u'60 +.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'bra\h'|\n(41u'sP\h'|\n(42u'2\h'|\n(43u'62\h'|\n(44u'cal\h'|\n(45u'mPo\h'|\n(46u'28\h'|\n(47u'64\h'|\n(48u'cal\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'92 +.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'cff\h'|\n(41u'-\h'|\n(42u'\h'|\n(43u'93\h'|\n(44u'cif\h'|\n(45u'-\h'|\n(46u'\h'|\n(47u'94\h'|\n(48u'cii\h'|\n(49u'-\h'|\n(50u'\h'|\n(51u'95 +.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'cmf\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'96\h'|\n(44u'cmi\h'|\n(45u'mwPo\h'|\n(46u'2\h'|\n(47u'97\h'|\n(48u'cmp\h'|\n(49u'-\h'|\n(50u'\h'|\n(51u'99 +.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'cms\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'100\h'|\n(44u'csa\h'|\n(45u'mwPo\h'|\n(46u'1\h'|\n(47u'101\h'|\n(48u'csb\h'|\n(49u'mwPo\h'|\n(50u'1\h'|\n(51u'102 +.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'dec\h'|\n(41u'-\h'|\n(42u'\h'|\n(43u'103\h'|\n(44u'dee\h'|\n(45u'sw\h'|\n(46u'1\h'|\n(47u'104\h'|\n(48u'del\h'|\n(49u'swN\h'|\n(50u'1\h'|\n(51u'105 +.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'dup\h'|\n(41u'mwPo\h'|\n(42u'1\h'|\n(43u'106\h'|\n(44u'dvf\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'107\h'|\n(48u'dvi\h'|\n(49u'mwPo\h'|\n(50u'1\h'|\n(51u'108 +.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'fil\h'|\n(41u'2\h'|\n(42u'\h'|\n(43u'109\h'|\n(44u'inc\h'|\n(45u'-\h'|\n(46u'\h'|\n(47u'110\h'|\n(48u'ine\h'|\n(49u'w2\h'|\n(50u'\h'|\n(51u'111 +.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'ine\h'|\n(41u'sw\h'|\n(42u'1\h'|\n(43u'112\h'|\n(44u'inl\h'|\n(45u'mwN\h'|\n(46u'3\h'|\n(47u'113\h'|\n(48u'inl\h'|\n(49u'swN\h'|\n(50u'1\h'|\n(51u'116 +.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'inn\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'117\h'|\n(44u'ior\h'|\n(45u'mwPo\h'|\n(46u'1\h'|\n(47u'118\h'|\n(48u'ior\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'119 +.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'lae\h'|\n(41u'2\h'|\n(42u'\h'|\n(43u'120\h'|\n(44u'lae\h'|\n(45u'sw\h'|\n(46u'7\h'|\n(47u'121\h'|\n(48u'lal\h'|\n(49u'P2\h'|\n(50u'\h'|\n(51u'128 +.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'lal\h'|\n(41u'N2\h'|\n(42u'\h'|\n(43u'129\h'|\n(44u'lal\h'|\n(45u'm\h'|\n(46u'1\h'|\n(47u'130\h'|\n(48u'lal\h'|\n(49u'mN\h'|\n(50u'1\h'|\n(51u'131 +.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'lal\h'|\n(41u'swP\h'|\n(42u'1\h'|\n(43u'132\h'|\n(44u'lal\h'|\n(45u'swN\h'|\n(46u'2\h'|\n(47u'133\h'|\n(48u'lar\h'|\n(49u'mwPo\h'|\n(50u'1\h'|\n(51u'135 +.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'ldc\h'|\n(41u'mP\h'|\n(42u'1\h'|\n(43u'136\h'|\n(44u'lde\h'|\n(45u'w2\h'|\n(46u'\h'|\n(47u'137\h'|\n(48u'lde\h'|\n(49u'sw\h'|\n(50u'1\h'|\n(51u'138 +.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'ldl\h'|\n(41u'mP\h'|\n(42u'1\h'|\n(43u'139\h'|\n(44u'ldl\h'|\n(45u'swN\h'|\n(46u'1\h'|\n(47u'140\h'|\n(48u'lfr\h'|\n(49u'mwPo\h'|\n(50u'2\h'|\n(51u'141 +.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'lfr\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'143\h'|\n(44u'lil\h'|\n(45u'swN\h'|\n(46u'1\h'|\n(47u'144\h'|\n(48u'lil\h'|\n(49u'swP\h'|\n(50u'1\h'|\n(51u'145 +.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'lil\h'|\n(41u'mwP\h'|\n(42u'2\h'|\n(43u'146\h'|\n(44u'lin\h'|\n(45u'2\h'|\n(46u'\h'|\n(47u'148\h'|\n(48u'lin\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'149 +.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'lni\h'|\n(41u'-\h'|\n(42u'\h'|\n(43u'150\h'|\n(44u'loc\h'|\n(45u'2\h'|\n(46u'\h'|\n(47u'151\h'|\n(48u'loc\h'|\n(49u'mP\h'|\n(50u'34\h'|\n(51u'0 +.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'loc\h'|\n(41u'mN\h'|\n(42u'1\h'|\n(43u'152\h'|\n(44u'loc\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'153\h'|\n(48u'loc\h'|\n(49u'sN\h'|\n(50u'1\h'|\n(51u'154 +.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'loe\h'|\n(41u'w2\h'|\n(42u'\h'|\n(43u'155\h'|\n(44u'loe\h'|\n(45u'sw\h'|\n(46u'5\h'|\n(47u'156\h'|\n(48u'lof\h'|\n(49u'2\h'|\n(50u'\h'|\n(51u'161 +.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'lof\h'|\n(41u'mwPo\h'|\n(42u'4\h'|\n(43u'162\h'|\n(44u'lof\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'166\h'|\n(48u'loi\h'|\n(49u'2\h'|\n(50u'\h'|\n(51u'167 +.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'loi\h'|\n(41u'mPo\h'|\n(42u'1\h'|\n(43u'168\h'|\n(44u'loi\h'|\n(45u'mwPo\h'|\n(46u'4\h'|\n(47u'169\h'|\n(48u'loi\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'173 +.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'lol\h'|\n(41u'wP2\h'|\n(42u'\h'|\n(43u'174\h'|\n(44u'lol\h'|\n(45u'wN2\h'|\n(46u'\h'|\n(47u'175\h'|\n(48u'lol\h'|\n(49u'mwP\h'|\n(50u'4\h'|\n(51u'176 +.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'lol\h'|\n(41u'mwN\h'|\n(42u'8\h'|\n(43u'180\h'|\n(44u'lol\h'|\n(45u'swP\h'|\n(46u'1\h'|\n(47u'188\h'|\n(48u'lol\h'|\n(49u'swN\h'|\n(50u'1\h'|\n(51u'189 +.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'lxa\h'|\n(41u'mPo\h'|\n(42u'1\h'|\n(43u'190\h'|\n(44u'lxl\h'|\n(45u'mPo\h'|\n(46u'2\h'|\n(47u'191\h'|\n(48u'mlf\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'193 +.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'mli\h'|\n(41u'mwPo\h'|\n(42u'2\h'|\n(43u'194\h'|\n(44u'rck\h'|\n(45u'mwPo\h'|\n(46u'1\h'|\n(47u'196\h'|\n(48u'ret\h'|\n(49u'mwP\h'|\n(50u'2\h'|\n(51u'197 +.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'ret\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'199\h'|\n(44u'rmi\h'|\n(45u'mwPo\h'|\n(46u'1\h'|\n(47u'200\h'|\n(48u'sar\h'|\n(49u'mwPo\h'|\n(50u'1\h'|\n(51u'201 +.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'sbf\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'202\h'|\n(44u'sbi\h'|\n(45u'mwPo\h'|\n(46u'2\h'|\n(47u'203\h'|\n(48u'sdl\h'|\n(49u'swN\h'|\n(50u'1\h'|\n(51u'205 +.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'set\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'206\h'|\n(44u'sil\h'|\n(45u'swN\h'|\n(46u'1\h'|\n(47u'207\h'|\n(48u'sil\h'|\n(49u'swP\h'|\n(50u'1\h'|\n(51u'208 +.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'sli\h'|\n(41u'mwPo\h'|\n(42u'1\h'|\n(43u'209\h'|\n(44u'ste\h'|\n(45u'w2\h'|\n(46u'\h'|\n(47u'210\h'|\n(48u'ste\h'|\n(49u'sw\h'|\n(50u'3\h'|\n(51u'211 +.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'stf\h'|\n(41u'2\h'|\n(42u'\h'|\n(43u'214\h'|\n(44u'stf\h'|\n(45u'mwPo\h'|\n(46u'2\h'|\n(47u'215\h'|\n(48u'stf\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'217 +.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'sti\h'|\n(41u'mPo\h'|\n(42u'1\h'|\n(43u'218\h'|\n(44u'sti\h'|\n(45u'mwPo\h'|\n(46u'4\h'|\n(47u'219\h'|\n(48u'sti\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'223 +.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'stl\h'|\n(41u'wP2\h'|\n(42u'\h'|\n(43u'224\h'|\n(44u'stl\h'|\n(45u'wN2\h'|\n(46u'\h'|\n(47u'225\h'|\n(48u'stl\h'|\n(49u'mwP\h'|\n(50u'2\h'|\n(51u'226 +.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'stl\h'|\n(41u'mwN\h'|\n(42u'5\h'|\n(43u'228\h'|\n(44u'stl\h'|\n(45u'swN\h'|\n(46u'1\h'|\n(47u'233\h'|\n(48u'teq\h'|\n(49u'-\h'|\n(50u'\h'|\n(51u'234 +.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'tgt\h'|\n(41u'-\h'|\n(42u'\h'|\n(43u'235\h'|\n(44u'tlt\h'|\n(45u'-\h'|\n(46u'\h'|\n(47u'236\h'|\n(48u'tne\h'|\n(49u'-\h'|\n(50u'\h'|\n(51u'237 +.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'zeq\h'|\n(41u'2\h'|\n(42u'\h'|\n(43u'238\h'|\n(44u'zeq\h'|\n(45u'sP\h'|\n(46u'2\h'|\n(47u'239\h'|\n(48u'zer\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'241 +.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'zge\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'242\h'|\n(44u'zgt\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'243\h'|\n(48u'zle\h'|\n(49u'sP\h'|\n(50u'1\h'|\n(51u'244 +.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'zlt\h'|\n(41u'sP\h'|\n(42u'1\h'|\n(43u'245\h'|\n(44u'zne\h'|\n(45u'sP\h'|\n(46u'1\h'|\n(47u'246\h'|\n(48u'zne\h'|\n(49u'sN\h'|\n(50u'1\h'|\n(51u'247 +.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'zre\h'|\n(41u'w2\h'|\n(42u'\h'|\n(43u'248\h'|\n(44u'zre\h'|\n(45u'sw\h'|\n(46u'1\h'|\n(47u'249\h'|\n(48u'zrl\h'|\n(49u'mwN\h'|\n(50u'2\h'|\n(51u'250 +.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'zrl\h'|\n(41u'swN\h'|\n(42u'1\h'|\n(43u'252\h'|\n(44u'zrl\h'|\n(45u'wN2\h'|\n(46u'\h'|\n(47u'253\h'|\n(48u'aar\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'0 +.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'aar\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'1\h'|\n(44u'adf\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'2\h'|\n(48u'adf\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'3 +.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'adi\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'4\h'|\n(44u'adi\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'5\h'|\n(48u'ads\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'6 +.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'ads\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'7\h'|\n(44u'adu\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'8\h'|\n(48u'adu\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'9 +.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'and\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'10\h'|\n(44u'and\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'11\h'|\n(48u'asp\h'|\n(49u'ew2\h'|\n(50u'\h'|\n(51u'12 +.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'ass\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'13\h'|\n(44u'ass\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'14\h'|\n(48u'bge\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'15 +.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'bgt\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'16\h'|\n(44u'ble\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'17\h'|\n(48u'blm\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'18 +.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'bls\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'19\h'|\n(44u'bls\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'20\h'|\n(48u'blt\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'21 +.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'bne\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'22\h'|\n(44u'cai\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'23\h'|\n(48u'cal\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'24 +.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'cfi\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'25\h'|\n(44u'cfu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'26\h'|\n(48u'ciu\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'27 +.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'cmf\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'28\h'|\n(44u'cmf\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'29\h'|\n(48u'cmi\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'30 +.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'cmi\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'31\h'|\n(44u'cms\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'32\h'|\n(48u'cms\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'33 +.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'cmu\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'34\h'|\n(44u'cmu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'35\h'|\n(48u'com\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'36 +.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'com\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'37\h'|\n(44u'csa\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'38\h'|\n(48u'csa\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'39 +.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'csb\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'40\h'|\n(44u'csb\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'41\h'|\n(48u'cuf\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'42 +.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'cui\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'43\h'|\n(44u'cuu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'44\h'|\n(48u'dee\h'|\n(49u'ew2\h'|\n(50u'\h'|\n(51u'45 +.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'del\h'|\n(41u'ewP2\h'|\n(42u'\h'|\n(43u'46\h'|\n(44u'del\h'|\n(45u'ewN2\h'|\n(46u'\h'|\n(47u'47\h'|\n(48u'dup\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'48 +.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'dus\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'49\h'|\n(44u'dus\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'50\h'|\n(48u'dvf\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'51 +.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'dvf\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'52\h'|\n(44u'dvi\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'53\h'|\n(48u'dvi\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'54 +.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'dvu\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'55\h'|\n(44u'dvu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'56\h'|\n(48u'fef\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'57 +.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'fef\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'58\h'|\n(44u'fif\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'59\h'|\n(48u'fif\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'60 +.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'inl\h'|\n(41u'ewP2\h'|\n(42u'\h'|\n(43u'61\h'|\n(44u'inl\h'|\n(45u'ewN2\h'|\n(46u'\h'|\n(47u'62\h'|\n(48u'inn\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'63 +.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'inn\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'64\h'|\n(44u'ior\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'65\h'|\n(48u'ior\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'66 +.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'lar\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'67\h'|\n(44u'lar\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'68\h'|\n(48u'ldc\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'69 +.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'ldf\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'70\h'|\n(44u'ldl\h'|\n(45u'ewP2\h'|\n(46u'\h'|\n(47u'71\h'|\n(48u'ldl\h'|\n(49u'ewN2\h'|\n(50u'\h'|\n(51u'72 +.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'lfr\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'73\h'|\n(44u'lil\h'|\n(45u'ewP2\h'|\n(46u'\h'|\n(47u'74\h'|\n(48u'lil\h'|\n(49u'ewN2\h'|\n(50u'\h'|\n(51u'75 +.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'lim\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'76\h'|\n(44u'los\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'77\h'|\n(48u'los\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'78 +.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'lor\h'|\n(41u'esP\h'|\n(42u'1\h'|\n(43u'79\h'|\n(44u'lpi\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'80\h'|\n(48u'lxa\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'81 +.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'lxl\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'82\h'|\n(44u'mlf\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'83\h'|\n(48u'mlf\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'84 +.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'mli\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'85\h'|\n(44u'mli\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'86\h'|\n(48u'mlu\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'87 +.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'mlu\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'88\h'|\n(44u'mon\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'89\h'|\n(48u'ngf\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'90 +.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'ngf\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'91\h'|\n(44u'ngi\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'92\h'|\n(48u'ngi\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'93 +.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'nop\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'94\h'|\n(44u'rck\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'95\h'|\n(48u'rck\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'96 +.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'ret\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'97\h'|\n(44u'rmi\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'98\h'|\n(48u'rmi\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'99 +.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'rmu\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'100\h'|\n(44u'rmu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'101\h'|\n(48u'rol\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'102 +.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'rol\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'103\h'|\n(44u'ror\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'104\h'|\n(48u'ror\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'105 +.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'rtt\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'106\h'|\n(44u'sar\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'107\h'|\n(48u'sar\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'108 +.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'sbf\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'109\h'|\n(44u'sbf\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'110\h'|\n(48u'sbi\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'111 +.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'sbi\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'112\h'|\n(44u'sbs\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'113\h'|\n(48u'sbs\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'114 +.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'sbu\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'115\h'|\n(44u'sbu\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'116\h'|\n(48u'sde\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'117 +.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'sdf\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'118\h'|\n(44u'sdl\h'|\n(45u'ewP2\h'|\n(46u'\h'|\n(47u'119\h'|\n(48u'sdl\h'|\n(49u'ewN2\h'|\n(50u'\h'|\n(51u'120 +.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'set\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'121\h'|\n(44u'set\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'122\h'|\n(48u'sig\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'123 +.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'sil\h'|\n(41u'ewP2\h'|\n(42u'\h'|\n(43u'124\h'|\n(44u'sil\h'|\n(45u'ewN2\h'|\n(46u'\h'|\n(47u'125\h'|\n(48u'sim\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'126 +.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'sli\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'127\h'|\n(44u'sli\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'128\h'|\n(48u'slu\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'129 +.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'slu\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'130\h'|\n(44u'sri\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'131\h'|\n(48u'sri\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'132 +.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'sru\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'133\h'|\n(44u'sru\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'134\h'|\n(48u'sti\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'135 +.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'sts\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'136\h'|\n(44u'sts\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'137\h'|\n(48u'str\h'|\n(49u'esP\h'|\n(50u'1\h'|\n(51u'138 +.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'tge\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'139\h'|\n(44u'tle\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'140\h'|\n(48u'trp\h'|\n(49u'e-\h'|\n(50u'\h'|\n(51u'141 +.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'xor\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'142\h'|\n(44u'xor\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'143\h'|\n(48u'zer\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'144 +.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'zer\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'145\h'|\n(44u'zge\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'146\h'|\n(48u'zgt\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'147 +.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'zle\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'148\h'|\n(44u'zlt\h'|\n(45u'e2\h'|\n(46u'\h'|\n(47u'149\h'|\n(48u'zne\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'150 +.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'zrf\h'|\n(41u'e2\h'|\n(42u'\h'|\n(43u'151\h'|\n(44u'zrf\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'152\h'|\n(48u'zrl\h'|\n(49u'ewP2\h'|\n(50u'\h'|\n(51u'153 +.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'dch\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'154\h'|\n(44u'exg\h'|\n(45u'esP\h'|\n(46u'1\h'|\n(47u'155\h'|\n(48u'exg\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'156 +.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'exg\h'|\n(41u'e-\h'|\n(42u'\h'|\n(43u'157\h'|\n(44u'lpb\h'|\n(45u'e-\h'|\n(46u'\h'|\n(47u'158\h'|\n(48u'gto\h'|\n(49u'e2\h'|\n(50u'\h'|\n(51u'159 +.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'ldc\h'|\n(41u'4\h'|\n(42u'\h'|\n(43u'0\h'|\n(44u'\h'|\n(45u'\h'|\n(46u'\h'|\n(47u'\h'|\n(48u'\h'|\n(49u'\h'|\n(50u'\h'|\n(51u' +.fc +.nr T. 1 +.T# 1 +.35 +.TE +.if \n-(b.=0 .nr c. \n(.c-\n(d.-102 diff --git a/doc/em/mach.nr b/doc/em/mach.nr new file mode 100644 index 00000000..1374eff3 --- /dev/null +++ b/doc/em/mach.nr @@ -0,0 +1,390 @@ +.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. diff --git a/doc/em/macr.nr b/doc/em/macr.nr new file mode 100644 index 00000000..14c628c4 --- /dev/null +++ b/doc/em/macr.nr @@ -0,0 +1,16 @@ +.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 diff --git a/doc/em/mapping.nr b/doc/em/mapping.nr new file mode 100644 index 00000000..fbd0ff11 --- /dev/null +++ b/doc/em/mapping.nr @@ -0,0 +1,245 @@ +.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. diff --git a/doc/em/mem.nr b/doc/em/mem.nr new file mode 100644 index 00000000..c6ca14dc --- /dev/null +++ b/doc/em/mem.nr @@ -0,0 +1,80 @@ +.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. diff --git a/doc/em/print b/doc/em/print new file mode 100755 index 00000000..a9b9b033 --- /dev/null +++ b/doc/em/print @@ -0,0 +1,5 @@ + +case $# in +1) make "$1".t ; ntlp "$1".t^lpr ;; +*) echo $0 heeft een argument nodig ;; +esac diff --git a/doc/em/show b/doc/em/show new file mode 100755 index 00000000..f60e8e46 --- /dev/null +++ b/doc/em/show @@ -0,0 +1,4 @@ +case $# in +1) make $1.t ; ntout $1.t ;; +*) echo $0 heeft een argument nodig ;; +esac diff --git a/doc/em/title.nr b/doc/em/title.nr new file mode 100644 index 00000000..348d55db --- /dev/null +++ b/doc/em/title.nr @@ -0,0 +1,38 @@ +.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 diff --git a/doc/em/types.nr b/doc/em/types.nr new file mode 100644 index 00000000..c014a78a --- /dev/null +++ b/doc/em/types.nr @@ -0,0 +1,130 @@ +.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. diff --git a/doc/install.doc b/doc/install.doc new file mode 100644 index 00000000..f9edb7e1 --- /dev/null +++ b/doc/install.doc @@ -0,0 +1,621 @@ +.\" $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. diff --git a/doc/ncg.doc b/doc/ncg.doc new file mode 100644 index 00000000..4abfdbad --- /dev/null +++ b/doc/ncg.doc @@ -0,0 +1,2944 @@ +.\" $Header$ +.RP +.ND +.TL +The table driven code generator +.br +from the +.br +Amsterdam Compiler Kit +.br +Second Revised Edition +.AU +Hans van Staveren +.AI +Dept. of Mathematics and Computer Science +Vrije Universiteit +Amsterdam, The Netherlands +.AB +The Amsterdam Compiler Kit is a collection of tools +designed to help automate the process of compiler building. +Part of it is a table driven code generator, +called +.I cg , +and a program to check and translate machine description +tables called +.I cgg . +This document provides a description of the internal workings of +.I cg , +and a description of syntax and semantics of the driving table. +This is required reading for those wishing to write a new 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 the machine table will be described after which +some light is shed onto +the internal workings of the code generator. +.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 +What has changed since version 1 ? +.PP +This chapter can be skipped by anyone not familiar with the first version. +It is not needed to understand the current version. +.PP +This paper describes the second version of the code generator system. +Although the code generator itself is for the main part unchanged, +the table format has been drastically redesigned and the opportunities +to make faulty tables are reduced. +The format is now aesthaticly more pleasing (according to \fIme\fP that is), +mainly because the previous version was designed for one line code rules, +which did not work out that way. +.PP +The `SCRATCH' property is now automatically generated by +.I cgg , +.I erase +and +.I setcc +calls and their ilk are now no longer needed +(read: can no longer be forgotten) +and all this because the table now +.I knows +what the machine instructions look like and what arguments they +destroy. +.PP +Checks are now made for register types, so it is no longer possible +to generate a `regind2' token with a floating point register as a base. +In general, if the instructions of the machine are correctly defined, +it is no longer possible to generate code that does not assemble, +which of course does not mean that it is not possible to generate +assembly code that does not do what was intended! +.PP +Checks are made now for missing moves, tests, coercions, etc. +There is a form of procedure call now to reduce table size: +it is no longer necessary to write the code for conditional +instructions six times. +.PP +The inreg() pseudo-function returns other results!! +.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 stack +of the compiled program 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 `fake stack' 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 fake stack as a logical extension of the real +stack the compiled program will have when run. +Alternatively one can think of the real stack as an infinite extension +at the bottom of the fake stack. +Both ways, the concatenation of the real stack and the fake stack +will be the stack as it would have been on a real EM machine (see figure). +.KF +.DS L +.ta 8 16 24 32 40 48 56 64 72 + EM machine target machine + + | | | | + | | | | + | | | | + | | | | + | | | real stack | + | | | | | + | | | | | growing + | EM stack | | | | + | | |_______________| \e|/ + | | | | + | | | | + | | | | + | | | fake stack | + | | | | + |_______________| |_______________| + + +.I + Relation between EM stack, real stack and fake stack. +.R +.DE +.KE +During code generation tokens will be kept on the fake stack 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 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 pushed tokens will be pushed also, +so the fake stack will not contain holes. +.PP +The information about the machine that +.I cg +needs has to be given in a machine description table, +with as a major part a list of code rules telling +.I cg +what to do when certain EM-instructions occur +with certain tokens on the fake stack. +Not all possible fake stack possibilities have to be given of course, +there is a possibility for providing rewriting rules, or +.I coercions +as they are called in this document. +.PP +The main loop of +.I cg +is: +.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. +Process any pseudo-instructions found. +.IP 2) +Select one of the possibly many stack patterns that go with this +EM pattern on the basis of heuristics, look ahead or both. +The cost fields provided in the token definitions and +instruction definitions are used +to compute costs during look ahead. +.IP 3) +Force the current fake stack contents to match the pattern. +This may involve +copying tokens to registers, making dummy transformations, e.g. to +transform a `local' into an `indexed from register' or might even +cause the move of the complete fake stack contents to the real stack +and then back into registers if no suitable coercions +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 fake stack 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 look ahead decisions +are based on a linear combination of these. +The code generator calls on itself recursively during look ahead, +and the recursive incarnations return the costs they made. +The costs the top-level code generator makes is of course irrelevant. +.PP +The table that drives +.I cg +is not read in every time, +but instead is used at compile time +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. +.PP +Part of the information needed is not easily expressed in this table +format and must be supplied in two separate files, +mach.h and mach.c. +Their contents are described later in this document. +.NH 1 +Register variables +.PP +If the machine has more than enough registers to generate code with, +it is possible to reserve some of them for use as register variables. +If it has not, you can skip this section and ignore any references +to register variables in the rest of this document. +.PP +The front ends generate messages to the back ends telling them which +local variables could go into registers. +The information given is the offset of the local, it's size and type +and a scoring number, roughly the number of times it occurs. +.PP +The decision which variable to put in which register is taken by the +machine independent part of +.I cg +with the help of a scoring function provided by the table writer in mach.c. +The types of variables known are +.IP reg_any 12 +Just a variable of some integer type. +Nothing special known about it. +.IP reg_float +A floating point variable. +.IP reg_loop +A loop control variable. +.IP reg_pointer +A pointer variable. +Usually they are better candidates to put in registers. +.PP +If you use register variables in your table you must supply +more functions in mach.c. +These functions are explained later. +.NH 1 +Description of the machine table +.PP +The machine description table consists of the +concatenation of the following sections: +.IP 1) +Constant definitions +.IP 2) +Property definitions +.IP 3) +Register definitions +.IP 4) +Token definitions +.IP 5) +Set definitions +.IP 6) +Instruction definitions +.IP 7) +Move definitions +.IP 8) +Test definitions +.IP 9) +Stack definitions +.IP 10) +Coercions +.IP 11) +Code rules +.PP +This is the order in the table +but the descriptions in this document will use a slightly different +order. +All sections except the first start with an uppercase header word. +Examples may be given in early stages that use knowledge that is explained +in a later stage. +If something is not clear the first time, please read on. +All will clear up in a couple of pages. +.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. +Here is a list of reserved words; all of these are unavailable as identifiers. +.DS L +.ta 14 28 42 56 +ADDR STACK from reg_any test +COERCIONS STACKINGRULES gen reg_float to +INSTRUCTIONS TESTS highw reg_loop ufit +INT TIMEFACTOR inreg reg_pointer uses +MOVES TOKENS kills regvar with +PATTERNS call leaving return yields +PROPERTIES cost loww reusing +REGISTERS defined move rom +SETS exact pat samesign +SIZEFACTOR example proc sfit +.DE +C style comments are accepted. +.DS +/* this is a comment */ +.DE +If the standard constant facility is not enough the C-preprocessor can +be used to enhance the table format. +.PP +Integers in the table have the normal C-style syntax. +Decimal by default, octal when preceded by a 0 +and hexadecimal when preceded by 0x. +.NH 2 +Constant section +.PP +In the first part of the table some constants can be defined, +most with the syntax +.DS +NAME=value +.DE +value being an integer or string. +Three constants must be defined here: +.IP EM_WSIZE 10 +Number of bytes in a machine word. +This is the number of bytes +a \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 +Other constants can be defined here to be used as mnemonics +later in the table. +.PP +Optional is the definition of a printformat for integers in the code file. +This is given as +.DS +FORMAT = string +.DE +The string must be a valid printf(III) format, +and defaults to "%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. +.PP +Tables under control of programs like +.I sccs +or +.I rcs +can put their id-string here, for example +.DS +rcsid="$Header$" +.DE +These strings, like all strings in the table, will eventually +end up in the binary code generator produced. +.PP +Optionally one can give the factors with which the size and time +parts of the cost vector have to be multiplied to ensure they have the +same order of magnitude. +This can be done as +.DS +SIZEFACTOR = C\d3\u/C\d4\u +TIMEFACTOR = C\d1\u/C\d2\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 code sequences where one has +cost (10,4) and the other has cost (8,6). +See also the description of the cost field below. +.NH 2 +Property definition +.PP +This part of the table defines the list of properties that can be used +to differentiate between register classes. +It consists of a list of user-defined +identifiers optionally followed by the size +of the property in parentheses, default EM_WSIZE. +Example for the PDP-11: +.DS +.ta 8 16 24 32 40 +PROPERTIES /* The header word for this section */ + +GENREG /* All PDP registers */ +REG /* Normal registers (allocatable) */ +ODDREG /* All odd registers (allocatable) */ +REGPAIR(4) /* Register pairs for division */ +FLTREG(4) /* Floating point registers */ +DBLREG(8) /* Same, double precision */ +GENFREG(4) /* generic floating point */ +GENDREG(8) /* Same, double precision */ +FLTREGPAIR(8) /* register pair for modf */ +DBLREGPAIR(16) /* Same, double precision */ +LOCALBASE /* Guess what */ +STACKPOINTER +PROGRAMCOUNTER +.DE +Registers are allocated by asking for a property, +so if for some reason in later parts of the table +one particular register must be allocated it +has to have a unique property. +.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. +Syntax: +.DS + : REGISTERS + : ':' '.' + : ident [ '(' string ')' ] [ '=' ident [ '+' ident ] ] +.DE +Example for the PDP-11: +.DS L +.ta 8 16 24 32 40 48 56 64 +REGISTERS + +r0,r2,r4 : GENREG,REG. +r1,r3 : GENREG,REG,ODDREG. +r01("r0")=r0+r1 : REGPAIR. +fr0("r0"),fr1("r1"),fr2("r2"),fr3("r3") : GENFREG,FLTREG. +dr0("r0")=fr0,dr1("r1")=fr1, + dr2("r2")=fr2,dr3("r3")=fr3 : GENDREG,DBLREG. +fr01("r0")=fr0+fr1,fr23("r2")=fr2+fr3 : FLTREGPAIR. +dr01("r0")=dr0+dr1,dr23("r2")=dr2+dr3 : DBLREGPAIR. +lb("r5") : GENREG,LOCALBASE. +sp : GENREG,STACKPOINTER. +pc : GENREG,PROGRAMCOUNTER. +.DE +.PP +The names in the left hand lists are names of registers as used +in the table. +They can optionally be followed by a string in parentheses, +their name as far as the assembler is concerned. +The default assembler name is the same as the table name. +A name can also be followed by +.DS += othername +.DE +or +.DS += othername + othername +.DE +which says that the register is composed of the parts +after the '=' sign. +The identifiers at the right hand side of the lists are +names of properties. +The end of each register definition is a period. +.PP +It might seem wise to list 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, +especially since no use can be made of that instruction anyway. +Every extra property means the register set 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. +So try to keep the number of different register classes to a minimum. +When faced with the choice between two possible code rules +for a nonfrequent EM sequence, +one being elegant but requiring an extra property, +and the other less elegant, +elegance should probably loose. +.PP +Tables that implement register variables must mark registers to be used +for variable storage here by following the list of properties by one +of the following: +.DS +regvar \fIor\fP regvar(reg_any) +regvar(reg_loop) +regvar(reg_pointer) +regvar(reg_float) +.DE +meaning they are candidates for that type of variable. +All register variables of one type must be of the same size, +and they may have no subregisters. +Such registers are not available for normal code generation. +.NH 2 +Stack token definition +.PP +The next part describes all possible tokens that can reside on +the fake stack during code generation. +Attributes of a token are described as a C struct declaration; +this is followed by the size of the token in bytes, +optionally followed by the cost of the token when used as an addressing mode +and the format to be used on output. +.PP +In general, when writing a table, it is not wise to try +to think of all necessary tokens in advance. +While writing the necessity or advisability for some token +will be seen and it can then be added together with the +stacking rules and coercions needed. +.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 + +const2 = { INT num; } 2 cost(2,300) "$" num . +addr_local = { INT ind; } 2 . +addr_external = { ADDR off; } 2 "$" off. + +regdef2 = { GENREG reg; } 2 "*" reg. +regind2 = { GENREG reg; ADDR off; } 2 off "(" reg ")" . +reginddef2 = { GENREG reg; ADDR off; } 2 "*" off "(" reg ")" . +regconst2 = { GENREG reg; ADDR off; } 2 . +relative2 = { ADDR off; } 2 off . +reldef2 = { ADDR off; } 2 "*" off. +.DE +.PP +Types allowed in the struct are ADDR, INT and all register properties. +The type ADDR means a string and an integer, +which is output as string+integer, +and arithmetic on mixed ADDR and INT is possible. +This is the right mode for anything that can be an +assembler address expression. +The type of the register in the token is strict. +At any assignment of an expression of type register to a token attribute +of type register +.I cgg +will check if the set of possible results from the expression is a subset +of the set of permissible values for the token attribute. +.PP +The cost-field is made up by the word +.I cost +followed by two numbers in parentheses, the size and timecosts +of this token when output in the code file. +If omitted, zero cost is assumed. +While generating code, +.I cg +keeps track of a linear combination of these costs together +with the costs of the instructions itself which we will see later. +The coefficients of this linear combination are influenced +by two things: +.IP 1) +The SIZEFACTOR and TIMEFACTOR constants, +as mentioned above. +.IP 2) +A run time option to +.I cg +that can adjust the time/space tradeoff to all positions +from 100% time to 100% space. +.LP +By supplying different code rules in certain situations +it is possible to get a code generator that can adjust it's +code to the need of the moment. +This is probably most useful with small machines, +experience has shown that on the larger micro's and mini's +the difference between time-optimal and space-optimal code +is often small. +.PP +The printformat consists of a list of strings intermixed with +attributes from the token. +Strings are output literally, attributes are printed according +to their type and value. +Tokens without a printformat should never be output, +and +.I cgg +checks for this. +.PP +Notice that tokens need not correspond to addressing modes; +the regconst2 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 regconst2 token is needed as part of the path +.DS +REG -> regconst2 -> regind2 +.DE +of which the first and the last "exist" and the middle is needed +only as an intermediate step. +.PP +Tokens with name `LOCAL' or `DLOCAL' are a special case when +register variables are used, this is explained further in the +section on token descriptions. +.NH 2 +Sets +.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 set +in the remainder of the table, +but for clarity it is usually better not to. +.LP +Example for the PDP-11 (incomplete): +.DS L +.ta 8 16 24 32 40 48 56 64 +SETS + +src2 = GENREG + regdef2 + regind2 + reginddef2 + relative2 + + reldef2 + addr_external + const2 + LOCAL + ILOCAL + + autodec + autoinc . +dst2 = src2 - ( const2 + addr_external ) . +xsrc2 = src2 + ftoint . +src1 = regdef1 + regind1 + reginddef1 + relative1 + reldef1 . +dst1 = src1 . +src1or2 = src1 + src2 . +src4 = relative4 + regdef4 + DLOCAL + regind4 . +dst4 = src4 . +.DE +Permissible in the set construction are all the usual set operators, i.e. +.IP + +set union +.IP - +set difference +.IP * +set intersection +.PP +Normal operator priorities apply, and parentheses can be +used. +Every token identifier is also a set identifier +denoting the singleton collection of tokens containing +just itself. +Every register property as defined above is also a set +matching all registers with that property. +The standard set identifier ALL denotes the collection of +all tokens. +.NH 2 +Instruction definitions +.PP +In the next part of the table the instructions for the machine +are declared together with information about their operands. +Example for the PDP-11(very incomplete): +.DS +.ta 8 16 24 32 40 48 56 64 +INSTRUCTIONS +/* default cost */ + +cost(2,600) + +/* Normal instructions */ + +adc dst2:rw:cc . +add src2:ro,dst2:rw:cc cost(2,450). +ash src2:ro,REG:rw:cc . +ashc src2:ro,REGPAIR+ODDREG:rw . +asl dst2:rw:cc . +asr dst2:rw:cc . +bhis "bcc" label . + +/* floating point instructions */ + +movf "ldf" fsrc,freg . +movf "stf" freg,fdst . +.DE +As the examples show an instruction definition consists of the name +of the instruction, +optionally followed by an assembler mnemonic in +quotes-default is the name itself-and then +a list of operands, +optionally followed by the cost and then a period. +If the cost is omitted the cost just after the word +INSTRUCTIONS is assumed, +if that is also omitted the cost is zero. +The cost must be known by +.I cg +of course if it has multiple +code generation paths to choose from. +.PP +For each operand we have the set of possible token values, +followed by a qualifier that can be +.IP :ro +signifies that this operand is read only, +so it can be replaced by a register with the same contents +if available. +.IP :rw +signifies that the operand is read-write +.IP :wo +signifies that the operand is write only. +.IP :cc +says that after the instruction is finished, the condition codes +are set to this operand. +If none of the operands have the :cc qualifier set, +.I cg +will assume that condition codes were unaffected +(but see below). +.PP +The first three qualifiers are of course mutually exclusive. +The :ro qualifier does not cause any special action in the current +implementation, and the :wo and :rw qualifiers are treated equal. +It must be recommended however to be precise in the specifications, +since later enhancements to the code generator might use them. +.PP +As the last examples show it is not necessary to give one definition +for an instruction. +There are machines that have very unorthogonal instruction sets, +in fact most of them do, +and it is possible to declare each possible combination +of operands. +The +.I cgg +program will check all uses of the instruction to find out which +one was meant. +.PP +Although not in the PDP-11 example above there is a possibility +to describe instructions that have side effects to registers not +in the operand list. +The only thing possible is to say that the instruction is destructive +to some registers or the condition codes, by following the operand list +with the word +.I kills +and a list of the things destroyed. +Example for some hypothetic accumulator machine: +.DS +add source2:ro kills ACCU :cc . +.DE +.PP +The cost fields in the definitions for tokens and instructions +are added together when generating code. +It depends on the machine at hand whether the costs are orthogonal +enough to make use of both these costs, +in extreme cases every combination of instructions and operands +can be given in this section, +all with their own costs. +.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, address, register and undefined. +Really the type register is nonexistent as such, +for each register expression +.I cgg +keeps a set of possible values, +and this set can be seen as the real type. +.PP +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. +It is the responsibility of the table writer to ensure no undefined +expressions are ever used as initialisers for token attributes. +This is unfortunately almost impossible to check for +.I cgg +so be careful. +.LP +Basic terms in an expression are +.IP number 16 +A number is a constant of type integer. +Also usable is an identifier defined to a number in the constant +definition section. +.IP """string""" +A string within double quotes is a constant of type address. +All the normal C style escapes may be used within the string. +Also usable is an identifier defined to a string in the constant +definition section. +.IP [0-9][bf] +This must be read as a grep-pattern. +It evaluates to a string that is the label name for the +temporary label meant. +More about this in the section on code rules. +.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 address. +It is undefined when the instruction has no operand. +Watch out for instructions with type-letter w. +They can occur without an operand. +Check for this in your code rule with the defined() pseudo function. +.br +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 address. +.br +Those who want to know it exactly, the integer instruction types +are the instructions marked with the +type-letters c,f,l,n,o,s,r,w,z in the EM manual. +.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 code labels 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 attribute "off" of the first stack pattern token. +Type is the same as that of attribute "off". +To use this expression implies a check that all tokens +in the set used have the same attribute in the same place. +.IP %off +This means attribute "off" in the `current' token. +This can only be used when no confusion is possible about which token +was meant, eg. in the optional boolean expressions following token sets +in the move and test rules, in coercions or in the kills section inside +the code rules. +Same check as above. +.IP %1.1 +This is the first subregister of the first token. +Previous comments apply. +.IP %b +A percent sign followed by a lowercase letter +stands for an allocated register. +This is 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 on addresses behaves as you would expect +and the only operators allowed on register expressions +are == and != . +Furthermore there are some special `functions': +.IP defined(e) 16 +Returns 1 if expression +.I e +is defined, 0 otherwise. +.IP samesign(e1,e2) +Returns 1 if integer expression +.I e1 +and +.I e2 +have the same sign. +.IP sfit(e1,e2) +Returns 1 if integer expression +.I e1 +fits as a signed integer +into a field of +.I e2 +bits, 0 otherwise. +.IP ufit(e1,e2) +Same as above but now for unsigned +.I e1 . +.IP rom($a,n) +Integer expression giving word +.I n +from the \fBrom\fP descriptor +pointed at by EM instruction +number +.I a +in the EM-pattern. +Undefined if that descriptor does not exist. +.IP loww($a) +Returns the lower half of the argument of EM instruction number +.I a . +This is used to split the arguments of a \fBldc\fP instruction. +.IP highw($a) +Same for upper half. +.LP +The next two `functions' are only needed in a table that +implements register variables. +.IP inreg(e) 16 +Returns the status of the local variable with offset +.I e +from the localbase. +Value is an integer, +negative if the local was not allowed as a register +variable, +zero if it was allowed but not assigned to a register, +and the type of the register if it was assigned to a register. +This makes it possible to write +.DS +inreg($1)==reg_pointer +.DE +and similar things. +.IP regvar(e,t) +Type of this is register. +It returns the register the local with offset +.I e +is assigned to. +The table writer guarantees the register is one of type +.I t , +with +.I t +one of reg_any, reg_loop, reg_pointer or reg_float. +If +.I t +is omitted reg_any is assumed. +Undefined if inreg(\fIe\fP)<=0 . +.NH 2 +Token descriptions +.PP +Throughout the rest of the table tokens must be described, +be it as operands of instructions or as stack-replacements. +In all those cases we will speak about a token description. +The possibilities for these will be described here. +.PP +All expressions of type register are token descriptions. +The construct %1 means the token matched first in the stack pattern. +All other token descriptions are those that are built on the spot. +They look like this: +.DS +{ , } +.DE +All expressions are type-checked by +.I cgg , +and the number of initializers is also checked. +.PP +A special case of the last token descriptions occurs when +the token name is `LOCAL' or `DLOCAL' and the table uses register +variables. The first token attribute then must be of type integer and +the token description is automagically replaced by the register chosen +if the LOCAL (wordsize) or DLOCAL (twice the wordsize) was assigned +to a register. +.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. +Broadly the syntax is +.DS L +code rule : EM-part code-part +EM-part : EM-pattern | procedure-heading +code-part : code-description | procedure-call +code-description : stackpattern kills allocates generates yields leaving +.DE +Ignoring the "procedure"-part for now, the description for the EM-pattern +and the code-description follows. +Almost everything here is optional, the minimum code rule +is: +.DS +pat nop +.DE +that will simply throw away +.I nop +instructions. +.NH 3 +The EM pattern +.PP +The EM pattern consists of a list of EM mnemonics +preceded by the word +.I pat +optionally followed by a boolean expression. +Examples: +.DS +pat \fBloe\fP +.DE +will match a single \fBloe\fP instruction, +.DS +pat \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 +pat \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 +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. +This rule of three is an unfortunate implementation dependent restriction, +but patterns longer than three EM instructions are luckily not needed +too often. +.PP +Following the EM-pattern there may be more than one code +rule, +.I cg +will choose using heuristics and the cost +information provided with the instruction and token +definitions. +Owing to parsing reasons of the table, the word +.I with +(see below) +is mandatory when there are more code rules attached to one +EM-pattern. +The stack pattern may be empty however. +.NH 3 +The stack pattern +.PP +The optional stack pattern is a list of token sets preceded by the word +.I with . +The token sets are usually represented by set identifiers for clarity. +No boolean expression is allowed here. +The first expression is the one that matches the top of the stack. +.PP +If the pattern is followed by the word STACK +it only matches if there is nothing +else on the fake stack, +and the code generator will stack everything not matched at the start +of the rule. +.PP +The pattern can be preceded with the word +.I exact +following the +.I with +that tells the code generator not to try to coerce to the pattern +but only to use it when it is already present on the fake stack. +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. +.LP +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 +if 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 stack pattern for \fBsti\fP\ 8 +like this: +.DS +with DBLREG +.DE +The code generator would then find that coercing the 8-byte global _a +to a floating point register and then storing it to _b was the cheapest, +if the space/time knob was turned far enough to space. +This can be prevented by changing the stack pattern to +.DS +with exact DBLREG +.DE +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 +.I exact +construct is speed. +When the code generator has a long list of possible stack patterns +for one EM pattern it can waste much 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 many special cases. +Prepending all the special cases by +.I exact +will stop the code generator from trying to find things +that either cannot be done, +or are too expensive anyway. +.PP +So in general it is wise to prepend all stack patterns that +cannot be made by coercions with +.I exact . +.PP +Using both +.I exact +and STACK in the stack pattern has the effect that the rule will +only be taken if there is nothing else on the fake stack. +.NH 3 +The kills part +.PP +The optional kills part describes certain tokens +that should neither remain on +the fake stack, nor remembered as contents of registers. +This is usually only required with store operations. +The entire fake stack, 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 token is marked as empty. +.PP +Syntax is +.DS +kills +thing to kill : token set optionally followed by boolean expression +.DE +Example: +.DS +kills regind2 %reg != lb || %off == $1 +.DE +is a kills part used for example in the \fBinl\fP or \fBstl\fP code rule. +It removes all register offsetted tokens where the register is not the +localbase plus the local in which 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 kills part 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 code for an EM-instruction like +.B sti +it is necessary to write a line in the table like +.DS +kills all_except_constant_or_register +.DE +where the long identifier is a set containing all tokens +that can be the destination of some random indirect store. +These indirect stores are the main reason to prevent this +.I kills +line to be deduced automatically by +.I cgg . +.PP +When generating something like a branch instruction it +might be needed to empty the fake stack completely. +This can of course be done with +.DS +kills ALL +.DE +or by ending the stack pattern with the word STACK, which is equivalent, +if the stack pattern does not start with +.I exact . +.PP +It is unfortunate that this part is still present in the table +but it is too much for now to let the +.I cgg +program discover what rules ruin what kind of tokens. +Maybe some day ..... +.NH 3 +The allocates part +.PP +The optional register allocation part describes the registers needed. +Syntax is +.DS +uses +.DE +where itemlist is a list of three kinds of things: +.IP 1) +.I reusing +< a token description >, for example %1. +.br +This will instruct the code generator that all registers +contained in this token can be reused if they are not used +in another token on the fakestack, +so that they are available for allocation in this +.I uses +line +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, +that is marked as empty at this point. +Look ahead can be performed if there is more than one register available. +.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. +.LP +Examples: +.DS +uses ODDREG +.DE +will allocate an odd register, while +.DS +uses REG={regind2,lb,$1} +.DE +will allocate a register while simultaneously filling it with +the asked value. +.br +Inside the coercion from xsrc2 to REG in the PDP-11 table +the following line can be found. +.DS +uses reusing %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={regind2,r3,"4"} and r3 is not in use elsewhere on the fake stack +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. +.NH 3 +The generates part +.PP +Code to be generated, also optionally, is specified as +the word +.I gen +followed by a list of items of the following kind: +.IP 1) +An instruction name followed by a comma-separated +list of token descriptions. +.I Cgg +will search the instruction definitions for the machine to find a suitable +instruction. +At code generation time the assembler name of the +instruction will be output followed by a space, +followed by a comma separated list of tokens. +.br +In the table an instruction without operands must be +followed by a period. +The author of +.I cgg +could not get +.I yacc +to be silent without it. +Sorry about this. +.IP 2) +a +.I move +call. +This has the following syntax: +.DS +move , +.DE +Moves are handled specially since that enables the code generator +to keep track of register contents. +Example: +.DS +move r3,{regind2,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 move definitions section described below. +.IP 3) +For machines that have condition codes, +which alas most of them do, +there are provisions to remember condition code settings +and prevent needless testing. +To set the condition code to a token put in the code the following call: +.DS +test +.DE +This will generate a test if the condition codes +were not already set to that token. +The rules describing how to test things +can be found in the test definitions section described below. +See also the :cc qualifier that can be used at instruction +definition time. +.IP 4) +The +.I return +statement. +Only used when register variables are in use. +This statement causes a call to the machine dependent +C-routine +.I regreturn . +Explanation of this must wait for the description of the +file mach.c below. +.IP 5) +A temporary label of the form : may be placed here. +Expressions of the form [0-9][bf] in this code rule +generate the same string as is used for this label. +The code generator system could probably easily be changed +to make this work for assemblers that do not support this +type of label by generating unique labels itself. +Implementation of this is not contemplated at the moment, +bad luck if your assembler cannot do it. +.NH 3 +Stack replacement +.PP +The optional stack replacement is a possibly empty list +of tokens to be pushed onto the fake stack. +It start with the word +.I yields , +and is followed by a list of token descriptions. +.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 sets +and you want to push them back unchanged, +you have to specify as stack replacement +.DS +yields %2 %1 +.DE +and not the other way around. +This is known to cause errors in tables so watch out for +this! +.NH 3 +EM replacement +.PP +In exceptional cases it might be useful to leave part of an EM-pattern +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 EM replacement part allows +one to express this. +It is activated by the word +.I leaving . +.LP +Example: +.DS +leaving \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 +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 +.ta 8 16 24 32 40 48 56 64 +pat loc yields {const2, $1} + +pat ldc yields {const2, loww($1)} + {const2, highw($1)} +.DE +These simple patterns just push one or more tokens onto the fake stack. +.DS +.ta 8 16 24 32 40 48 56 64 +pat lof +with REG yields {regind2,%1,$1} +with exact regconst2 yields {regind2,%1.reg,$1+%1.off} +with exact addr_external yields {relative2,$1+%1.off} +with exact addr_local yields {LOCAL, %1.ind + $1,2} +.DE +This pattern shows the possibility to do different things +depending on the fake stack contents, +there are some rules for some specific cases plus a general rule, +not preceded by +.I exact +that can always be taken after a coercion, +if necessary. +.DS +.ta 8 16 24 32 40 48 56 64 +pat lxl $1>3 +uses REG={LOCAL, SL, 2}, + REG={const2,$1-1} +gen 1: + move {regind2,%a, SL},%a + sob %b,{label,1b} yields %a +.DE +This rule shows register allocation with initialisation, +and the use of a temporary label. +The constant SL used here is defined to be the offset from lb +of the static link, +that is pushed by the Pascal compiler as the last argument of +a function. +.DS +.ta 8 16 24 32 40 48 56 64 +pat stf +with regconst2 xsrc2 + kills allexeptcon + gen move %2,{regind2,%1.reg,$1+%1.off} +with addr_external xsrc2 + kills allexeptcon + gen move %2,{relative2,$1+%1.off} +.DE +This rule shows the use of a +.I kills +part in a store instruction. +The set allexeptcon contains all tokens that can be the destination +of an indirect store. +.DS +.ta 8 16 24 32 40 48 56 64 +pat sde +with exact FLTREG + kills posextern + gen move %1,{relative4,$1} +with exact ftolong + kills posextern + gen setl. + movfi %1.reg,{relative4,$1} + seti. +with src2 src2 + kills posextern + gen move %1, {relative2, $1 } + move %2, {relative2, $1+2} +.DE +The rule for +.B sde +shows the use of the +.I exact +clause in both qualities, +the first is for correctness, +the second for efficiency. +The third rule is taken by default, +resulting in two separate stores, +nothing better exists on the PDP-11. +.DS +.ta 8 16 24 32 40 48 56 64 +pat sbi $1==2 +with src2 REG + gen sub %1,%2 yields %2 +with exact REG src2-REG + gen sub %2,%1 + neg %1 yields %1 +.DE +This rule for +.I sbi +has a normal first part, +and a hand optimized special case as it's second part. +.DS +.ta 8 16 24 32 40 48 56 64 +pat mli $1==2 +with ODDREG src2 + gen mul %2,%1 yields %1 +with src2 ODDREG + gen mul %1,%2 yields %2 +.DE +This shows the general property for rules with commutative +operators, +heuristics or look ahead will have to decide which rule is the best. +.DS +.ta 8 16 24 32 40 48 56 64 +pat loc sli $1==1 && $2==2 +with REG +gen asl %1 yields %1 +.DE +A simple rule involving a longer EM-pattern, +to make use of a specialized instruction available. +.DS +.ta 8 16 24 32 40 48 56 64 +pat loc loc cii $1==1 && $2==2 +with src1or2 +uses reusing %1,REG +gen movb %1,%a yields %a +.DE +A somewhat more complicated example of the same. +Note the +.I reusing +clause. +.DS +.ta 8 16 24 32 40 48 56 64 +pat loc loc loc cii $1>=0 && $2==2 && $3==4 leaving loc $1 loc 0 +.DE +Shows a trivial example of EM-replacement. +This is a rule that could be done by the +peephole optimizer, +if word order in longs was defined in EM. +On a `big-endian' machine the two replacement +instructions would be the other way around. +.DS +.ta 8 16 24 32 40 48 56 64 +pat and $1==2 +with const2 REG + gen bic {const2,~%1.num},%2 yields %2 +with REG const2 + gen bic {const2,~%2.num},%1 yields %1 +with REG REG + gen com %1 + bic %1,%2 yields %2 +.DE +Shows the way you have to twist the table, +if an +.I and -instruction +is not available on your machine. +.DS +.ta 8 16 24 32 40 48 56 64 +pat set $1==2 +with REG +uses REG={const2,1} +gen ash %1,%a yields %a +.DE +Shows the building of a word-size set. +.DS +.ta 8 16 24 32 40 48 56 64 +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)==0 + leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)!=0 + leaving adi 2 adp 0-rom($1,1) +.DE +Two rules showing the use of the rom pseudo function, +and some array optimalisation. +.DS +.ta 8 16 24 32 40 48 56 64 +pat bra +with STACK +gen jbr {label, $1} +.DE +A simple jump. +The stack pattern guarantees that everything will be stacked +before the jump is taken. +.DS +.ta 8 16 24 32 40 48 56 64 +pat cal +with STACK +gen jsr pc,{label, $1} +.DE +A simple call. +Same comments as previous rule. +.DS +.ta 8 16 24 32 40 48 56 64 +pat lfr $1==2 yields r0 +pat lfr $1==4 yields r1 r0 +.DE +Shows the return area conventions of the PDP-11 table. +At this point a reminder: +the +.B asp +instruction, and some other instructions must leave +the function return area intact. +See the defining document for EM for exact information. +.DS +.ta 8 16 24 32 40 48 56 64 +pat ret $1==0 +with STACK +gen mov lb,sp + rts pc +.DE +This shows a rule for +.B ret +in a table not using register variables. +In a table with register variables the +.I gen +part would just contain +.I return . +.DS +.ta 8 16 24 32 40 48 56 64 +pat blm +with REG REG +uses REG={const2,$1/2} +gen 1: + mov {autoinc,%2},{autoinc,%1} + sob %a,{label,1b} +.DE +This rule for +.B blm +already uses three registers of the same type. +.I Cgg +contains code to check all your rules +to see if they can be applied from an empty fakestack. +It uses the marriage thesis from Hall, +a thesis from combinatorial mathematics, +to accomplish this. +.DS +.ta 8 16 24 32 40 48 56 64 +pat exg $1==2 +with src2 src2 yields %1 %2 +.DE +This rule shows the exchanging of two elements on the fake stack. +.NH 2 +Code rules using procedures +.PP +To start this chapter it must be admitted at once that the +word procedure is chosen here mainly for it's advertising +value. +It more resembles a glorified goto but this of course can +not be admitted in the glossy brochures. +This document will continue to use the word +procedure. +.PP +The need for procedures was felt after the first version of +the code generator system was made, +mainly because of conditional instructions. +Often the code sequences for +.B tlt , +.B tle , +.B teq , +.B tne , +.B tge +and +.B tgt +were identical apart from one opcode in the code rule. +The code sequence had to be written out six times however. +Not only did this increase the table size and bore the +table writer, it also led to errors when changing the table +since it happened now and then that five out of six +rules were changed. +.PP +In general the procedures in this table format are used to +keep one copy instead of six of the code rules for all +sorts of conditionals and one out of two for things like +increment/decrement. +.PP +And now the syntax, first the procedure definition, +which must indeed be defined before the call because +.I cgg +is one-pass. +The procedure heading replaces the EM-pattern in a code rule +and looks like this: +.DS +proc +.DE +The identifier is used in later calls and the example must +be used if expressions like $1 are used in the code rule. +.DS + : example +.DE +so an example looks just like an EM-pattern, but without +the optional boolean expression. +The example is needed to know the types of $1 expressions. +The current version of +.I cgg +does not check correctness of the example, so be careful. +.PP +A procedure is called with one or two string-parameters, +that are assembler opcodes. +They can be accessed by appending the strings `[1]' or `[2]' +to a table opcode. +The string `*' can be used as an equivalent for `[1]'. +Just in case this is not clear, here is an example for +a procedure to increment/decrement a register. +.DS +.ta 8 16 24 32 40 48 56 64 +incop REG:rw:cc . /* in the INSTRUCTIONS part of course */ + +proc incdec +with REG +gen incop* %1 yields %1 +.DE +The procedure is called with parameter "inc" or "dec". +.PP +The procedure call is given instead of the code-part of the +code rule and looks like this +.DS +call '(' string [ ',' string ] ')' +.DE +which leads to the following large example: +.DS +.ta 8 16 24 32 40 48 56 64 +proc bxx example beq +with src2 src2 STACK +gen cmp %2,%1 + jxx* {label, $1} + +pat blt call bxx("jlt") +pat ble call bxx("jle") +pat beq call bxx("jeq") +pat bne call bxx("jne") +pat bgt call bxx("jgt") +pat bge call bxx("jge") +.DE +.NH 2 +Move definitions +.PP +We now jump back to near the beginning of the table +where the move definitions are found. +The move definitions directly follow the instruction +definitions. +.PP +In certain cases a move is called for, +either explicitly when a +.I move +instruction is used in a code rule, +or implicitly in a register initialization. +The different code rules possible to move data from one +spot to another are described here. +Example for the PDP-11: +.DS +.ta 8 16 24 32 40 48 56 64 +MOVES + +from const2 %num==0 to dst2 +gen clr %2 + +from src2 to dst2 +gen mov %1,%2 + +from FLTREG to longf4-FLTREG +gen movfo %1,%2 + +from longf4-FLTREG to FLTREG +gen movof %1,%2 +.DE +The example shows that the syntax is just +.DS +from to gen +.DE +Source and destination are a token set, optionally followed by +a boolean expression. +The code generator will take the first move that matches, +whenever a move is necessary. +.I Cgg +checks whether all moves called for in the table are present. +.NH 2 +Test definitions +.PP +This part describes the instructions necessary to set the condition codes +to a certain token. +These rules are needed when the +.I test +instruction is used in code rules. +Example for the PDP-11: +.DS +.ta 8 16 24 32 40 48 56 64 +TESTS + +to test src2 +gen tst %1 +.DE +So syntax is just +.DS +to test gen +.DE +Source is the same thing as in the move definition. +.I Cgg +checks whether all tests called for in the table are present. +.NH 2 +Some explanation about the rules behind 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 minimal set of coercions are +the coercions to unstack every token expression, +in combination with the rules to stack every token. +It should not be possible to smuggle a table through +.I cgg +without these basic set available. +.PP +If these are present the code generator can always make the necessary +transformations by stacking and unstacking. +Of course for code quality 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 +.I uses +clause 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 of the same size. +This category can use the +.I uses +clause 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 fake stack 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 2 +Stack definitions +.PP +The next part of the table defines the stacking rules for the machine. +Each token that may reside on the fake stack must have a rule attached +to put it on the real stack. +Example for the PDP-11: +.DS +.ta 8 16 24 32 40 48 56 64 +STACKINGRULES + +from const2 %num==0 to STACK +gen clr {autodec,sp} + +from src2 to STACK +gen mov %1,{autodec,sp} + +from regconst2 to STACK +gen mov %1.reg,{autodec,sp} + add {addr_external, %1.off},{regdef2,sp} + +from DBLREG to STACK +gen movf %1,{autodec,sp} + +from FLTREG to STACK +gen movfo %1,{autodec,sp} + +from regind8 to STACK +uses REG +gen move %1.reg,%a + add {addr_external, 8+%1.off},%a + mov {autodec, %a},{autodec,sp} + mov {autodec, %a},{autodec,sp} + mov {autodec, %a},{autodec,sp} + mov {autodec, %a},{autodec,sp} +.DE +.PP +These examples should be self-explanatory, except maybe for the last one. +It is possible inside a stacking-rule to use a register. +Since however the stacking might also take place at a moment +when no registers are free, it is mandatory that for each token +there is one stackingrule that does not use a register. +The code generator uses the first rule possible. +.NH 2 +Coercions +.PP +The next part of the table defines the coercions that are possible +on the defined tokens. +Example for the PDP-11: +.DS +.ta 8 16 24 32 40 48 56 64 +COERCIONS + +from STACK +uses REG +gen mov {autoinc,sp},%a yields %a + +from STACK +uses DBLREG +gen movf {autoinc,sp},%a yields %a + +from STACK +uses REGPAIR +gen mov {autoinc,sp},%a.1 + mov {autoinc,sp},%a.2 yields %a +.DE +These three coercions just deliver a certain type +of register by popping it from the real stack. +.DS +.ta 8 16 24 32 40 48 56 64 +from LOCAL yields {regind2,lb,%1.ind} + +from DLOCAL yields {regind4,lb,%1.ind} + +from REG yields {regconst2, %1, 0} +.DE +These three are zero-cost rewriting rules. +.DS +.ta 8 16 24 32 40 48 56 64 +from regconst2 %1.off==1 +uses reusing %1,REG=%1.reg +gen inc %a yields %a + +from regconst2 +uses reusing %1,REG=%1.reg +gen add {addr_external, %1.off},%a yields %a + +from addr_local +uses REG +gen mov lb,%a + add {const2, %1.ind},%a yields %a +.DE +The last three are three different cases of the coercion +register+constant to register. +Only in the last case is it always necessary to allocate +an extra register, +since arithmetic on the localbase is unthinkable. +.DS +.ta 8 16 24 32 40 48 56 64 +from xsrc2 +uses reusing %1, REG=%1 yields %a + +from longf4 +uses FLTREG=%1 yields %a + +from double8 +uses DBLREG=%1 yields %a + +from src1 +uses REG={const2,0} +gen bisb %1,%a yields %a +.DE +These examples show the coercion of different +tokens to a register of the needed type. +The last one shows the trouble needed on a PDP-11 to +ensure bytes are not sign-extended. +In EM it is defined that the result of a \fBloi\fP\ 1 +instruction is an integer in the range 0..255. +.DS +.ta 8 16 24 32 40 48 56 64 +from REGPAIR yields %1.2 %1.1 + +from regind4 yields {regind2,%1.reg,2+%1.off} + {regind2,%1.reg,%1.off} + +from relative4 yields {relative2,2+%1.off} + {relative2,%1.off} +.DE +The last examples are splitting rules. +.PP +The examples show that +all coercions change one token on the fake stack into one or more others, +possibly generating code. +The STACK token is supposed to be on the fake stack when it is +really empty, and can only be changed into one other token. +.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. +They are defined depending on the Target EM_WSIZE, or TEM_WSIZE, +and TEM_PSIZE. +The type 'int' is used for things like counters 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 TEM_WSIZE>2. +The type 'full' is used for addresses and is of type 'long' if +TEM_WSIZE>2 or TEM_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 +that 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 machine word. +.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 +that is a nonnumeric global label, and transform it into a copy made to +.I st +that 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) +.br +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==TEM_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) +.br +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() +.br +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) +.br +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) +.br +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[] +.br +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. +.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 - +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 count of static occurrences, 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 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 == 2) + 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++); +} + +#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; { + + /* + * This function is full of magic constants. + * They are a result of experimentation. + */ + + 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); /* 10 * estimated # of words of profit */ +} + +i_regsave() { + + Rstring[0] = 0; + n_regvars=0; +} + +f_regsave() { + register i; + + if (n_regvars==0 || lbytes==0) { + fprintf(codefile,"mov r5,-(sp)\enmov sp,r5\en"); + if (lbytes == 2) + fprintf(codefile,"tst -(sp)\en"); + else if (lbytes!=0) + fprintf(codefile,"sub $0%o,sp\en",lbytes); + for (i=0;i6) { + fprintf(codefile,"mov $0%o,r0\en",lbytes); + fprintf(codefile,"jsr r5,PR%s\en",Rstring); + } else { + fprintf(codefile,"jsr r5,PR%d%s\en",lbytes,Rstring); + } + } + for (i=0;i=0) + fprintf(codefile,"mov 0%lo(r5),%s\en",regadm[i].ra_off, + regadm[i].ra_str); +} + +regsave(regstr,off,size) char *regstr; long off; { + + fprintf(codefile,"/ Local %ld into %s\en",off,regstr); + strcat(Rstring,regstr); + regadm[n_regvars].ra_str = regstr; + regadm[n_regvars].ra_off = off; + n_regvars++; +} + +regreturn() { + + fprintf(codefile,"jmp RT%s\en",Rstring); +} + +#endif + +prolog(nlocals) full nlocals; { + +#ifndef REGVARS + 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 $0%o,sp\en",nlocals); +#else + lbytes = nlocals; +#endif +} + +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 +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 coderules[] +.br +Pseudo code interpreted by the code generator. +Always starts with some opcode followed by operands depending +on the opcode. +Some of the opcodes have an argument encoded in the upper three +bits of the opcode byte. +Integers in this table are between 0 and 32767 and have a one byte +encoding if between 0 and 127. +.ti -0.5i +char wrd_fmt[] +.br +The format used for output of words. +.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 run time 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 codestrings[] +.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 index for code rule. +.ti -0.5i +test_t tests[] +.br +List of test rules. +Contains token expressions for source +plus 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_ADDR , +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 look ahead. +Arguments are: +.IP codep 10 +Pointer into code rules, pseudo program counter. +.IP ply +Number of EM pattern look ahead 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 look ahead. +.PP +The instructions inplemented in the switch: +.NH 4 +DO_DLINE +.PP +Prints debugging information if the code generator runs in debug mode. +This information is only generated if +.I cgg +was called with the -d flag. +.NH 4 +DO_NEXTEM +.PP +Matches the next EM pattern and does look ahead 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. +It can also handle the procedure mechanism. +.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 +fake stack 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 +Look ahead is now performed if the number of tuples is greater than one. +If no possibility is found within the costlimit, +the fake stack is made smaller by pushing the bottom token, +and this process is repeated until either a way is found or +the fake stack 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 kills clause 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 look ahead 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_INSTR +.PP +This prints an instruction and it's operands. +Only done on toplevel. +.NH 4 +DO_MOVE +.PP +Calls the move() function in the code generator to implement the move +instruction in the table. +.NH 4 +DO_TEST +.PP +Calls the test() function in the code generator to implement the test +instruction 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 fake stack 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 fake stack 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 genstr() gets a string as argument and copies it to codefile. +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. +The flag can be followed by a digit specifying the amount of debugging +wanted, +and by @labelname giving the start of debugging. +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 look ahead 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 instruction in the tables, +register initialization and the test instruction and associated bookkeeping. +First tests are made to try to prevent the move from really happening. +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 fake stack. +.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 and +restore a previous saved state. +.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 fake stack 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 fake stack 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 fake stack and must stack +every token including the one pointed at up to the bottom of the fake stack. +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. diff --git a/doc/pcref.doc b/doc/pcref.doc new file mode 100644 index 00000000..0cf42031 --- /dev/null +++ b/doc/pcref.doc @@ -0,0 +1,1555 @@ +.\" $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 = +_ 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. +.IE +.PP +For those who wish the use the interface between C and Pascal we +give an incomplete list of corresponding formal parameters in C and Pascal. +.sp 1 +.ta 8 37 +.nf + Pascal C + a:integer int a + a:char int a + a:boolean int a + a:real double a + a:^type type *a + var a:type type *a + procedure a(pars) struct { + void (*a)() ; + char *static_link ; + } + function a(pars):type struct { + type (*a)() ; + char *static_link ; + } +.fi +The Pascal runtime system uses the following algorithm when calling +function/procedures passed as parameters. +.nf +.ta 8 16 + if ( static_link ) (*a)(static_link,pars) ; + else (*a)(pars) ; +.fi +.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. +.sp +.ti -3 +9.~\ +Pre-processing. +.sp +If the very first character of a file containing a Pascal +program is the sharp ('#', ASCII 23(hex)) the file is preprocessed +in the same way as C programs. +Lines beginning with a '#' are taken as preprocessor command lines +and not fed to the Pascal compiler proper. +C style comments, /*......*/, are removed by the C preprocessor, +thus C comments inside Pascal programs are also removed when they +are fed through the preprocessor. +.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~~\ +the size of reals can be changed by this option. should be specified in 8-bit bytes. +The default in most implementations is 8, but other values can +occur. +.sp +.ti -8 +i~~\ +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~~the size of pointers can be changed by this option. 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) diff --git a/doc/peep.doc b/doc/peep.doc new file mode 100644 index 00000000..cad79668 --- /dev/null +++ b/doc/peep.doc @@ -0,0 +1,506 @@ +.\" $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. + diff --git a/doc/regadd.doc b/doc/regadd.doc new file mode 100644 index 00000000..6f8c91b4 --- /dev/null +++ b/doc/regadd.doc @@ -0,0 +1,133 @@ +.\" $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. + diff --git a/doc/toolkit.doc b/doc/toolkit.doc new file mode 100644 index 00000000..d6e7b5d5 --- /dev/null +++ b/doc/toolkit.doc @@ -0,0 +1,897 @@ +.\" $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. diff --git a/doc/v7bugs.doc b/doc/v7bugs.doc new file mode 100644 index 00000000..5a5f0a6a --- /dev/null +++ b/doc/v7bugs.doc @@ -0,0 +1,303 @@ +.\" $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 ??? +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: +.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 diff --git a/doc/val.doc b/doc/val.doc new file mode 100644 index 00000000..2be0c093 --- /dev/null +++ b/doc/val.doc @@ -0,0 +1,753 @@ +.\" $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. diff --git a/emtest/Makefile b/emtest/Makefile new file mode 100644 index 00000000..77ce23fe --- /dev/null +++ b/emtest/Makefile @@ -0,0 +1,19 @@ +tested: last + set -x ;\ + for i in `awk '{for(i=\$$1;i<=127;i++)print i}' last ` ;\ + do \ + echo $$i; \ + echo $$i >last; \ + select $$i tests > test.e; \ + ack test.e; \ + a.out \ + : ok; \ + done + rm -f test.e a.out + >tested + +last: tests test.h select + echo 0 >last + +select: select.c + cc -O -n -o select select.c diff --git a/emtest/READ_ME b/emtest/READ_ME new file mode 100644 index 00000000..021ae77f --- /dev/null +++ b/emtest/READ_ME @@ -0,0 +1,136 @@ +This directory contains test programs for EM implementations. +The test programs are all part of the file "tests". +Each individual test program looks like: + + TEST 004: test ... + ... ; data declarations etc. + MAIN nlocal + ... ; part of the body of MAIN + PROC + ... ; subroutines used by this test + +The PROC part is optional, so the smallest test program looks like: + + TEST 000: null test + MAIN 0 + +The keywords used by "select", like TEST, MAIN, PROC, HOL, OK and ERRLAB, +all consist of upper case letters and start in column one. +A convention for test numbers is to use 3 digit numbers, possibly left +padded with zero's. + +A program, called "select", is provided to combine a range of tests +into a single test program. +"Select" expects a range as argument, like 0-127, or -127, or 0-. +Tests that have a TEST number in that range are included. +"Select" also expects the file from which the tests should +be selected as an argument. +If no argument is given, or only a range argument, select expects +the tests to slect from on standard input. + +To prevent name clashes, some rules must be obeyed: + - data label names, procedure names and instruction label numbers + must be unique over all tests. A good habit is to use the + three digit test number as suffix. + - only keyword of "select" may start with uppercase letters in column + one, to allow for expansion in the future. + - because only a single 'hol' pseudo is allowed, "select" must + generate the 'hol' pseudo. An individual test may request + some 'hol' space by a special HOL line, starting in column one + and followed by a single number, the number of bytes needed. + This number must consists of digits only, no constant symbols, + because "select" must compute the maximum, so before the + preprocessor has replaced the constant symbols by their values. + - a similar problem is caused by the number of bytes of local + storage for 'main'. An individual test may specify the number + of bytes it needs as parameter to the MAIN line. + Again, the number must consist of digits only. + +Test programs print a sequence of integers greater than 1. +This sequence is terminated by the number 1 as soon as an error is detected. +If all tests are performed correctedly the number 0 is printed. + +To allow test programs to print integers without the full machinery of +conversion and i/o routines, the EM instruction 'nop' is used. +Each time this instruction is executed, the current line number as +maintained by the 'lin' instruction must be printed, followed by a +newline, at least during debugging. + +The following abbrevation may be used in test programs: + + OK -> lin n + nop + +Numbers are automatically assigned in order of static appearance. +As soon as an error is detected you must branch to label 1, by instructions +like 'bra *1' and 'zne *1'. +Label 1 is automatically provided in the main routine. +If you jump to label 1 in a subroutine, then that subroutine must +end with ERRLAB, like in: + + PROC + pro $test,0 + ... + bra *1 + ... + ret 0 + ERRLAB + end + +An option to "select" is to generate 'fil' instructions whenever a +new test starts. +This is useful if 'nop' prints the 'fil' string as well as the 'lin' number. +This 'f' option is on by default, off if a '-f' flag is given. + +The EM file generated by "select" includes "test.h". +"test.h" may contain definitions of the following symbols: + W2S: the size of double precision integers, if implemented. + FS: the size of single precision floats, if implemented. + F2S: the size of double precision floats, if implemented. +The value of these symbols, if defined, must be the size of the object involved. + +Two other symbols are used: + EM_PSIZE: pointer size + EM_WSIZE: word size +The machine dependent translation program, like 8086 and vax2, give +definitions of these symbols while calling the EM encode program. +Because these size names occur quite often, they may be abbreviated: + WS -> EM_WSIZE + PS -> EM_PSIZE + +Before running the tests in the file "tests", it is wise to test +the necessary basic functions with some simple tests like + + TEST 000: null + MAIN 0 +and + TEST 001: ok + MAIN 0 + OK +and + TEST 998: error + MAIN 0 + bra *1 +and + TEST 999: test lni + MAIN 0 + lin 1 + lni + loe 0 + loc 2 + bne *1 + OK +The first two of these are part of "tests" as well. The last two are +not included in "tests" intensionally, because they would fail. +The last tests fails because it references the ABS block which is +inaccessable after an 'hol' pseudo. +Proceed as follows for each of these basic tests: + - make a file called 'basic' containing the test + - run select: + select basic >basic.e + - compile by + machine basic.e + - and load and run + + where machine should be replaced by the name of program + used to compile EM programs for the current machine. diff --git a/emtest/last b/emtest/last new file mode 100644 index 00000000..573541ac --- /dev/null +++ b/emtest/last @@ -0,0 +1 @@ +0 diff --git a/emtest/ok b/emtest/ok new file mode 100755 index 00000000..1eca33bb --- /dev/null +++ b/emtest/ok @@ -0,0 +1,10 @@ +trap "" 1 2 + +while read x +do + case $x in + 0) exit 0;; + bad) exit 1;; + esac +done +exit 1 diff --git a/emtest/select.c b/emtest/select.c new file mode 100644 index 00000000..9be038ad --- /dev/null +++ b/emtest/select.c @@ -0,0 +1,249 @@ +/* + * (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 +#include +#include + +#define LINSIZ 100 + +int sigs[] = { + SIGHUP, + SIGINT, + SIGQUIT, + SIGTERM, + 0 +}; + +char *prog; +char line[LINSIZ]; +int nlocals = 0; +int nhol = 0; +int nerrors = 0; +int oknum = 2; +int fflag = 1; +int low = 0; +int high = 999; + +FILE *file1; +FILE *file2; +FILE *file3; +char name1[] = "/usr/tmp/f1XXXXXX"; +char name2[] = "/usr/tmp/f2XXXXXX"; +char name3[] = "/usr/tmp/f3XXXXXX"; + +stop() { + unlink(name1); + unlink(name2); + unlink(name3); + exit(nerrors); +} + +main(argc,argv) char **argv; { + register *p; + register char *s; + + prog = *argv++; --argc; + mktemp(name1); + mktemp(name2); + mktemp(name3); + for (p = sigs; *p; p++) + if (signal(*p, stop) == SIG_IGN) + signal(*p, SIG_IGN); + while (argc > 0 && argv[0][0] == '-') { + switch (argv[0][1]) { + case 'f': + fflag ^= 1; + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + high = atoi(&argv[0][1]); + break; + default: + usage(); + break; + } + argc--; + argv++; + } + if (argc > 0 && argv[0][0] >= '0' && argv[0][0] <= '9') { + s = argv[0]; + do + low = low*10 + *s++ - '0'; + while (*s >= '0' && *s <= '9'); + if (*s == 0) + high = low; + else if (*s++ == '-') { + high = atoi(s); + if (high == 0) + high = 999; + } else + fatal("bad range %s", argv[0]); + argc--; + argv++; + } + if (argc > 1) + usage(); + if (argc == 1 && freopen(argv[0], "r", stdin) == NULL) + fatal("cannot open %s", argv[0]); + if ((file1 = fopen(name1, "w")) == NULL) + fatal("cannot create %s", name1); + if ((file2 = fopen(name2, "w")) == NULL) + fatal("cannot create %s", name2); + if ((file3 = fopen(name3, "w")) == NULL) + fatal("cannot create %s", name3); + if (getline()) + while (select()) + ; + fclose(file1); + fclose(file2); + fclose(file3); + combine(); + stop(); +} + +select() { + register FILE *f; + int i; + + if (sscanf(line, "TEST %d", &i) != 1) + fatal("bad test identification(%s)", line); + if (i < low || i > high) { + while (getline()) + if (line[0] == 'T') + return(1); + return(0); + } + fprintf(file2, "; %s\n", line); + if (fflag) { + fprintf(file1, ".%03d\n", i); + fprintf(file1, " con \"tst%03d\"\n", i); + fprintf(file2, " fil .%03d\n", i); + } + f = file1; + while (getline()) { + switch (line[0]) { + case 'T': + return(1); + case 'M': + if (sscanf(line, "MAIN%d", &i) != 1 || i%4 != 0) + break; + if (i > nlocals) + nlocals = i; + f = file2; + continue; + case 'P': + if (strcmp(line, "PROC") != 0) + break; + f = file3; + continue; + case 'H': + if (f != file1 || + sscanf(line, "HOL%d", &i) != 1 || + i%4 != 0) + break; + if (i > nhol) + nhol = i; + continue; + case 'O': + if (strcmp(line, "OK") != 0) + break; + fprintf(f, " lin %d\n nop\n", oknum++); + continue; + case 'E': + if (f != file3 || strcmp(line, "ERRLAB") != 0) + break; + fprintf(f, "1\n lin 1\n nop\n loc 1\n loc 1\n mon\n"); + continue; + default: + putline(f); + continue; + } + fatal("bad line (%s)", line); + } + return(0); +} + +combine() { + + printf("#define WS EM_WSIZE\n"); + printf("#define PS EM_PSIZE\n"); + printf("#include \"test.h\"\n"); + printf(" mes 2,WS,PS\n"); + printf(" mes 1\n"); + printf(" mes 4,300\n"); + if (nhol) + printf(" hol %d,0,0\n", nhol); + copy(name1); + printf(" exp $m_a_i_n\n"); + printf(" pro $m_a_i_n,%d\n", nlocals); + printf(" loc 123\n"); + printf(" loc -98\n"); + copy(name2); + printf(" loc -98\n"); + printf(" bne *1\n"); + printf(" loc 123\n"); + printf(" bne *1\n"); + printf(" lin 0\n"); + printf(" nop\n"); + printf(" loc 0\n"); + printf(" ret WS\n"); + printf("1\n"); + printf(" lin 1\n"); + printf(" nop\n"); + printf(" loc 1\n"); + printf(" ret WS\n"); + printf(" end\n"); + copy(name3); +} + +copy(s) char *s; { + if (freopen(s, "r", stdin) == NULL) + fatal("cannot reopen %s", s); + while (getline()) + putline(stdout); +} + +getline() { + register len; + + if (fgets(line, LINSIZ, stdin) == NULL) + return(0); + len = strlen(line); + if (line[len-1] != '\n') + fatal("line too long(%s)", line); + line[len-1] = 0; + return(1); +} + +putline(f) FILE *f; { + fprintf(f, "%s\n", line); +} + +fatal(s, a1, a2, a3, a4) char *s; { + fprintf(stderr, "%s: ", prog); + fprintf(stderr, s, a1, a2, a3, a4); + fprintf(stderr, " (fatal)\n"); + nerrors++; + stop(); +} + +usage() { + fprintf(stderr, "usage: %s -f [[low]-[high]] [testcollection]\n", prog); + nerrors++; + stop(); +} diff --git a/emtest/test.e b/emtest/test.e new file mode 100644 index 00000000..7f26cf5f --- /dev/null +++ b/emtest/test.e @@ -0,0 +1,28 @@ +#define WS EM_WSIZE +#define PS EM_PSIZE +#include "test.h" + mes 2,WS,PS + mes 1 + mes 4,300 +.000 + con "tst000" + exp $m_a_i_n + pro $m_a_i_n,0 + loc 123 + loc -98 +; TEST 000: empty + fil .000 + loc -98 + bne *1 + loc 123 + bne *1 + lin 0 + nop + loc 0 + ret WS +1 + lin 1 + nop + loc 1 + ret WS + end diff --git a/emtest/test.h b/emtest/test.h new file mode 100644 index 00000000..e69de29b diff --git a/emtest/tests b/emtest/tests new file mode 100644 index 00000000..0479430f --- /dev/null +++ b/emtest/tests @@ -0,0 +1,3605 @@ +TEST 000: empty +MAIN 0 +TEST 001: OK +MAIN 0 +OK +TEST 002: test loc, bne +MAIN 0 + loc 0 + loc 0 + bne *1 +OK + loc 1 + loc 1 + bne *1 +OK + loc -1 + loc -1 + bne *1 +OK + loc 127 + loc 127 + bne *1 +OK + loc -127 + loc -127 + bne *1 +OK + loc -128 + loc -128 + bne *1 +OK +#if WS > 1 + loc 255 + loc 255 + bne *1 +OK + loc 256 + loc 256 + bne *1 +OK + loc 257 + loc 257 + bne *1 +OK + loc 32767 + loc 32767 + bne *1 +OK + loc -32767 + loc -32767 + bne *1 +OK + loc -32768 + loc -32768 + bne *1 +OK +#endif WS > 1 +#if WS > 2 + loc 65535 + loc 65535 + bne *1 +OK + loc 65536 + loc 65536 + bne *1 +OK + loc 65537 + loc 65537 + bne *1 +OK + loc 2147483647 + loc 2147483647 + bne *1 +OK + loc -2147483647 + loc -2147483647 + bne *1 +OK + loc -2147483648 + loc -2147483648 + bne *1 +OK +#endif WS > 2 +TEST 003: test signed and unsigned loc +MAIN 0 +#if WS == 1 + loc 128 + loc -128 + bne *1 +OK + loc 129 + loc -127 + bne *1 +OK + loc 255 + loc -1 + bne *1 +OK +#endif +#if WS == 2 + loc 32768 + loc -32768 + bne *1 +OK + loc 32769 + loc -32767 + bne *1 +OK + loc 65535 + loc -1 + bne *1 +OK +#endif +#if WS == 4 + loc 2147483648 + loc -2147483648 + bne *1 +OK + loc 2147483649 + loc -2147483647 + bne *1 +OK + loc 4294967295 + loc -1 + bne *1 +OK +#endif +TEST 004: test lol, stl +MAIN 8 + loc 95 + stl -4 + lol -4 + loc 95 + bne *1 +OK + lol 0 + stl -4 + loc 125 + stl -8 + loc 125 + lol -8 + bne *1 +OK + lol 0 + lol -4 + bne *1 +OK +TEST 005: test loe, ste +HOL 8 +MAIN 0 + loc 95 + ste 4 + loe 4 + loc 95 + bne *1 +OK + loc 125 + ste 0 + loc 125 + loe 0 + bne *1 +OK + loc 95 + ste 0 + loe 4 + loe 0 + bne *1 +OK +TEST 006: test named global data: con, rom, bss +a006 + bss 4,0,0 +b006 + con 35 +c006 + bss 4,0,1 +d006 + bss 4,35,1 +e006 + rom 57 +MAIN 0 + loc 0 + loe c006 + bne *1 +OK + loe b006 + ste a006 + loe d006 + loe a006 + bne *1 +OK + loe e006 + ste b006 + loc 57 + loe b006 + bne *1 +OK +TEST 007: test lal, lil +MAIN 12 + lal -8 +#if WS == PS + stl -4 +#endif +#if WS*2 == PS + sdl -4 +#endif + loc 117 + stl -8 + lil -4 + loc 117 + bne *1 +OK +TEST 008: test sil +MAIN 12 + loc 29 + stl -8 + lal -8 +#if WS == PS + stl -4 +#endif +#if WS*2 == PS + sdl -4 +#endif + loc 110 + sil -4 + lol -8 + loc 110 + bne *1 +OK +TEST 009: test lof +MAIN 20 + lal -16 + loc 120 + stl -12 + lof 4 + loc 120 + bne *1 +OK +TEST 010: test stf +MAIN 20 + loc 180 + lal -16 + stf 8 + lol -8 + loc 180 + bne *1 +OK +TEST 011: test loi WS +MAIN 20 + loc 140 + stl -12 + lal -12 + loi WS + loc 140 + bne *1 +OK +TEST 012: test loi 1, sti 1 +MAIN 20 +#if WS > 1 + loc 519 + lal -10 + sti 1 + lal -10 + loi 1 + loc 7 + bne *1 +OK +#endif +TEST 013: test loi 2*WS +MAIN 20 + loc 77 + stl -12 + loc 119 + stl -12+WS + lal -12 + loi 2*WS + loc 77 + bne *1 + loc 119 + bne *1 +OK +TEST 014: test loi 4*WS +MAIN 20 + loc 150 + stl -16+(3*WS) + loc 152 + stl -16+(2*WS) + loc 154 + stl -16+WS + loc 156 + stl -16 + lal -16 + loi 4*WS + loc 156 + bne *1 + loc 154 + bne *1 + loc 152 + bne *1 + loc 150 + bne *1 +OK +TEST 015: test los WS with 1 +MAIN 20 + loc 7 + lal -10 + sti 1 + lal -10 + loc 1 + los WS + loc 7 + bne *1 +OK +TEST 016: test los WS with 2 +MAIN 20 +#if WS == 1 + loc 77 + loc 78 + stl -12 + stl -11 + lal -12 + loc 2 + los WS + loc 78 + bne *1 + loc 77 + bne *1 +#endif +#if WS > 1 + loc 777 + stl -12 + lal -12 + loc 2 + los WS + loc 777 + bne *1 +#endif +OK +TEST 017: test los WS with 4 +MAIN 20 +#if WS == 1 + loc 14 + loc 15 + loc 16 + loc 17 + lal -12 + sti 4 + lal -12 + loc 4 + los WS + loc 17 + bne *1 + loc 16 + bne *1 + loc 15 + bne *1 + loc 14 + bne *1 +#endif +#if WS == 2 + loc 3001 + loc 3002 + stl -12 + stl -10 + lal -12 + loc 4 + los WS + loc 3002 + bne *1 + loc 3001 + bne *1 +#endif +#if WS > 2 + loc 123001 + stl -12 + lal -12 + loc 4 + los WS + loc 123001 + bne *1 +#endif +OK +TEST 018: test ldl +MAIN 20 + loc 77 + stl -12 + loc 123 + stl -12+WS + ldl -12 + loc 77 + bne *1 + loc 123 + bne *1 +OK +TEST 019: test lde +HOL 20 +MAIN 0 + loc 70 + ste 12 + loc 71 + ste 12+WS + lde 12 + loc 70 + bne *1 + loc 71 + bne *1 +OK +TEST 020: test ldf +MAIN 20 + loc 123 + loc 77 + sdl -4 + lal -9 + ldf 5 + loc 77 + bne *1 + loc 123 + bne *1 +OK +TEST 021: test ldf +MAIN 20 + loc 75 + stl -12 + loc 77 + stl -12+WS + lal -20 + ldf 8 + loc 75 + bne *1 + loc 77 + bne *1 +OK +TEST 022: test sdl +MAIN 20 + loc 30 + loc 31 + sdl -12 + lol -12+WS + loc 30 + bne *1 + lol -12 + loc 31 + bne *1 +OK +TEST 023: test sde +HOL 20 +MAIN 0 + loc 40 + loc 41 + sde 16 + loe 16 + loc 41 + bne *1 + loe 16+WS + loc 40 + bne *1 +OK +TEST 024: test sdf +HOL 20 +MAIN 0 + loc 51 + loc 50 + lae 6 + sdf 10 + loe 16 + loc 50 + bne *1 + loc 51 + loe 16+WS + bne *1 +OK +TEST 025: test sti 1 +MAIN 20 + loc 4136 + lal -11 + sti 1 + loc 1034 + lal -10 + sti 1 + lal -10 + loi 1 + loc 10 + bne *1 + lal -11 + loi 1 + loc 40 + bne *1 +OK +TEST 026: test sti 1 and lol +MAIN 0 + loc 257 + stl -12+WS + loc 514 + stl -12-WS + loc 50 + lal -12 + sti 1 +#if WS > 1 + loc -50 + lal -11 + sti 1 +#endif +#if WS > 2 + loc 49 + lal -10 + sti 1 + loc -49 + lal -9 + sti 1 +#endif + loc 257 + lol -12+WS + bne *1 + loc 514 + lol -12-WS + bne *1 +OK +TEST 027: test sti 2 +MAIN 20 +#if WS == 1 + ldc 90 +#else + loc 90 +#endif + lal -12 + sti 2 +#if WS != 2 + lal -12 + loi 2 +#else + lol -12 +#endif +#if WS == 1 + ldc 90 +#else + loc 90 +#endif + bne *1 +OK +TEST 028: test sti 4 +MAIN 20 +#if WS == 1 + loc 100 + loc 101 +#endif +#if WS <= 2 + loc 102 +#endif + loc 103 + lal -14 + sti 4 + lol -14 + loc 103 + bne *1 +OK +TEST 029: test sts WS with 1 +MAIN 20 + loc 57 + lal -13 + sti 1 + loc 123 + lal -11 + sti 1 + loc 20 + lal -12 + loc 1 + sts WS + lal -12 + loi 1 + loc 20 + bne *1 + lal -11 + loi 1 + loc 123 + bne *1 + lal -13 + loi 1 + loc 57 + bne *1 +OK +TEST 030: test sts WS with WS +MAIN 20 + loc 210 + lal -12 + loc WS + sts WS + lol -12 + loc 210 + bne *1 +OK +TEST 031: test sts WS with 4 +MAIN 20 +#if WS == 1 + loc 100 + loc 101 +#endif +#if WS <= 2 + loc 102 +#endif + loc 103 + lal -14 + loc 4 + sts WS + lol -14 + loc 103 + bne *1 +OK +TEST 032: test adi WS +MAIN 0 + loc 1 + loc 1 + adi WS + loc 2 + bne *1 +OK + loc 5 + loc -6 + adi WS + loc -1 + bne *1 +OK +#if WS >= 2 + loc -1007 + loc +999 + adi WS + loc -8 + bne *1 +OK + loc -1300 + loc +1405 + adi WS + loc 105 + bne *1 +OK + loc -30000 + loc -20 + adi WS + loc -30020 + bne *1 +OK +#endif +#if WS >= 4 + loc -100007 + loc +99999 + adi WS + loc -8 + bne *1 +OK + loc -1300 + loc +140567 + adi WS + loc 139267 + bne *1 +OK + loc -30000000 + loc -20 + adi WS + loc -30000020 + bne *1 +OK +#endif +TEST 033: test sbi WS +MAIN 0 + loc 1 + loc 1 + sbi WS + loc 0 + bne *1 +OK + loc 5 + loc -6 + sbi WS + loc +11 + bne *1 +OK +#if WS >= 2 + loc -1007 + loc +999 + sbi WS + loc -2006 + bne *1 +OK + loc -1300 + loc +1405 + sbi WS + loc -2705 + bne *1 +OK + loc -30000 + loc -20 + sbi WS + loc -29980 + bne *1 +OK +#endif +#if WS >= 4 + loc -100007 + loc +99999 + sbi WS + loc -200006 + bne *1 +OK + loc -1300 + loc +140567 + sbi WS + loc -141867 + bne *1 +OK + loc -30000000 + loc -20 + sbi WS + loc -29999980 + bne *1 +OK +#endif +TEST 034: test mli WS +MAIN 0 + loc 5 + loc 9 + mli WS + loc 45 + bne *1 +OK + loc 0 + loc 10 + mli WS + loc 0 + bne *1 +OK +#if WS > 1 + loc -99 + loc 7 + mli WS + loc -693 + bne *1 +OK + loc -100 + loc -90 + mli WS + loc 9000 + bne *1 +OK +#endif +#if WS > 2 + loc 123456 + loc 200 + mli WS + loc 24691200 + bne *1 +OK +#endif +TEST 035: test dvi WS +MAIN 0 + loc 15 + loc 5 + dvi WS + loc 3 + bne *1 +OK + loc 100 + loc -7 + dvi WS + loc -14 + bne *1 +OK + loc -100 + loc 7 + dvi WS + loc -14 + bne *1 +OK +#if WS >= 2 + loc -1000 + loc -201 + dvi WS + loc 4 + bne *1 +OK +#endif +#if WS >= 4 + loc 1234567 + loc -100 + dvi WS + loc -12345 + bne *1 +OK +#endif +TEST 036: test rmi WS +MAIN 0 + loc 100 + loc 7 + rmi WS + loc 2 + bne *1 +OK + loc -100 + loc 7 + rmi WS + loc -2 + bne *1 +OK + loc 100 + loc -7 + rmi WS + loc 2 + bne *1 +OK + loc -100 + loc -7 + rmi WS + loc -2 + bne *1 +OK +#if WS >= 2 + loc -1000 + loc -201 + rmi WS + loc -196 + bne *1 +OK +#endif +#if WS >= 4 + loc 1234567 + loc -100 + rmi WS + loc 67 + bne *1 +OK +#endif +TEST 037: test ngi WS +MAIN 0 + loc 100 + ngi WS + loc -100 + bne *1 +OK + loc -100 + ngi WS + loc 100 + bne *1 +OK +TEST 038: test sli,slu WS +MAIN 0 + loc 5 + loc 3 + sli WS + loc 40 + bne *1 +OK + loc -2 + loc 4 + sli WS + loc -32 + bne *1 +OK + loc 5 + loc 3 + slu WS + loc 40 + bne *1 +OK + loc -2 + loc 4 + slu WS + loc -32 + bne *1 +OK +TEST 039: test sri,sru WS +MAIN 0 + loc 64 + loc 5 + sri WS + loc 2 + bne *1 +OK + loc -3 + loc 2 + sri WS + loc -1 + bne *1 +OK + loc -16 + loc 3 + sri WS + loc -2 + bne *1 +OK + loc 64 + loc 5 + sru WS + loc 2 + bne *1 +OK + loc -3 + loc 2 + sru WS +#if WS == 1 + loc 63 +#endif +#if WS == 2 + loc 16383 +#endif +#if WS == 4 + loc 1073741823 +#endif + bne *1 +OK +TEST 040: test rol WS +MAIN 0 + loc 1 + loc 3 + rol WS + loc 8 + bne *1 +OK +#if WS > 1 + loc 16384 + loc WS * 8 - 1 + rol WS + loc 8192 + bne *1 +OK + loc -2 + loc WS * 8 - 1 + rol WS +#if WS == 2 + loc 32767 +#endif +#if WS == 4 + loc 2147483647 +#endif + bne *1 +OK + loc -28671 + loc 0 + rol WS + loc -28671 + bne *1 +OK +#endif +TEST 041: test ror WS +MAIN 0 + loc 4 + loc 5 + ror WS +#if WS == 1 + loc 32 +#endif +#if WS == 2 + loc 8192 +#endif +#if WS == 4 + loc 536870912 +#endif + bne *1 +OK +#if WS == 2 + loc 32767 + loc 15 + ror WS + loc -2 + bne *1 +OK +#endif + loc -28 + loc 0 + ror WS + loc -28 + bne *1 +OK +TEST 042: test inc +MAIN 0 + loc 20 + inc + loc 21 + bne *1 +OK + loc -50 + inc + loc -49 + bne *1 +OK +TEST 043: test dec +MAIN 0 + loc 66 + dec + loc 65 + bne *1 +OK + loc -44 + dec + loc -45 + bne *1 +OK +TEST 044: test adp +MAIN 20 + lal -10 + adp -2 + lal -12 + cmp + zne *1 +OK + loc 519 + lal -11 + sti 1 + lal -12 + adp 1 + loi 1 + loc 7 + bne *1 +OK +TEST 045: test inn WS +MAIN 0 + loc 8 + loc 3 + inn WS + loc 1 + bne *1 +OK + loc 8 + loc 4 + inn WS + loc 0 + bne *1 +OK + loc 2 + loc -5 + inn WS + loc 0 + bne *1 +OK + loc -5 + loc 3 + inn WS + loc 1 + bne *1 +OK +TEST 046: test inn ? +MAIN 0 + loc 8 + loc 3 + loc WS + inn ? + loc 1 + bne *1 +OK + loc 8 + loc 4 + loc WS + inn ? + loc 0 + bne *1 +OK + loc 2 + loc -5 + loc WS + inn ? + loc 0 + bne *1 +OK + loc -5 + loc 3 + loc WS + inn ? + loc 1 + bne *1 +OK +TEST 047: test set +MAIN 0 + loc 3 + set WS + loc 8 + bne *1 +OK + loc 6 + set 2*WS + loc 64 + bne *1 + loc 0 + bne *1 +OK + loc 0 + set 4*WS + loc 1 + bne *1 + loc 0 + bne *1 + loc 0 + bne *1 + loc 0 + bne *1 +OK +TEST 048: test set ? +MAIN 0 + loc 3 + loc WS + set ? + loc 8 + bne *1 +OK + loc 6 + loc 2*WS + set ? + loc 64 + bne *1 + loc 0 + bne *1 +OK + loc 0 + loc 4*WS + set ? + loc 1 + bne *1 + loc 0 + bne *1 + loc 0 + bne *1 + loc 0 + bne *1 +OK +TEST 049: test aar +a049 + rom 5,2,4 +b049 + con 5,2,1 +MAIN 20 + lal -12 + loc 5 + lae a049 + aar WS + lal -12 + cmp + zne *1 +OK + lal -11 + loc 7 + lae b049 + aar WS + lal -9 + cmp + zne *1 +OK +TEST 050: test aar ? +a050 + rom 5,2,4 +b050 + con 5,2,1 +MAIN 20 + lal -12 + loc 5 + lae a050 + loc WS + aar ? + lal -12 + cmp + zne *1 +OK + lal -11 + loc 7 + lae b050 + loc WS + aar ? + lal -9 + cmp + zne *1 +OK +TEST 051: test lar +a051 + rom 5,2,2*WS +b051 + con 5,2,1 +MAIN 20 + loc 40 + loc 41 + sdl -12+(2*WS) + lal -12 + loc 6 + lae a051 + lar WS + loc 41 + bne *1 + loc 40 + bne *1 +OK + loc 42 + lal -9 + sti 1 + lal -11 + loc 7 + lae b051 + lar WS + lal -9 + loi 1 + bne *1 +OK +TEST 052: test lar ? +a052 + rom 5,2,2*WS +b052 + con 5,2,1 +MAIN 20 + loc 40 + loc 41 + sdl -12+(2*WS) + lal -12 + loc 6 + lae a052 + loc WS + lar ? + loc 41 + bne *1 + loc 40 + bne *1 +OK + loc 42 + lal -9 + sti 1 + lal -11 + loc 7 + lae b052 + loc WS + lar ? + lal -9 + loi 1 + bne *1 +OK +TEST 053: test sar +a053 + rom 5,2,3*WS +b053 + con 5,2,1 +MAIN 28 : assert WS <= 8 + loc 39 + loc 40 + loc 41 + lal -28 + loc 6 + lae a053 + sar WS + lal -28+(3*WS) + loi 3*WS + loc 41 + bne *1 + loc 40 + bne *1 + loc 39 + bne *1 +OK + loc -2 + lal -11 + loc 7 + lae b053 + sar WS + lal -9 + loi 1 + loc 254 + bne *1 +OK +TEST 054: test sar ? +a054 + rom 5,2,3*WS +b054 + con 5,2,1 +MAIN 28 + loc 39 + loc 40 + loc 41 + lal -28 + loc 6 + lae a054 + loc WS + sar ? + lal -28+(3*WS) + loi 3*WS + loc 41 + bne *1 + loc 40 + bne *1 + loc 39 + bne *1 +OK + loc -2 + lal -11 + loc 7 + lae b054 + loc WS + sar ? + lal -9 + loi 1 + loc 254 + bne *1 +OK +TEST 055: test tlt +MAIN 0 + loc 1 + tlt + loc 0 + bne *1 +OK + loc 0 + tlt + loc 0 + bne *1 +OK + loc -3 + tlt + loc 1 + bne *1 +OK +TEST 056: test tle +MAIN 0 + loc 8 + tle + loc 0 + bne *1 +OK + loc 0 + tle + loc 1 + bne *1 +OK + loc -19 + tle + loc 1 + bne *1 +OK +TEST 057: test teq +MAIN 0 + loc 17 + teq + loc 0 + bne *1 +OK + loc 0 + teq + loc 1 + bne *1 +OK + loc -100 + teq + loc 0 + bne *1 +OK +TEST 058: test tne +MAIN 0 + loc 76 + tne + loc 1 + bne *1 +OK + loc 0 + tne + loc 0 + bne *1 +OK + loc -99 + tne + loc 1 + bne *1 +OK +TEST 059: test tge +MAIN 0 + loc 14 + tge + loc 1 + bne *1 +OK + loc 0 + tge + loc 1 + bne *1 +OK + loc -76 + tge + loc 0 + bne *1 +OK +TEST 060: test tgt +MAIN 0 + loc 20 + tgt + loc 1 + bne *1 +OK + loc 0 + tgt + loc 0 + bne *1 +OK + loc -66 + tgt + loc 0 + bne *1 +OK +TEST 061: test cmi WS +MAIN 0 + loc 10 + loc 20 + cmi WS + tlt + loc 1 + bne *1 +OK + loc 20 + loc 10 + cmi WS + tgt + loc 1 + bne *1 +OK + loc 44 + loc 44 + cmi WS + loc 0 + bne *1 +OK +TEST 062: test cmp, adp, cmu +MAIN 20 + lal -5 + lal -2 + cmp + tlt + loc 1 + bne *1 +OK + lal -2 + lal -5 + cmp + tle + loc 0 + bne *1 +OK + lal -2 + lal -2 + cmp + loc 0 + bne *1 +OK + lal -5 + adp 3 + lal -2 + cmp + loc 0 + bne *1 +OK + lal -5 + adp 4 + lal -2 + cmp + tge + loc 1 + bne *1 +OK + loc 6 + loc 6 + cmu WS + loc 0 + bne *1 +OK + loc 17 + loc 27 + cmu WS + tlt + loc 1 + bne *1 +OK + loc 17 + loc 6 + loc 27 + loc 6 + cmu 2*WS + tlt + loc 1 + bne *1 +OK + loc 6 + loc 27 + loc 6 + loc 17 + cmu 2*WS + tgt + loc 1 + bne *1 +OK +TEST 063: test cms +MAIN 0 + loc 6 + loc -10 + loc -125 + loc 30 + loc 6 + loc -10 + loc -126 + loc 30 + loc 4*WS + cms + tne + loc 1 + bne *1 +OK +TEST 064: test blt +MAIN 0 + loc 3 + loc 4 + blt *1064 + bra *1 +1064 + loc 4 + loc 3 + blt *1 + loc -5 + loc -4 + blt *2064 + bra *1 +2064 + loc -4 + loc -5 + blt *1 + loc 4 + loc 4 + blt *1 +OK +TEST 065: test ble +MAIN 0 + loc 3 + loc 4 + ble *1065 + bra *1 +1065 + loc 4 + loc 3 + ble *1 + loc -99 + loc -5 + ble *2065 + bra *1 +2065 + loc -99 + loc -99 + ble *3065 + bra *1 +3065 + loc 100 + loc -100 + ble *1 +OK +TEST 066: test beq +MAIN 0 + loc 3 + loc 3 + beq *1066 + bra *1 +1066 + loc 3 + loc 4 + beq *1 + loc -18 + loc -17 + beq *1 + loc 0 + loc 0 + beq *2066 + bra *1 +2066 +OK +TEST 067: test bne +MAIN 0 + loc 50 + loc 50 + bne *1 + loc 50 + loc 51 + bne *1067 + bra *1 +1067 + loc 0 + loc 0 + bne *1 +OK +TEST 068: test bge +MAIN 0 + loc 100 + loc 101 + bge *1 + loc 101 + loc 100 + bge *1068 + bra *1 +1068 + loc -100 + loc -99 + bge *1 + loc -100 + loc 100 + bge *1 + loc 0 + loc 0 + bge *2068 + bra *1 +2068 + loc 50 + loc 50 + bge *3068 + bra *1 +3068 +OK +TEST 069: test bgt +MAIN 0 + loc 3 + loc 10 + bgt *1 + loc 10 + loc 3 + bgt *1069 + bra *1 +1069 + loc -100 + loc -50 + bgt *1 + loc -100 + loc 50 + bgt *1 + loc 5 + loc 5 + bgt *1 +OK +TEST 070: test zlt +MAIN 0 + loc 4 + zlt *1 + loc -4 + zlt *1070 + bra *1 +1070 + loc 0 + zlt *1 +OK +TEST 071: test zle +MAIN 0 + loc 4 + zle *1 + loc -4 + zlt *1071 + bra *1 +1071 + loc 0 + zle *2071 + bra *1 +2071 +OK +TEST 072: test zeq +MAIN 0 + loc 4 + zeq *1 + loc -4 + zeq *1 + loc 0 + zeq *1072 + bra *1 +1072 +OK +TEST 073: test zne +MAIN 0 + loc 4 + zne *1073 + bra *1 +1073 + loc -4 + zne *2073 + bra *1 +2073 + loc 0 + zne *1 +OK +TEST 074: test zge +MAIN 0 + loc 4 + zge *1074 + bra *1 +1074 + loc -4 + zge *1 + loc 0 + zge *2074 + bra *1 +2074 +OK +TEST 075: test zgt +MAIN 0 + loc 4 + zgt *1075 + bra *1 +1075 + loc -4 + zgt *1 + loc 0 + zgt *1 +OK +TEST 076: test asp +MAIN 12 + loc 104 + loc 4 + loc 5 + loc 6 + asp 2*WS + stl -4 + loc 104 + bne *1 +OK +TEST 077: test cal +HOL 12 +MAIN 0 + cal $p077 + loe 4 + loc 34 + bne *1 +OK +PROC + pro $p077,0 + loc 34 + ste 4 + ret 0 + end +TEST 078: test cai +HOL 12 +MAIN 0 + lpi $p078 + cai + loe 4 + loc 34 + bne *1 +OK +PROC + pro $p078,0 + loc 34 + ste 4 + ret 0 + end +TEST 079: test ads WS +MAIN 20 + lal -6 + loc -2 + ads WS + lal -8 + cmp + zne *1 +OK + lal -6 + loc 2 + ads WS + lal -4 + cmp + zne *1 +OK +; test adp + lal -5 + adp 1 + lal -4 + cmp + zne *1 +OK +TEST 080: test sbs +HOL 12 +MAIN 20 + lal -4 + lal -6 + sbs WS + loc 2 + bne *1 +OK + lae 7 + lae 10 + sbs WS + loc -3 + bne *1 +OK +TEST 081: test lor +#define LB 0 +#define SP 1 +MAIN 20 + lor LB + lxl 0 + cmp + zne *1 +OK + loc 31 + lor SP + loi WS + bne *1 +OK + lor SP + lal -12 + sti PS + asp -4 + lor SP + lal -8 + sti PS + asp 4 + lal -12 + loi PS + lal -8 + loi PS + sbs WS + loc 4 + bne *1 +OK +TEST 082: test ass WS +#define SP 1 +MAIN 20 + loc 104 + loc 50 + loc 60 + loc 2*WS + ass WS + loc 104 + bne *1 +OK + lor SP + lal -8 + sti PS + loc -18 + ass WS + lor SP + lal -4 + sti PS + loc 18 + ass WS + lal -8 + loi PS + lal -4 + loi PS + sbs WS + loc 18 + bne *1 +OK +TEST 083: test blm +HOL 40 +MAIN 32 + loc 61 + ste 12 + loc 0 + stl -4 + lae 12 + lal -4 + blm WS + lol -4 + loc 61 + bne *1 +OK + loc 44 + loc 43 + loc 42 + loc 41 + lal -20 + sti 4*WS + lal -20 + lae 8 + blm 4*WS + loe 8 + loc 41 + bne *1 + loe 8+WS + loc 42 + bne *1 + loe 8+(2*WS) + loc 43 + bne *1 + loe 8+(3*WS) + loc 44 + bne *1 +OK +TEST 084: test bls WS +HOL 40 +MAIN 32 + loc 55 + stl -8+WS + loc 56 + stl -8 + lal -8 + lae 20 + loc 2*WS + bls WS + loe 20 + loc 56 + bne *1 + loe 20+WS + loc 55 + bne *1 +OK +TEST 085: test dup +MAIN 0 + loc 199 + dup WS + bne *1 +OK + loc 130 + loc 150 + dup 2*WS + loc 150 + bne *1 + loc 130 + bne *1 + loc 150 + bne *1 + loc 130 + bne *1 +OK +; test dus WS + loc 400 + loc 399 + loc 2*WS + dus WS + loc 399 + bne *1 + loc 400 + bne *1 + loc 399 + bne *1 + loc 400 + bne *1 +OK +TEST 087: test rck +a087 + con 10,14 +MAIN 12 + loc 10 + lae a087 + rck WS + inc + lae a087 + rck WS + inc + lae a087 + rck WS + inc + lae a087 + rck WS + inc + lae a087 + rck WS + stl -4 +OK +TEST 088: test csa +MAIN 20 +a088 + con *1088,4,2,*3088,*2088,*4088 + zrl -8 + loc 4 +5088 + inc + dup WS + lae a088 + csa WS + bra *1 +3088 + bra *1 +2088 + lol -8 + loc 3 + adi WS + stl -8 + bra *5088 +1088 + inl -8 + bra *6088 +4088 + lol -8 + loc 2 + adi WS + stl -8 + bra *5088 +6088 + loc 7 + bne *1 +OK + lol -8 + loc 6 + bne *1 +OK +TEST 089: test csb +MAIN 20 +b089 + rom *1089,3,-1,*3089,0,*2089,1,*4089 + loc -1 + zrl -12 +5089 + inc + dup WS + lae b089 + csb WS + bra *1 +3089 + bra *1 +2089 + lol -12 + loc 3 + adi WS + stl -12 + bra *5089 +1089 + inl -12 + bra *6089 +4089 + lol -12 + loc 2 + adi WS + stl -12 + bra *5089 +6089 + loc 2 + bne *1 +OK + lol -12 + loc 6 + bne *1 +OK +TEST 090: now test loi again, because it is so tricky +MAIN 20 + loc 256 + lal -3 + sti 1 + loc 1 + lal -4 + sti 1 + loc 517 + lal -5 + sti 1 + loc 2 + lal -6 + sti 1 + loc 1030 + lal -8 + sti 2 + loc 4 + lal -9 + sti 1 + lal -3 + loi 1 + loc 0 + bne *1 +OK + lal -3 + adp -1 + loi 1 + loc 1 + bne *1 +OK + lal -3 + adp -2 + loi 1 + loc 5 + bne *1 +OK + lal -3 + adp -3 + loi 1 + loc 2 + bne *1 +OK + lal -4 + adp -4 + loi 2 + loc 1030 + bne *1 +OK + lal -6 + adp -3 + loi 1 + loc 4 + bne *1 +OK +TEST 091: now test sti 1 again +MAIN 12 + loc 3 + loc 2 + loc 1 + loc 7 + loc 8 + loc 10 + lal -4 + sti 1 + lal -4 + adp -1 + sti 1 + lal -4 + adp -2 + sti 1 + lal -4 + adp -3 + sti 1 + lal -4 + adp -4 + sti 1 + lal -4 + adp -5 + sti 1 + lal -4 + loi 1 + loc 10 + bne *1 +OK + lal -6 + loi 1 + loc 7 + bne *1 +OK + lal -8 + loi 1 + loc 2 + bne *1 +OK +TEST 092: test ldc and cii +MAIN 0 +#ifdef W2S + ldc 0 + bne *1 +OK + ldc 1 + loc 1 + loc WS + loc W2S + cii + cmi W2S + zne *1 +OK + ldc -1 + loc -1 + loc WS + loc W2S + cii + cmi W2S + zne *1 +OK + loc -1 + ldc -1 + loc W2S + loc WS + cii + cmi WS + zne *1 +OK +#if WS == 1 + ldc -128 + loc -128 +#endif +#if WS == 2 + ldc -32768 + loc -32768 +#endif +#if WS == 4 + ldc -2147483648 + loc -2147483648 +#endif + loc WS + loc W2S + cii + cmi W2S + zne *1 +OK + ldc -1 + loc -1 + bne *1 +OK + loc -1 + bne *1 +OK + ldc 1 + zeq *1092 +; low order part on top of stack + loc 0 + bne *1 +OK + bra *2092 +; high order part on top of stack +1092 + loc 1 + bne *1 +OK +2092 +#endif +TEST 093: test cii +MAIN 0 + loc 123 + dup WS + loc WS + dup WS + cii + bne *1 +OK +#ifdef W2S + loc 0 + loc WS + loc W2S + cii + loc 0 + bne *1 + loc 0 + bne *1 +OK +; dynamically determine format of doubles + loc 1 + loc WS + loc W2S + cii + zeq *1093 +; low order part on top of stack + loc 0 + bne *1 +OK + loc -3 + loc WS + loc W2S + cii + loc -3 + bne *1 + loc -1 + bne *1 +OK + bra *2093 +; high order part on top of stack +1093 + loc 1 + bne *1 +OK + loc -3 + loc WS + loc W2S + cii + loc -1 + bne *1 + loc -3 + bne *1 +OK +2093 +#endif +TEST 094: test adi W2S +MAIN 0 +#ifdef W2S + ldc 1 + ldc 1 + adi W2S + ldc 2 + cmi W2S + zne *1 +OK + ldc 5 + ldc -6 + adi W2S + ldc -1 + cmi W2S + zne *1 +OK + ldc -1007 + ldc +999 + adi W2S + ldc -8 + cmi W2S + zne *1 +OK + ldc -1300 + ldc +1405 + adi W2S + ldc 105 + cmi W2S + zne *1 +OK + ldc -30000 + ldc -20 + adi W2S + ldc -30020 + cmi W2S + zne *1 +OK +#if WS >= 2 + ldc -100007 + ldc +99999 + adi W2S + ldc -8 + cmi W2S + zne *1 +OK + ldc -1300 + ldc +140567 + adi W2S + ldc 139267 + cmi W2S + zne *1 +OK + ldc -30000000 + ldc -20 + adi W2S + ldc -30000020 + cmi W2S + zne *1 +OK +#endif +#endif +TEST 095: test sbi W2S +MAIN 0 +#ifdef W2S + ldc 1 + ldc 1 + sbi W2S + ldc 0 + cmi W2S + zne *1 +OK + ldc 5 + ldc -6 + sbi W2S + ldc +11 + cmi W2S + zne *1 +OK + ldc -1007 + ldc +999 + sbi W2S + ldc -2006 + cmi W2S + zne *1 +OK + ldc -1300 + ldc +1405 + sbi W2S + ldc -2705 + cmi W2S + zne *1 +OK + ldc -30000 + ldc -20 + sbi W2S + ldc -29980 + cmi W2S + zne *1 +OK +#if WS >= 2 + ldc -100007 + ldc +99999 + sbi W2S + ldc -200006 + cmi W2S + zne *1 +OK + ldc -1300 + ldc +140567 + sbi W2S + ldc -141867 + cmi W2S + zne *1 +OK + ldc -30000000 + ldc -20 + sbi W2S + ldc -29999980 + cmi W2S + zne *1 +OK +#endif +#endif +TEST 096: test mli W2S +MAIN 0 +#ifdef W2S + ldc 5 + ldc 9 + mli W2S + ldc 45 + cmi W2S + zne *1 +OK + ldc 0 + ldc 10 + mli W2S + ldc 0 + cmi W2S + zne *1 +OK + ldc -99 + ldc 7 + mli W2S + ldc -693 + cmi W2S + zne *1 +OK + ldc -100 + ldc -90 + mli W2S + ldc 9000 + cmi W2S + zne *1 +OK +#if WS >= 2 + ldc 123456 + ldc 200 + mli W2S + ldc 24691200 + cmi W2S + zne *1 +OK +#endif +#endif +TEST 097: test dvi W2S +MAIN 0 +#ifdef W2S + ldc 15 + ldc 5 + dvi W2S + ldc 3 + cmi W2S + zne *1 +OK + ldc 100 + ldc -7 + dvi W2S + ldc -14 + cmi W2S + zne *1 +OK + ldc -100 + ldc 7 + dvi W2S + ldc -14 + cmi W2S + zne *1 +OK + ldc -1000 + ldc -201 + dvi W2S + ldc 4 + cmi W2S + zne *1 +OK +#if WS >= 2 + ldc 1234567 + ldc -100 + dvi W2S + ldc -12345 + cmi W2S + zne *1 +OK +#endif +#endif +TEST 098: test rmi W2S +MAIN 0 +#ifdef W2S + ldc 100 + ldc 7 + rmi W2S + ldc 2 + cmi W2S + zne *1 +OK + ldc -100 + ldc 7 + rmi W2S + ldc -2 + cmi W2S + zne *1 +OK + ldc 100 + ldc -7 + rmi W2S + ldc 2 + cmi W2S + zne *1 +OK + ldc -100 + ldc -7 + rmi W2S + ldc -2 + cmi W2S + zne *1 +OK + ldc -1000 + ldc -201 + rmi W2S + ldc -196 + cmi W2S + zne *1 +OK +#if WS >= 4 + ldc 1234567 + ldc -100 + rmi W2S + ldc 67 + cmi W2S + zne *1 +OK +#endif +#endif +TEST 099: test and +MAIN 0 + loc 68 + loc 65 + and WS + loc 64 + bne *1 +OK + loc 17 + loc 34 + loc 3 + loc 36 + and 2*WS + loc 32 + bne *1 + loc 1 + bne *1 +OK + loc 17 + loc 34 + loc 68 + loc -120 + loc 1 + loc 37 + loc 12 + loc -127 + and 4*WS + loc -128 + bne *1 + loc 4 + bne *1 + loc 32 + bne *1 + loc 1 + bne *1 +OK +TEST 100: test ior +MAIN 0 + loc 68 + loc 65 + ior WS + loc 69 + bne *1 +OK + loc 17 + loc 34 + loc 3 + loc 36 + ior 2*WS + loc 38 + bne *1 + loc 19 + bne *1 +OK + loc 17 + loc 34 + loc 68 + loc -120 + loc 1 + loc 37 + loc 12 + loc -127 + ior 4*WS + loc -119 + bne *1 + loc 76 + bne *1 + loc 39 + bne *1 + loc 17 + bne *1 +OK +TEST 101: test xor +MAIN 0 + loc 68 + loc 65 + xor WS + loc 5 + bne *1 +OK + loc 17 + loc 34 + loc 3 + loc 36 + xor 2*WS + loc 6 + bne *1 + loc 18 + bne *1 +OK + loc 17 + loc 34 + loc 68 + loc -120 + loc 1 + loc 37 + loc 12 + loc -127 + xor 4*WS + loc 9 + bne *1 + loc 72 + bne *1 + loc 7 + bne *1 + loc 16 + bne *1 +OK +TEST 102: test com +MAIN 0 + loc 68 + com WS + loc -69 + bne *1 +OK + loc 17 + loc 34 + com 2*WS + loc -35 + bne *1 + loc -18 + bne *1 +OK + loc 17 + loc 34 + loc 68 + loc -120 + com 4*WS + loc 119 + bne *1 + loc -69 + bne *1 + loc -35 + bne *1 + loc -18 + bne *1 +OK +TEST 103: test sli,slu W2S +MAIN 0 +#ifdef W2S + ldc 5 + loc 3 + sli W2S + ldc 40 + cmi W2S + zne *1 +OK + ldc -2 + loc 4 + sli W2S + ldc -32 + cmi W2S + zne *1 +OK + ldc 5 + loc 3 + slu W2S + ldc 40 + cmi W2S + zne *1 +OK + ldc -2 + loc 4 + slu W2S + ldc -32 + cmi W2S + zne *1 +OK +#endif +TEST 104: test sri,sru W2S +MAIN 0 +#ifdef W2S + ldc 64 + loc 5 + sri W2S + ldc 2 + cmi W2S + zne *1 +OK + ldc -3 + loc 2 + sri W2S + ldc -1 + cmi W2S + zne *1 +OK + ldc -16 + loc 3 + sri W2S + ldc -2 + cmi W2S + zne *1 +OK + ldc 64 + loc 5 + sru W2S + ldc 2 + cmi W2S + zne *1 +OK + ldc -3 + loc 2 + sru W2S +#if W2S == 2 + ldc 16383 +#endif +#if W2S == 4 + ldc 1073741823 +#endif + cmi W2S + zne *1 +OK +#endif +TEST 105: common test of double arithmetic +MAIN 0 +#ifdef W2S + ldc 1000 + ldc 10 + mli W2S + ldc 4 + dvi W2S + ldc 1500 + adi W2S + ldc 2856 + sbi W2S + ldc 100 + rmi W2S + ldc 44 + cmi W2S + zne *1 +OK +#endif +TEST 106: test cmi W2S +MAIN 0 +#if W2S==2 + ldc 64 + ldc 4 + mli W2S + ldc 63 + ldc 4 + mli W2S + cmi W2S + tge + loc 1 + bne *1 +OK +#endif +#if W2S==4 + ldc 16384 + ldc 4 + mli W2S + ldc 16383 + ldc 4 + mli W2S + cmi W2S + tge + loc 1 + bne *1 +OK +#endif +TEST 107: test cii W2S -> WS +MAIN 0 +#ifdef W2S + ldc 100 + loc W2S + loc WS + cii + loc 100 + bne *1 +OK + ldc 5000 + ldc -6 + mli W2S + ldc 1000 + dvi W2S + loc W2S + loc WS + cii + loc -30 + bne *1 +OK +#endif +TEST 108: test cif, cfi, adf FS +MAIN 0 +#ifdef FS + loc 100 + loc WS + loc FS + cif + loc 44 + loc WS + loc FS + cif + adf FS + loc FS + loc WS + cfi + loc 144 + bne *1 +OK + loc 65 + loc WS + loc FS + cif + loc -65 + loc WS + loc FS + cif + adf FS + loc FS + loc WS + cfi + loc 0 + bne *1 +OK +#endif +TEST 109: test cdf, cfd +MAIN 0 +#ifdef FS +#ifdef W2S + loc 55 + loc WS + loc W2S + cii + loc W2S + loc FS + cif + loc 55 + loc WS + loc FS + cif + cmf FS + zne *1 +OK + loc 24 + loc WS + loc FS + cif + loc FS + loc W2S + cfi + loc W2S + loc WS + cii + loc 24 + bne *1 +OK + loc 57 + loc WS + loc FS + cif + loc FS + loc W2S + cfi + loc W2S + loc WS + cii + loc 57 + bne *1 +OK + loc 40 + loc WS + loc W2S + cii + loc W2S + loc FS + cif + loc FS + loc WS + cfi + loc 40 + bne *1 +OK +#endif +#endif +TEST 110: test sbf FS +MAIN 0 +#ifdef FS + loc 100 + loc WS + loc FS + cif + loc 50 + loc WS + loc FS + cif + sbf FS + loc FS + loc WS + cfi + loc 50 + bne *1 +OK + loc 32 + loc WS + loc FS + cif + loc 101 + loc WS + loc FS + cif + sbf FS + loc -69 + loc WS + loc FS + cif + cmf FS + zne *1 +OK +#endif +TEST 111: test mlf FS +MAIN 0 +#ifdef FS + loc 4 + loc WS + loc FS + cif + loc 20 + loc WS + loc FS + cif + mlf FS + loc FS + loc WS + cfi + loc 80 + bne *1 +OK + loc -12 + loc WS + loc FS + cif + loc -9 + loc WS + loc FS + cif + mlf FS + loc FS + loc WS + cfi + loc 108 + bne *1 +OK +#endif +TEST 112: test dvf FS +MAIN 0 +#ifdef FS + loc 45 + loc WS + loc FS + cif + loc 9 + loc WS + loc FS + cif + dvf FS + loc 5 + loc WS + loc FS + cif + cmf FS + zne *1 +OK + loc -60 + loc WS + loc FS + cif + loc 7 + loc WS + loc FS + cif + dvf FS + loc FS + loc WS + cfi + loc -8 + bne *1 +OK +#endif +TEST 113: test fractions using FS floating arithmetic +MAIN 0 +#ifdef FS + loc 7 + loc WS + loc FS + cif + loc 2 + loc WS + loc FS + cif + dvf FS + loc FS + loc WS + cfi + loc 3 + bne *1 +OK + loc -7 + loc WS + loc FS + cif + loc 2 + loc WS + loc FS + cif + dvf FS + loc FS + loc WS + cfi + loc -3 + bne *1 +OK + loc 11 + loc WS + loc FS + cif + loc 2 + loc WS + loc FS + cif + dvf FS + loc 5 + loc WS + loc FS + cif + mlf FS + loc 4 + loc WS + loc FS + cif + mlf FS + loc 110 + loc WS + loc FS + cif + cmf FS + zne *1 +OK +#endif +TEST 114: test cif, cfi, adf F2S +MAIN 0 +#ifdef F2S + loc 10 + loc WS + loc F2S + cif + loc 44 + loc WS + loc F2S + cif + adf F2S + loc F2S + loc WS + cfi + loc 54 + bne *1 +OK + loc 65 + loc WS + loc F2S + cif + loc -65 + loc WS + loc F2S + cif + adf F2S + loc F2S + loc WS + cfi + loc 0 + bne *1 +OK +#endif +TEST 115: test cif, cfi W2S F2S +MAIN 0 +#ifdef F2S +#ifdef W2S + loc 55 + loc WS + loc W2S + cii + loc W2S + loc F2S + cif + loc 55 + loc WS + loc F2S + cif + cmf F2S + zne *1 +OK + loc 24 + loc WS + loc F2S + cif + loc F2S + loc W2S + cfi + loc W2S + loc WS + cii + loc 24 + bne *1 +OK + loc 57 + loc WS + loc F2S + cif + loc F2S + loc W2S + cfi + loc W2S + loc WS + cii + loc 57 + bne *1 +OK + loc 41 + loc WS + loc W2S + cii + loc W2S + loc F2S + cif + loc F2S + loc WS + cfi + loc 41 + bne *1 +OK +#endif +#endif +TEST 116: test sbf F2S +MAIN 0 +#ifdef F2S + loc 100 + loc WS + loc F2S + cif + loc 50 + loc WS + loc F2S + cif + sbf F2S + loc F2S + loc WS + cfi + loc 50 + bne *1 +OK + loc 32 + loc WS + loc F2S + cif + loc 101 + loc WS + loc F2S + cif + sbf F2S + loc -69 + loc WS + loc F2S + cif + cmf F2S + zne *1 +OK +#endif +TEST 117: test fmu F2S +MAIN 0 +#ifdef F2S + loc 4 + loc WS + loc F2S + cif + loc 20 + loc WS + loc F2S + cif + mlf F2S + loc F2S + loc WS + cfi + loc 80 + bne *1 +OK + loc -20 + loc WS + loc F2S + cif + loc -6 + loc WS + loc F2S + cif + mlf F2S + loc F2S + loc WS + cfi + loc 120 + bne *1 +OK +#endif +TEST 118: test dvf F2S +MAIN 0 +#ifdef F2S + loc 45 + loc WS + loc F2S + cif + loc 9 + loc WS + loc F2S + cif + dvf F2S + loc 5 + loc WS + loc F2S + cif + cmf F2S + zne *1 +OK + loc -60 + loc WS + loc F2S + cif + loc 7 + loc WS + loc F2S + cif + dvf F2S + loc F2S + loc WS + cfi + loc -8 + bne *1 +OK +#endif +TEST 119: test fractions using F2S floating arithmetic +MAIN 0 +#ifdef F2S + loc 7 + loc WS + loc F2S + cif + loc 2 + loc WS + loc F2S + cif + dvf F2S + loc F2S + loc WS + cfi + loc 3 + bne *1 +OK + loc -7 + loc WS + loc F2S + cif + loc 2 + loc WS + loc F2S + cif + dvf F2S + loc F2S + loc WS + cfi + loc -3 + bne *1 +OK + loc 11 + loc WS + loc F2S + cif + loc 2 + loc WS + loc F2S + cif + dvf F2S + loc 5 + loc WS + loc F2S + cif + mlf F2S + loc 4 + loc WS + loc F2S + cif + mlf F2S + loc 110 + loc WS + loc F2S + cif + cmf F2S + zne *1 +OK +#endif +TEST 120: test cal +HOL 12 +MAIN 0 + loc 0 + ste 4 + cal $p120 + loe 4 + loc 34 + bne *1 +OK +PROC + pro $p120,0 + loc 34 + ste 4 + ret 0 + end +TEST 121: test cal +MAIN 0 + cal $p121 + lfr WS + loc 7 + bne *1 +OK +PROC + pro $p121,0 + loc 7 + ret WS + end +TEST 122: test cal +MAIN 0 + loc 7 + cal $p122 + asp WS + lfr WS + loc 7 + bne *1 +OK +PROC + pro $p122,0 + lol 0 + ret WS + end +TEST 123: test cal +MAIN 4 + loc 7 + stl -4 + lor 0 + cal $p123 + asp PS + lfr WS + loc 7 + bne *1 +OK + lxl 0 + cal $p123 + asp PS + lfr WS + loc 7 + bne *1 +OK +PROC + pro $p123,0 + lxl 1 + lof -4 + ret WS + end +TEST 124: test cal +MAIN 0 + loc 7 + cal $p124 + asp WS +PROC + pro $p124,0 + lol 0 + loc 7 + bne *1 +OK + ret 0 +ERRLAB + end +TEST 125: test cal +MAIN 4 + loc 10 + stl -WS + loc 90 + lxl 0 + cal $p1125 + asp PS+WS +OK +PROC + pro $p1125,WS + lol PS + loc 90 + bne *1 +OK + loc 11 + stl -WS + loc 21 + loc 91 + lxl 0 + cal $p2125 + asp PS+WS + lfr WS +OK + loc 82 + bne *1 +OK + loc 21 + bne *1 +OK + ret 0 +ERRLAB + end + pro $p2125,0 + lol PS + loc 91 + bne *1 +OK + loc 12 + loc 92 + lxl 0 + cal $p3125 + asp PS+WS + lfr WS+WS +OK + loc 86 + bne *1 + loc 83 + bne *1 +OK + loc 12 + bne *1 +OK + lal PS + loi WS + loc 91 + bne *1 +OK + loc 82 + ret WS +ERRLAB + end + pro $p3125,WS + lol PS + loc 92 + bne *1 +OK + loc 13 + stl -WS + lxa 0 + adp PS + loi WS + loc 92 + bne *1 +OK + lxa 1 + adp PS + loi WS + loc 91 + bne *1 +OK + lxa 2 + adp PS + loi WS + loc 90 + bne *1 +OK + lxl 2 + lof -WS + loc 11 + bne *1 +OK + lxl 3 + adp -WS + loi WS + loc 10 + bne *1 +OK + loc 83 + lxl 1 + cal $p4125 + asp PS + lxl 2 + cal $p5125 + asp PS + lxl 3 + cal $p6125 + asp PS + lfr WS + ret WS+WS +ERRLAB + end + pro $p4125,0 + lxa 1 + adp PS + loi WS + loc 91 + bne *1 +OK + ret 0 +ERRLAB + end + pro $p5125,0 + lxa 1 + adp PS + loi WS + loc 90 + bne *1 +OK + ret 0 +ERRLAB + end + pro $p6125,0 + lxl 1 + adp -WS + loi WS + loc 10 + bne *1 +OK + loc 86 + ret WS +ERRLAB + end +TEST 126: test bra +MAIN 0 + bra *0126 + bra *1 +9126 + bra *8126 +0126 + bra *6126 + bra *1 +1126 + bra *5126 + bra *1 +2126 + bra *4126 + bra *1 +3126 + bra *7126 + bra *1 +4126 + bra *3126 + bra *1 +5126 + bra *2126 + bra *1 +6126 + bra *1126 + bra *1 +7126 + bra *9126 + bra *1 +8126 +OK +TEST 127: test ret and lfr +a127 + bss 4,0,0 +MAIN 0 +; return nothing + loc 123 + cal $retw0 + loc 123 + bne *1 +OK +; return single word + cal $retw1 + lfr WS + loc 45 + bne *1 +OK +; return single pointer + cal $retp1 + lfr PS + lae a127 + cmp + zne *1 +OK +; return procedure instance identifier (two pointers) +; this value may not be disturbed by ASP + lxl 0 + cal $retp2 + asp PS + lfr 2*PS + lpi $retp2 + cmp + zne *1 + lxl 0 + cmp + zne *1 +OK +; same as above but with ASS instead of ASP + lxl 0 + cal $retp2 + loc PS + ass WS + lfr 2*PS + lpi $retp2 + cmp + zne *1 + lxl 0 + cmp + zne *1 +OK +PROC + pro $retw0,0 + ret 0 + end + pro $retw1,0 + loc 45 + ret WS + end + pro $retp1,0 + lae a127 + ret PS + end + pro $retp2,0 + lxl 1 + lpi $retp2 + ret 2*PS + end diff --git a/etc/Makefile b/etc/Makefile new file mode 100644 index 00000000..75194fd9 --- /dev/null +++ b/etc/Makefile @@ -0,0 +1,26 @@ +d=.. +h=$d/h +c=$d/util/data + +FILES= \ +$h/em_spec.h \ +$h/em_pseu.h \ +$h/em_mnem.h \ +$c/em_flag.c \ +$c/em_pseu.c \ +$c/em_mnem.c + +$(FILES): em_table + new_table $h $c + +install: $(FILES) + +opr: + make pr ^ opr +pr: + @pr Makefile em_table new_table pop_push traps + +clean: + -rm -f *.old + +cmp : # do nothing diff --git a/etc/em_table b/etc/em_table new file mode 100644 index 00000000..8dd963bb --- /dev/null +++ b/etc/em_table @@ -0,0 +1,175 @@ +magic 173 +fmnem 1 +nmnem 149 +fpseu 150 +npseu 30 +filb0 180 +nilb0 60 +fcst0 0 +zcst0 120 +ncst0 240 +fspec 240 +nspec 16 +ilb1 240 +ilb2 241 +dlb1 242 +dlb2 243 +dnam 244 +cst2 245 +cst4 246 +cst8 247 +doff 248 +pnam 249 +scon 250 +icon 251 +ucon 252 +fcon 253 +cend 255 + +bss 0 +con 1 +end 2 +exa 3 +exc 4 +exp 5 +hol 6 +ina 7 +inp 8 +mes 9 +pro 10 +rom 11 + +aar w- -p-a-p+p +adf w- -a-a+a +adi w- -a-a+a +adp f- -p+p +ads w- -a-p+p +adu w- -a-a+a +and w- -a-a+a +asp f- -a +ass w- -a-x +beq bc -w-w +bge bc -w-w +bgt bc -w-w +ble bc -w-w +blm z- -p-p +bls w- -a-p-p +blt bc -w-w +bne bc -w-w +bra bt 0 +cai -p -p +cal pp 0 +cff -- -w-w-y+x +cfi -- -w-w-y+x +cfu -- -w-w-y+x +cif -- -w-w-y+x +cii -- -w-w-y+x +ciu -- -w-w-y+x +cmf w- -a-a+w +cmi w- -a-a+w +cmp -- -p-p+w +cms w- -a-a+w +cmu w- -a-a+w +com w- -a-a+a +csa wt -p-a +csb wt -p-a +cuf -- -w-w-y+x +cui -- -w-w-y+x +cuu -- -w-w-y+x +dch -- -p+p +dec -- -w+w +dee g- 0 +del l- 0 +dup s- -a+a+a +dus w- -a-x+x+x +dvf w- -a-a+a +dvi w- -a-a+a +dvu w- -a-a+a +exg w- -a-a+a+a +fef w- -a+a+w +fif w- -a-a+a+a +fil g- 0 +gto gt -p-? +inc -- -w+w +ine g- 0 +inl l- 0 +inn w- -w-a+w +ior w- -a-a+a +lae g- +p +lal l- +p +lar w- -p-a-p+? +ldc d- +d +lde g- +d +ldf f- -p+d +ldl l- +d +lfr s- +a +lil l- +w +lim -- +w +lin n- 0 +lni -- 0 +loc c- +w +loe g- +w +lof f- -p+w +loi o- -p+a +lol l- +w +lor r- +p +los w- -a-p+x +lpb -- -p+p +lpi p- +p +lxa n- +p +lxl n- +p +mlf w- -a-a+a +mli w- -a-a+a +mlu w- -a-a+a +mon -- -?+? +ngf w- -a+a +ngi w- -a+a +nop -- 0 +rck w- -p-a+a +ret zt -a-? +rmi w- -a-a+a +rmu w- -a-a+a +rol w- -w-a+a +ror w- -w-a+a +rtt -t -? +sar w- -p-a-p-? +sbf w- -a-a+a +sbi w- -a-a+a +sbs w- -p-p+a +sbu w- -a-a+a +sde g- -d +sdf f- -p-d +sdl l- -d +set w- -w+a +sig -- -p-p+p+p +sil l- -w +sim -- -w +sli w- -w-a+a +slu w- -w-a+a +sri w- -w-a+a +sru w- -w-a+a +ste g- -w +stf f- -p-w +sti o- -p-a +stl l- -w +str r- -p +sts w- -a-p-x +teq -- -w+w +tge -- -w+w +tgt -- -w+w +tle -- -w+w +tlt -- -w+w +tne -- -w+w +trp -p -w+? +xor w- -a-a+a +zeq bc -w +zer w- +a +zge bc -w +zgt bc -w +zle bc -w +zlt bc -w +zne bc -w +zre g- 0 +zrf w- +a +zrl l- 0 + diff --git a/etc/ip_spec.t b/etc/ip_spec.t new file mode 100644 index 00000000..cc8537d6 --- /dev/null +++ b/etc/ip_spec.t @@ -0,0 +1,352 @@ +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 diff --git a/etc/new_table b/etc/new_table new file mode 100755 index 00000000..ef83ccb0 --- /dev/null +++ b/etc/new_table @@ -0,0 +1,71 @@ +h=${1-.} +d=${2-.} + +set `grep fpseu em_table` +p=$2 +set `grep fmnem em_table` +m=$2 + +ed - em_table <<'A' > X +1,/^$/g/ /s// /gp +A + +ed - em_table <<'A' | awk '{print $1,$2+'$p'}' > Y +1,/^$/d +1,/^$/g/ /s// /gp +A + +ed - em_table <<'A' | awk '{print $0,'$m'+i++}' > Z +1,/^$/d +1,/^$/d +1,/^$/g/ /s// /gp +A + +i=`wc -l >X +i=`wc -l >X + +ed - X <<'A' > $h/em_spec.h +g/^/s//#define sp_/p +A + +ed - Y <<'A' > $h/em_pseu.h +g/\(.*\) \(.*\)/s//#define ps_\1 \2/p +A + +ed - Z <<'A' > $h/em_mnem.h +g/ .* /s// / +g/\(.*\) \(.*\)/s//#define op_\1 \2/p +A + +( +echo 'char em_pseu[][4] = {' +ed - Y <<'A' +g/\(...\).*/s// "\1",/p +A +echo '};' +) > $d/em_pseu.c + +( +echo 'char em_mnem[][4] = {' +ed - Z <<'A' +g/\(...\).*/s// "\1",/p +A +echo '};' +) > $d/em_mnem.c + +( +echo '#include +char em_flag[] = {' +ed - Z <<'A' | tr a-z A-Z +g/^... /s/// +g/ .*/s/// +g/\(.\)\(.\)/s//PAR_\1 | FLO_\2/ +g/-/s//NO/g +g/.*/s// &,/p +A +echo '};' +) > $d/em_flag.c + +rm X Y Z diff --git a/etc/pc_errors b/etc/pc_errors new file mode 100644 index 00000000..688e4b37 --- /dev/null +++ b/etc/pc_errors @@ -0,0 +1,289 @@ +non-standard feature used +identifier '%s' declared twice +end of file encountered +bad line directive +unsigned real: digit of fraction expected +unsigned real: digit of exponent expected +unsigned real: too many digits (>72) +unsigned integer: too many digits (>72) +unsigned integer: overflow (>32767) +string constant: must not exceed one line +string constant: at least one character expected +string constant: double quotes not allowed (see c option) +string constant: too long (>72 chars) +bad character +identifier '%s' not declared +location counter overflow: arrays too big +location counter overflow: arrays too big +arraysize too big +variable '%s' never used +variable '%s' never assigned +the files contained in '%s' are not closed automatically +constant expected +constant: only integers and reals may be signed +constant: out of bounds +simple type expected +enumerated type: element identifier expected +enumerated type: ',' or ')' expected +enumerated type: ',' expected +enumerated type: ')' expected +subrange type: type must be scalar, but not real +subrange type: '..' expected +subrange type: type of lower and upper bound incompatible +subrange type: lower bound exceeds upper bound +array type: '[' expected +conformant array: low bound identifier expected +conformant array: '..' expected +conformant array: high bound identifier expected +conformant array: ':' expected +conformant array: index type identifier expected +array type: index type not bounded +array type: index separator or ']' expected +array type: index separator expected +array type: ']' expected +array type: 'of' expected +record variant part: tag type identifier expected +record variant part: tag type identifier expected +record variant part: type must be bounded +record variant part: 'of' expected +record variant: type of case label and tag incompatible +record variant: multiple defined case label +record variant: ',' or ':' expected +record variant: ',' expected +record variant: ':' expected +record variant: '(' expected +record variant: ')' expected +record variant part: ';' or end of variant list expected +record variant part: ';' expected +record variant part: end of variant list expected +record variant part: there must be a variant for each tag value +field list: record section expected +record section: field identifier expected +record section: ',' or ':' expected +record section: ',' expected +record section: ':' expected +field list: ';' or end of record section list expected +field list: ';' expected +field list: end of record section list expected +type expected +type: simple and pointer type may not be packed +pointer type: type identifier expected +pointer type: type identifier expected +record type: 'end' expected +set type: 'of' expected +set type: too many elements in set +set type: bad subrange of integer +set of integer: the i option dictates the number of bits (default 16) +set type: base type not bounded +file type: 'of' expected +file type: files within files not allowed +var parameter: type identifier or conformant array expected +var parameter: type identifier expected +label declaration: unsigned integer expected +label declaration: label '%i' multiple declared +label declaration: ',' or ';' expected +label declaration: ',' expected +label declaration: ';' expected +const declaration: constant identifier expected +const declaration: '=' expected +const declaration: ';' expected +const declaration: constant identifier or 'type', 'var', 'procedure', 'function' or 'begin' expected +type declaration: type identifier expected +type declaration: '=' expected +type declaration: ';' expected +type declaration: type identifier or 'var', 'procedure', 'function' or 'begin' expected +var declaration: var identifier expected +var declaration: ',' or ':' expected +var declaration: ',' expected +var declaration: ':' expected +var declaration: ';' expected +var declaration: var identifier or 'procedure', 'function' or 'begin' expected +parameter list: 'var','procedure','function' or identifier expected +parameter list: parameter identifier expected +parameter list: ',' or ':' expected +parameter list: ',' expected +parameter list: ':' expected +parameter list: type identifier expected +parameter list: ';' or ')' expected +parameter list: ';' expected +proc/func declaration: proc/func identifier expected +proc/func declaration: previous declaration of '%s' was not forward +proc/func declaration: parameter list expected +parameterlist: ')' expected +func declaration: ':' expected +func declaration: result type identifier expected +func declaration: result type must be scalar, subrange or pointer +proc/func declaration: ';' expected +proc/func declaration: block or directive expected +proc/func declaration: '%s' unknown directive +proc/func declaration: '%s' again forward declared +proc/func declaration: ';' expected +indexed variable: '[' only allowed following array variables +indexed variable: index type not compatible with declaration +indexed variable: ',' or ']' expected +indexed variable: ',' expected +assignment: standard function not allowed as destination +assignment: cannot store the function result +assignment: formal parameter function not allowed as destination +assignment: function identifier may not be de-referenced +variable: '[', '.', '^' or end of variable expected +indexed variable: ']' expected +field designator: field identifier expected +field designator: '.' only allowed following record variables +field designator: no field '%s' in this record +referenced variable: '^' not allowed following zero-terminated strings +referenced variable: '^' only allowed following pointer or file variables +variable: var or field identifier expected +call: too many actual parameters supplied +call: proc/func identifier expected +call: standard proc/func may not be used as parameter +call: parameter lists of actual and formal proc/func incompatible +call: type of actual and formal value parameter not compatible +call: array parameter not conformable +call: type of actual and formal variable parameter not similar +call: packed elements not allowed as variable parameter +call: ',' or ')' expected +call: too few actual parameters supplied +read(ln): type must be integer, char or real +write(ln): type must be integer, char, real, string or boolean +write(ln): ':', ',' or ')' expected +write(ln): field width must be integer +write(ln): ':', ',' or ')' expected +write(ln): precision must be integer +write(ln): precision may only be specified for reals +read/write: too few actual parameters supplied +read/write: standard input/output not mentioned in program heading +read/write: ',' or ')' expected +read/write: type of parameter not the same as that of the file elements +read/write: parameter list expected +readln/writeln: standard input/output not mentioned in program heading +readln/writeln: only allowed on text files +new/dispose: C-type strings not allowed here +new/dispose: ',' or ')' expected +new/dispose: too many actual parameters supplied +new/dispose: type of tagfield value is incompatible with declaration +call: '(' or end of call expected +standard proc/func: parameter list expected +standard input/output not mentioned in program heading +file variable expected +pointer variable expected +pack: ',' expected +pack: ',' expected +unpack: ',' expected +unpack: ',' expected +standard proc/func: parameter type incompatible with specification +eoln/page: text file variable expected +pack/unpack: array types are incompatible +pack/unpack: only for arrays +abs: integer or real expected +sqr: integer or real expected +ord: type must be scalar or subrange, but not real +pred/succ: type must be scalar or subrange, but not real +trunc/round: real argument required +call: ')' expected +expression: left and right operand are incompatible +set: incompatible elements +set: base type must be bounded or of type integer +set: base type upper bound exceeds maximum set element number +set: element out of range +set: ']' or element list expected +set: '..', ',' or ']' expected +set: ',' or ']' expected +set: ',' expected +factor expected +factor: ')' expected +factor: type of factor must be boolean +set: ']' expected +term: multiplying operator or end of term expected +term: '*' only defined for integers, reals and sets +term: '/' only defined for integers and reals +term: 'div' only defined for integers +term: 'mod' only defined for integers +term: 'and' only defined for booleans +simple expression: only integers and reals may be signed +simple expression: adding operator or end of simple expression expected +simple expression: '+' only defined for integers, reals and sets +simple expression: '-' only defined for integers, reals and sets +simple expression: 'or' only defined for booleans +expression: relational operator or end of expression expected +expression: set expected +expression: left operand of 'in' not compatible with base type of right operand +expression: only '=' and '<>' allowed on pointers +expression: '<' and '>' not allowed on sets +expression: comparison of arrays only allowed for strings +expression: comparison of records not allowed +expression: comparison of files not allowed +assignment: ':=' expected +assignment: left and right hand side incompatible +goto statement: unsigned integer expected +goto statement: label '%i' not declared +if statement: type of expression must be boolean +if statement: 'then' expected +if statement: 'else' or end of if statement expected +case statement: type must be scalar or subrange, but not real +case statement: 'of' expected +case statement: incompatible case label +case statement: multiple defined case label +case statement: ',' or ':' expected +case statement: ',' expected +case statement: ':' expected +case statement: ';' or 'end' expected +case statement: ';' expected +case statement: 'end' expected +repeat statement: ';' or 'until' expected +repeat statement: ';' expected +repeat statement: 'until' expected +repeat statement: type of expression must be boolean +while statement: type of expression must be boolean +while statement: 'do' expected +for statement: type of bound and control variable incompatible +for statement: control variable expected +for statement: control variable must be local +for statement: type must be scalar or subrange, but not real +for statement: ':=' expected +for statement: 'to' or 'downto' expected +for statement: upper bound not assignment compatible +for statement: 'do' expected +with statement: record variable expected +with statement: ',' or 'do' expected +with statement: ',' expected +with statement: 'do' expected +assertion: type of expression must be boolean +statement expected +label '%i' not declared +label '%i' multiple defined +statement: ':' expected +unlabeled statement expected +compound statement: ';' or 'end' expected +compound statement: ';' expected +compound statement: 'end' expected +case statement: 'end' expected +body: ';' or 'end' expected +body: ';' expected +body: label '%i' declared, but never defined +program parameter '%s' not declared +function '%s' never assigned +block: declaration or body expected +block: 'const', 'type', 'var', 'procedure', 'function' or 'begin' expected +block: 'type', 'var', 'procedure', 'function' or 'begin' expected +block: 'var', 'procedure', 'function' or 'begin' expected +block: 'procedure', 'function' or 'begin' expected +block: unsatisfied forward proc/func declaration(s) +block: 'begin' expected +block: 'end' expected +program heading: 'program' expected +program heading: program identifier expected +program heading: file identifier list expected +program heading: file identifier expected +program heading: ',' or ')' expected +program heading: ',' expected +program heading: maximum number of file arguments exceeded (12) +program heading: ')' expected +program heading: ';' expected +program: '.' expected +'program' expected +module: 'const', 'type', 'var', 'procedure' or 'function' expected +module: 'type', 'var', 'procedure' or 'function' expected +module: 'var', 'procedure' or 'function' expected +module: 'procedure' or 'function' expected +garbage at end of program diff --git a/etc/pc_rt_errors b/etc/pc_rt_errors new file mode 100644 index 00000000..53060496 --- /dev/null +++ b/etc/pc_rt_errors @@ -0,0 +1,107 @@ +array bound error +range bound error +set bound error +integer overflow +real overflow +real underflow +divide by 0 +divide by 0.0 +undefined integer +real undefined +conversion error +error 11 +error 12 +error 13 +error 14 +error 15 +stack overflow +heap error +illegal instruction +odd or zero byte count +case error +memory fault +bad pointer +bad program counter +bad external address +bad monitor call +bad line number +error 27 +error 28 +error 29 +error 30 +error 31 +error 32 +error 33 +error 34 +error 35 +error 36 +error 37 +error 38 +error 39 +error 40 +error 41 +error 42 +error 43 +error 44 +error 45 +error 46 +error 47 +error 48 +error 49 +error 50 +error 51 +error 52 +error 53 +error 54 +error 55 +error 56 +error 57 +error 58 +error 59 +error 60 +error 61 +error 62 +error 63 +more args expected +error in exp +error in ln +error in sqrt +assertion failed +array bound error in pack +array bound error in unpack +only positive j in 'i mod j' +file not yet open +dispose error +error 74 +error 75 +error 76 +error 77 +error 78 +error 79 +error 80 +error 81 +error 82 +error 83 +error 84 +error 85 +error 86 +error 87 +error 88 +error 89 +error 90 +error 91 +error 92 +error 93 +error 94 +error 95 +not writable +not readable +end of file +truncated +reset error +rewrite error +close error +read error +write error +digit expected +non-ASCII char read diff --git a/etc/pop_push b/etc/pop_push new file mode 100644 index 00000000..478f9678 --- /dev/null +++ b/etc/pop_push @@ -0,0 +1,15 @@ +description of third column of em_table: + + -: pop item indicated by next character + +: push item indicated by next character + 0: no effect on the stack + +characters describing items: + + w: target machine word (1, 2 or 4) + d: double target machine word (2, 4 or 8) + p: target machine address + a: item with size specified in argument + x: item with size specified by top item of stack + y: item with size specified by second item on stack + ?: one or more items of unknown size diff --git a/etc/traps b/etc/traps new file mode 100644 index 00000000..858cf618 --- /dev/null +++ b/etc/traps @@ -0,0 +1,28 @@ +~ Array bound error +~ Range bound error +~ Set bound error +~ Integer overflow +~ Floating overflow +~ Floating underflow +~ Divide by 0 +~ Divide by 0.0 +~ Integer undefined +~ Floating undefined +~ Conversion error + + + + + +* Stack overflow +* Heap overflow +* Illegal instruction +* Illegal odd or zero argument +* Case error +* Addressing non existent memory +* Bad pointer used +* Program counter out of range +* Bad argument of LAE +* Bad monitor call +* Argument of LIN too high +* Bad GTO descriptor diff --git a/first/ckpath b/first/ckpath new file mode 100644 index 00000000..2829749c --- /dev/null +++ b/first/ckpath @@ -0,0 +1,32 @@ +rm -f ../bin/x_tpath x_tpath +echo "echo $$" >../bin/x_tpath +rm -f x_tpath +chmod +x ../bin/x_tpath +case x`(x_tpath) 2>/dev/null` +in +x$$) + STAT=0 ;; +x) + (cd ../bin ; echo Sorry, `pwd` is not in your shell PATH" ($PATH)") + STAT=1 ;; +*) + echo "Sorry, there is something wrong with your PATH ($PATH)" ;; +esac +echo "echo l_$$" >x_tpath +chmod +x x_tpath +case x`(x_tpath) 2>/dev/null` +in +xl_$$) + ;; +x) + (cd ../bin ; echo Sorry, . is not in your shell PATH" ($PATH)") + STAT=2 ;; +x$$) + echo Sorry, . is not in your PATH" ($PATH)" or after the ACK bin directory + STAT=3 ;; +*) + echo "Sorry, there is something wrong with your PATH ($PATH)" + STAT=4 ;; +esac +rm -f ../bin/x_tpath x_tpath +exit $STAT diff --git a/first/did_first b/first/did_first new file mode 100755 index 00000000..f0d920a9 --- /dev/null +++ b/first/did_first @@ -0,0 +1,7 @@ +if (ack_sys ) >/dev/null 2>&1 +then + exit 0 +else + echo "You need to run 'first' first" + exit 1 +fi diff --git a/first/em_path.h.src b/first/em_path.h.src new file mode 100644 index 00000000..d1a3bab6 --- /dev/null +++ b/first/em_path.h.src @@ -0,0 +1,7 @@ +/* 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/descr" diff --git a/first/first b/first/first new file mode 100755 index 00000000..bbab5a65 --- /dev/null +++ b/first/first @@ -0,0 +1,133 @@ +: check $PATH first +if sh ckpath +then : +else + exit 1 +fi +: set ACK HOME Directory in ../h/em_path.h +rm -f em_path.h +sed -e "/^#define[ ]*EM_DIR/s@\".*\"@\"`cd .. ; pwd`\"@" <../h/em_path.h >em_path.h +if cmp ../h/em_path.h em_path.h >/dev/null 2>&1 +then + : Don't touch ../h/em_path.h, it's already correct +else + rm -f ../h/em_path.h + if mv em_path.h ../h >/dev/null 2>&1 + then : success + else + echo "Sorry, can't replace ../h/em_path.h" + exit 7 + fi +fi +: remove non-system as and ld from descr files +if (ack_sys) >/dev/null 2>&1 +then + : echo Your system is: `ack_sys`. +else + echo -n "Give me the name of your system, the current choice is: +pdp_v7 PDP11 with sep I/D and version 7 +vax_bsd4_1a VAX11 with BSD4.1a +vax_bsd4_1c VAX11 with BSD4.1c +vax_bsd4_2 VAX11 with BSD4.2 +pc_ix IBM PC with PC/IX +m68_unisoft Motorola 68000 with Unisoft UNIX +m68_pmds Philips PMDS +ANY Neither of the above + +system type: " + if read SYSNAME + then + echo echo "$SYSNAME" >../bin/ack_sys + chmod +x ../bin/ack_sys + case `ack_sys` in + pdp_v7|vax_bsd4_1[ac]|vax_bsd4_2|pc_ix|m68_unisoft|m68_pmds) ;; + *) echo None of the software especially intended for +the named systems will work ;; + esac + else + echo Sorry, got EOF when reading system name. + exit 8 + fi +fi +echo -n "Your system is `ack_sys`, are you satisfied with that? (y/n) " +if read YESNO +then + case $YESNO in + j*|y*) ;; + n*) echo Ok, I will give you another chance.... + rm -f ../bin/ack_sys + exec sh $0 + ;; + *) echo "I do not understand your answer ($YESNO). Bye" + exit 9 + ;; + esac +else + echo Sorry, got EOF when reading your answer. + exit 9 +fi +: "Take action according to the system used" +: 'Prevent the use of the system assembler on for certain systems' +case `ack_sys` in +vax_bsd*) RMD=pdp ;; +pdp_*) RMD="vax2 vax4" ;; +*) RMD="pdp vax2 vax4" ;; +esac +for i in $RMD +do +( cd ../lib/$i + if grep '^name as$' descr >/dev/null 2>&1 + then +cp descr descr.orig +ed - descr <<'ABC' +/^name as$/;/^end$/d +/^name ld$/;/^end$/d +w +q +ABC + fi +) +done +: 'Set the default machine in ../h/local.h' +case `ack_sys` in +pdp_v7) ACM=pdp ;; +vax_bsd4_1[ac]) ACM=vax2 ;; +vax_bsd4_2) ACM=vax2 ;; +pc_ix) ACM=ix ;; +m68_unisoft) ACM=m68k2 ;; +m68_pmds) ACM=pmds ;; +esac +rm -f local.h +sed /ACKM/s/'".*"'/'"'$ACM'"'/ <../h/local.h >local.h +if cmp -s ../h/local.h local.h +then : +else + cp local.h ../h + rm -f local.h +fi +echo "Your default machine to compile for is $ACM" +case `ack_sys` in +vax_bsd4_*) + echo 'Installing the include directory in lib/vax2' + ( cd ../lib/vax2 ; sh fetch_inc ) + echo Done + case `ack_sys` in + vax_bsd4_1a) VERS=BSD41a ;; + vax_bsd4_1c) VERS=BSD41c ;; + vax_bsd4_2) VERS=BSD42 ;; + *) echo "Unknown VAX BSD version, look at mach/vax[24]/libem" + break ;; + esac + for i in vax2 vax4 + do ( + cd ../mach/$i/libem + ed - system.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]; diff --git a/h/bc_string.h b/h/bc_string.h new file mode 100644 index 00000000..527b6fb1 --- /dev/null +++ b/h/bc_string.h @@ -0,0 +1,17 @@ +# + +/* $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; + +String *_newstr() ; + +#define MAXSTRING 1024 diff --git a/h/cg_pattern.h b/h/cg_pattern.h new file mode 100644 index 00000000..fc42c2f8 --- /dev/null +++ b/h/cg_pattern.h @@ -0,0 +1,156 @@ +/* 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)<= 128) {\ + a = ((a-128)<=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 */ diff --git a/h/em_mes.h b/h/em_mes.h new file mode 100644 index 00000000..8eec56b7 --- /dev/null +++ b/h/em_mes.h @@ -0,0 +1,21 @@ +/* + * 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 + */ diff --git a/h/em_ptyp.h b/h/em_ptyp.h new file mode 100644 index 00000000..6cb3da2c --- /dev/null +++ b/h/em_ptyp.h @@ -0,0 +1,8 @@ +#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 diff --git a/h/em_reg.h b/h/em_reg.h new file mode 100644 index 00000000..760d7cfd --- /dev/null +++ b/h/em_reg.h @@ -0,0 +1,10 @@ +/* + * 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 */ diff --git a/h/out.h b/h/out.h new file mode 100644 index 00000000..6bcceaa1 --- /dev/null +++ b/h/out.h @@ -0,0 +1,120 @@ +/* $Header$ */ +/* + * output format for ACK assemblers + */ +#ifndef ushort +#define ushort unsigned short +#endif ushort + +struct outhead { + ushort oh_magic; /* magic number */ + ushort oh_stamp; /* version stamp */ + ushort oh_flags; /* several format flags */ + ushort oh_nsect; /* number of outsect structures */ + ushort oh_nrelo; /* number of outrelo structures */ + ushort oh_nname; /* number of outname structures */ + long oh_nemit; /* sum of all os_flen */ + long oh_nchar; /* size of string area */ +}; + +#define O_MAGIC 0x0201 /* magic number of output file */ +#define O_STAMP 0 /* version stamp */ + +#ifdef JOHAN +#define HF_BREV 0x0001 /* high order byte lowest address */ +#define HF_WREV 0x0002 /* high order word lowest address */ +#endif JOHAN +#define HF_LINK 0x0004 /* unresolved references left */ +#define HF_8086 0x0008 /* os_base specially encoded */ + +struct outsect { + long os_base; /* startaddress in machine */ + long os_size; /* section size in machine */ + long os_foff; /* startaddress in file */ + long os_flen; /* section size in file */ + long os_lign; /* section alignment */ +}; + +struct outrelo { + char or_type; /* type of reference */ + char or_sect; /* referencing section */ + ushort or_nami; /* referenced symbol index */ + long or_addr; /* referencing address */ +}; + +struct outname { + union { + char *on_ptr; /* symbol name (in core) */ + long on_off; /* symbol name (in file) */ + } on_u; +#define on_mptr on_u.on_ptr +#define on_foff on_u.on_off + ushort on_type; /* symbol type */ + ushort on_desc; /* debug info */ + long on_valu; /* symbol value */ +}; + +/* + * relocation type bits + */ +#define RELSZ 0x07 /* relocation length */ +#define RELO1 1 /* 1 byte */ +#define RELO2 2 /* 2 bytes */ +#define RELO4 4 /* 4 bytes */ +#define RELPC 0x08 /* pc relative */ +#ifndef JOHAN +#define RELBR 0x10 /* High order byte lowest address. */ +#define RELWR 0x20 /* High order word lowest address. */ +#endif JOHAN + +/* + * section type bits and fields + */ +#define S_TYP 0x007F /* undefined, absolute or relative */ +#define S_EXT 0x0080 /* external flag */ +#define S_ETC 0x7F00 /* for symbolic debug, bypassing 'as' */ + +/* + * S_TYP field values + */ +#define S_UND 0x0000 /* undefined item */ +#define S_ABS 0x0001 /* absolute item */ +#define S_MIN 0x0002 /* first user section */ +#define S_MAX S_TYP /* last user section */ + +/* + * S_ETC field values + */ +#define S_SCT 0x0100 /* section names */ +#define S_LIN 0x0200 /* hll source line item */ +#define S_FIL 0x0300 /* hll source file item */ +#define S_MOD 0x0400 /* ass source file item */ +#ifndef JOHAN +#define S_COM 0x1000 /* Common name. */ +#endif JOHAN + +/* + * structure format strings + */ +#define SF_HEAD "22222244" +#define SF_SECT "44444" +#define SF_RELO "1124" +#define SF_NAME "4224" + +/* + * structure sizes (bytes in file; add digits in SF_*) + */ +#define SZ_HEAD 20 +#define SZ_SECT 20 +#define SZ_RELO 8 +#define SZ_NAME 12 + +/* + * file access macros + */ +#define BADMAGIC(x) ((x).oh_magic!=O_MAGIC) +#define OFF_SECT(x) SZ_HEAD +#define OFF_EMIT(x) (OFF_SECT(x) + ((long)(x).oh_nsect * SZ_SECT)) +#define OFF_RELO(x) (OFF_EMIT(x) + (x).oh_nemit) +#define OFF_NAME(x) (OFF_RELO(x) + ((long)(x).oh_nrelo * SZ_RELO)) +#define OFF_CHAR(x) (OFF_NAME(x) + ((long)(x).oh_nname * SZ_NAME)) diff --git a/h/pc_err.h b/h/pc_err.h new file mode 100644 index 00000000..9e5e8992 --- /dev/null +++ b/h/pc_err.h @@ -0,0 +1,22 @@ +#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 diff --git a/h/pc_file.h b/h/pc_file.h new file mode 100644 index 00000000..f49a1853 --- /dev/null +++ b/h/pc_file.h @@ -0,0 +1,19 @@ +#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])) diff --git a/h/pc_size.h b/h/pc_size.h new file mode 100644 index 00000000..8545063f --- /dev/null +++ b/h/pc_size.h @@ -0,0 +1,21 @@ +/* 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 diff --git a/h/ranlib.h b/h/ranlib.h new file mode 100644 index 00000000..cf76a86e --- /dev/null +++ b/h/ranlib.h @@ -0,0 +1,25 @@ +/* $Header$ */ + +#ifndef SYMDEF +# define SYMDEF "__.SYMDEF" +#endif SYMDEF + +/* + * Structure of the SYMDEF table of contents for an archive. + * SYMDEF begins with a long giving the number of ranlib + * structures that immediately follow, and then continues with a string + * table consisting of a long giving the number of bytes of + * strings that follow and then the strings themselves. + */ +struct ranlib { + union { + char *ran__ptr; /* symbol name (in core) */ + long ran__off; /* symbol name (in file) */ + } ran_u; +#define ran_ptr ran_u.ran__ptr +#define ran_off ran_u.ran__off + long ran_pos; /* library member is at this position */ +}; + +#define SZ_RAN 8 +#define SF_RAN "44" diff --git a/include/_tail_cc/setjmp.h b/include/_tail_cc/setjmp.h new file mode 100644 index 00000000..61f93b57 --- /dev/null +++ b/include/_tail_cc/setjmp.h @@ -0,0 +1 @@ +typedef char jmp_buf[256]; diff --git a/include/_tail_mon/errno.h b/include/_tail_mon/errno.h new file mode 100644 index 00000000..03fc7459 --- /dev/null +++ b/include/_tail_mon/errno.h @@ -0,0 +1,42 @@ +/* + * 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 diff --git a/include/_tail_mon/signal.h b/include/_tail_mon/signal.h new file mode 100644 index 00000000..86b47d55 --- /dev/null +++ b/include/_tail_mon/signal.h @@ -0,0 +1,21 @@ +#define NSIG 17 + +#define SIGHUP 1 /* hangup */ +#define SIGINT 2 /* interrupt */ +#define SIGQUIT 3 /* quit */ +#define SIGILL 4 /* illegal instruction (not reset when caught) */ +#define SIGTRAP 5 /* trace trap (not reset when caught) */ +#define SIGIOT 6 /* IOT instruction */ +#define SIGEMT 7 /* EMT instruction */ +#define SIGFPE 8 /* floating point exception */ +#define SIGKILL 9 /* kill (cannot be caught or ignored) */ +#define SIGBUS 10 /* bus error */ +#define SIGSEGV 11 /* segmentation violation */ +#define SIGSYS 12 /* bad argument to system call */ +#define SIGPIPE 13 /* write on a pipe with no one to read it */ +#define SIGALRM 14 /* alarm clock */ +#define SIGTERM 15 /* software termination signal from kill */ + +int (*signal())(); +#define SIG_DFL (int (*)())0 +#define SIG_IGN (int (*)())1 diff --git a/lang/basic/lib/LIST b/lang/basic/lib/LIST new file mode 100644 index 00000000..a558a996 --- /dev/null +++ b/lang/basic/lib/LIST @@ -0,0 +1,34 @@ +tail_bc.a +abs.c +asc.c +asrt.c +atn.c +chr.c +conversion.c +hlt.c +mki.c +oct.c +peek.c +power.c +exp.c +log.c +print.c +io.c +random.c +read.c +return.c +sgn.c +sin.c +fif.e +sqt.c +fef.e +stop.c +string.c +salloc.c +swap.c +trace.c +write.c +file.c +error.c +trap.c +setline.e diff --git a/lang/basic/lib/abs.c b/lang/basic/lib/abs.c new file mode 100644 index 00000000..1d623515 --- /dev/null +++ b/lang/basic/lib/abs.c @@ -0,0 +1,10 @@ +/* $Header$ */ + +long _abl(i) long i; +{ + return( i>=0?i:-i); +} +double _abr(f) double f; +{ + return( f>=0.0?f: -f); +} diff --git a/lang/basic/lib/asc.c b/lang/basic/lib/asc.c new file mode 100644 index 00000000..6d0eace1 --- /dev/null +++ b/lang/basic/lib/asc.c @@ -0,0 +1,11 @@ +#include "bc_string.h" + +/* $Header$ */ + +int _asc(str) +String *str; +{ + if(str==0 || str->strval==0) + error(3); + return( *str->strval); +} diff --git a/lang/basic/lib/asrt.c b/lang/basic/lib/asrt.c new file mode 100644 index 00000000..19b5baf7 --- /dev/null +++ b/lang/basic/lib/asrt.c @@ -0,0 +1,9 @@ +/* $Header$ */ + +asrt(b) +{ + if(!b){ + printf("ASSERTION ERROR\n"); + abort(); + } +} diff --git a/lang/basic/lib/atn.c b/lang/basic/lib/atn.c new file mode 100644 index 00000000..a2c4052b --- /dev/null +++ b/lang/basic/lib/atn.c @@ -0,0 +1,93 @@ +/* + * (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)); +} diff --git a/lang/basic/lib/chr.c b/lang/basic/lib/chr.c new file mode 100644 index 00000000..8175bf54 --- /dev/null +++ b/lang/basic/lib/chr.c @@ -0,0 +1,17 @@ +#include "bc_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= _newstr(buf); + return(s); +} diff --git a/lang/basic/lib/conversion.c b/lang/basic/lib/conversion.c new file mode 100644 index 00000000..b7ec4cdb --- /dev/null +++ b/lang/basic/lib/conversion.c @@ -0,0 +1,40 @@ +/* $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); +} diff --git a/lang/basic/lib/error.c b/lang/basic/lib/error.c new file mode 100644 index 00000000..abc0f764 --- /dev/null +++ b/lang/basic/lib/error.c @@ -0,0 +1,63 @@ +/* $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(); +} diff --git a/lang/basic/lib/exp.c b/lang/basic/lib/exp.c new file mode 100644 index 00000000..abb8ccac --- /dev/null +++ b/lang/basic/lib/exp.c @@ -0,0 +1,122 @@ +/* + * (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< 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)); +} diff --git a/lang/basic/lib/fef.e b/lang/basic/lib/fef.e new file mode 100644 index 00000000..5a296c24 --- /dev/null +++ b/lang/basic/lib/fef.e @@ -0,0 +1,23 @@ +# + 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 ? diff --git a/lang/basic/lib/fif.e b/lang/basic/lib/fif.e new file mode 100644 index 00000000..fb96dee4 --- /dev/null +++ b/lang/basic/lib/fif.e @@ -0,0 +1,25 @@ +# + 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 ? diff --git a/lang/basic/lib/file.c b/lang/basic/lib/file.c new file mode 100644 index 00000000..1a1b6a6c --- /dev/null +++ b/lang/basic/lib/file.c @@ -0,0 +1,135 @@ +#include "bc_string.h" +#include +#include "bc_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; + +_setchan(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); +} diff --git a/lang/basic/lib/hlt.c b/lang/basic/lib/hlt.c new file mode 100644 index 00000000..8a87b202 --- /dev/null +++ b/lang/basic/lib/hlt.c @@ -0,0 +1,7 @@ +/* $Header$ */ + +_hlt(nr) +int nr; +{ + exit(nr); +} diff --git a/lang/basic/lib/io.c b/lang/basic/lib/io.c new file mode 100644 index 00000000..e7ea50d5 --- /dev/null +++ b/lang/basic/lib/io.c @@ -0,0 +1,97 @@ +#include "bc_io.h" +#include + +/* $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; +{ + register int holder ; + 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( (holder = fgetc(_chanrd)) != EOF && holder != '\n'){ + *c= holder ; + if( _chann == -1) putchar(holder); + 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(" "); +} diff --git a/lang/basic/lib/log.c b/lang/basic/lib/log.c new file mode 100644 index 00000000..e9cb65c8 --- /dev/null +++ b/lang/basic/lib/log.c @@ -0,0 +1,75 @@ +/* + * (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(xstrval ) = i ; + return(s); +} +String *_mkd(d) +double d; +{ + char *buffer =" "; + String *s; + + s= _newstr(buffer); + * ( (double *)s->strval ) = i ; + return(s); +} +long _cvi(s) +String *s; +{ + return *( (long *) s->strval) ; +} +double _cvd(s) +String *s; +{ + return *( (double *) s->strval) ; +} diff --git a/lang/basic/lib/oct.c b/lang/basic/lib/oct.c new file mode 100644 index 00000000..067a5de3 --- /dev/null +++ b/lang/basic/lib/oct.c @@ -0,0 +1,19 @@ +#include "bc_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)); +} diff --git a/lang/basic/lib/peek.c b/lang/basic/lib/peek.c new file mode 100644 index 00000000..04ab1411 --- /dev/null +++ b/lang/basic/lib/peek.c @@ -0,0 +1,26 @@ +/* $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; +} diff --git a/lang/basic/lib/power.c b/lang/basic/lib/power.c new file mode 100644 index 00000000..be88ac4e --- /dev/null +++ b/lang/basic/lib/power.c @@ -0,0 +1,32 @@ +/* $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))); +} diff --git a/lang/basic/lib/print.c b/lang/basic/lib/print.c new file mode 100644 index 00000000..a335f968 --- /dev/null +++ b/lang/basic/lib/print.c @@ -0,0 +1,73 @@ +#include "bc_string.h" +#include "bc_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(""); + else _out(str->strval); +} diff --git a/lang/basic/lib/random.c b/lang/basic/lib/random.c new file mode 100644 index 00000000..41ea4f35 --- /dev/null +++ b/lang/basic/lib/random.c @@ -0,0 +1,25 @@ +/* $Header$ */ + +_randomi() +{ + int i; + double f; + _setchan(-1); + printf("Random number seed (-32768 to 32767) ? "); + _readint(&i); + f=i; + _setrand(f); +} + +_setrand(f) +double f; +{ + int i; + i=f; + srand(i); +} +double _rnd(d) double d; +{ + double f; f= (int) rand(); + return(f/32767.0); +} diff --git a/lang/basic/lib/read.c b/lang/basic/lib/read.c new file mode 100644 index 00000000..a258e419 --- /dev/null +++ b/lang/basic/lib/read.c @@ -0,0 +1,174 @@ +#include "bc_string.h" +#include "bc_io.h" +#include + +/* $Header$ */ + +_readln() +{ + register int c; + while( (c=fgetc(_chanrd)) != EOF && c!= '\n') + ; +} + +readskip() +{ + register int 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]; + register int kar ; + char *c; + +#ifdef DEBUG + printf("read str from %d\n",_chann); +#endif + _asschn(); + c= buffer; + kar= fgetc(_chanrd); + while(isspace(kar) && kar!= EOF) + kar= fgetc(_chanrd); + *c=kar ; + if( kar== '"') + { + /* read quoted string */ +#ifdef DEBUG + printf("qouted string\n"); +#endif + while ( (kar= fgetc(_chanrd)) != EOF && kar!='"' ) *c++ = kar ; + ungetc(kar,_chanrd); + *c=0; + }else + if( isalpha(*c)) + { + /* read normal string */ + c++; +#ifdef DEBUG + printf("non-qouted string\n"); +#endif + while( (kar= fgetc(_chanrd)) != ',' && kar!= EOF && + !isspace(kar) && kar!='\n') + *c++= kar ; + ungetc(kar,_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 _seektab[]; + +_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; _seektab[nr] && _seektab[nr]< line; nr+=2) +#ifdef DEBUG + printf("test %d %d\n",_seektab[nr], _seektab[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); +} diff --git a/lang/basic/lib/return.c b/lang/basic/lib/return.c new file mode 100644 index 00000000..aa0e43f2 --- /dev/null +++ b/lang/basic/lib/return.c @@ -0,0 +1,29 @@ +/* $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]); +} diff --git a/lang/basic/lib/salloc.c b/lang/basic/lib/salloc.c new file mode 100644 index 00000000..3e13b7d7 --- /dev/null +++ b/lang/basic/lib/salloc.c @@ -0,0 +1,20 @@ +/* $Header$ */ + +extern char *malloc() ; + +char * salloc(length) +unsigned length; +{ + char *c, *s; + c= malloc(length); + if( !c ) error(5); + for(s=c;s0) return(1); + if( v<0) return(-1); + return(0); +} diff --git a/lang/basic/lib/sin.c b/lang/basic/lib/sin.c new file mode 100644 index 00000000..5fcd1a3b --- /dev/null +++ b/lang/basic/lib/sin.c @@ -0,0 +1,102 @@ +/* + * (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)); +} diff --git a/lang/basic/lib/sqt.c b/lang/basic/lib/sqt.c new file mode 100644 index 00000000..cd9eff79 --- /dev/null +++ b/lang/basic/lib/sqt.c @@ -0,0 +1,76 @@ +/* + * (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); +} diff --git a/lang/basic/lib/stop.c b/lang/basic/lib/stop.c new file mode 100644 index 00000000..640639e4 --- /dev/null +++ b/lang/basic/lib/stop.c @@ -0,0 +1,10 @@ +/* $Header$ */ + +_stop() +{ + extern int _erlsym; + + _setline(); + printf("Break in %d\n", _erlsym); + exit(0); +} diff --git a/lang/basic/lib/string.c b/lang/basic/lib/string.c new file mode 100644 index 00000000..5aa9906d --- /dev/null +++ b/lang/basic/lib/string.c @@ -0,0 +1,179 @@ +#include "bc_string.h" + +/* $Header$ */ + +#define ok(X) if( X ==0) return; +#define okr(X) if( X ==0) return(0); + +extern char *salloc() ; + +_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= 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); + /* Strings in ROM are initialized with this count */ + if ( str->strcount==9999 ) return ; + 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((char *)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= salloc(length); + strcpy(s->strval,s2->strval); + strcat(s->strval,s1->strval); + return(s); +} +_strcomp(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= salloc(size+1); + ns->strcount=1; + for(i=0; istrval[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= salloc(len+1); + for(i=0;istrval[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= 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->strlengthstrlength - 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->strlengthstrlength - 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); +} diff --git a/lang/basic/lib/swap.c b/lang/basic/lib/swap.c new file mode 100644 index 00000000..bddc0ff7 --- /dev/null +++ b/lang/basic/lib/swap.c @@ -0,0 +1,30 @@ +#include "bc_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; +} diff --git a/lang/basic/lib/trace.c b/lang/basic/lib/trace.c new file mode 100644 index 00000000..ac0ba3a1 --- /dev/null +++ b/lang/basic/lib/trace.c @@ -0,0 +1,7 @@ +/* $Header$ */ + +_trace(i) +int i; +{ +printf("[%d]",i); +} diff --git a/lang/basic/lib/trap.c b/lang/basic/lib/trap.c new file mode 100644 index 00000000..ee46d4ee --- /dev/null +++ b/lang/basic/lib/trap.c @@ -0,0 +1,55 @@ +#include +#include + +/* $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;i0) + if( fputc(' ',_chanwr)==EOF) error(29); + fprintf(_chanwr,"%d",i); + if( ferror(_chanwr) ) error(29); +} +_wrflt(f) +double f; +{ + fprintf(_chanwr,"%f",f); + if( ferror(_chanwr) ) error(29); +} +_wrstr(s) +String *s; +{ + fprintf(_chanwr,"\"%s\"",s->strval); + if( ferror(_chanwr) ) error(29); +} diff --git a/lang/basic/src.old/Makefile b/lang/basic/src.old/Makefile new file mode 100644 index 00000000..d6d2f82e --- /dev/null +++ b/lang/basic/src.old/Makefile @@ -0,0 +1,51 @@ +# $Header$ + +d=../../.. +h=$d/h +l=$d/lib +INSTALL=$l/em_bem + +CFLAGS = -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 + +CFILES= bem.c y.tab.c symbols.c initialize.c compile.c \ + parsepar.c yywrap.c gencode.c util.c graph.c \ + eval.c func.c split.c + +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 basic.lex + $(CC) $(CFLAGS) -c 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 + +lint: $(CFILES) + lint -phac -I$h $(CFILES) diff --git a/lang/basic/src.old/basic.lex b/lang/basic/src.old/basic.lex new file mode 100644 index 00000000..69b95686 --- /dev/null +++ b/lang/basic/src.old/basic.lex @@ -0,0 +1,468 @@ +#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, +"randomi", 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->namename!=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 + +/* 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 *Sym; + 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.integer= 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( isymtype!=DEFAULTTYPE) + { + if(typech && typech!=Sym->symtype && wflag) + warning("type re-declared,ignored"); + } + if( typech) + Sym->symtype=typech; + if(debug) printf("lookup:%d Identifier\n",Sym); + 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': + if( *(c+1)=='='){ + c++;c++;cptr=c; yylval.integer= GESYM;return(RELOP); + } + yylval.integer= '>'; + cptr++; + return(RELOP); + case '<': + if( *(c+1)=='='){ + c++; c++; cptr=c; yylval.integer=LESYM; return(RELOP); + } else + if( *(c+1)=='>'){ + c++; c++; cptr=c; yylval.integer=NESYM; return(RELOP); + } + yylval.integer= '<'; + cptr++; + return(RELOP); + } + return(*cptr++); +} diff --git a/lang/basic/src.old/basic.yacc b/lang/basic/src.old/basic.yacc new file mode 100644 index 00000000..14eb16d6 --- /dev/null +++ b/lang/basic/src.old/basic.yacc @@ -0,0 +1,477 @@ +%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 + +%type arraydcl identifier indexed +%type getput +%type exprlist expression negation compare sum term factor +%type parmlist variable printlist inputtail funcname funccall + +%left BOOLOP +%left NOTSYM +%left '=' '<' '>' LESYM GESYM NESYM +%left RELOP +%left '+' '-' +%left '*' '/' '\\' MODSYM +%left '^' +%left UNARYMINUS + +%{ +#define YYDEBUG +#include "bem.h" + +typedef union { + int integer ; + Symbol *Sptr ; + char *cptr ; +} YYSTYPE ; + +int ival; +double dval; +char *sval; +int e1,e2; + +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($2->symname)); + while($3 -- >0) emcode("asp",EMPTRSIZE); + } + | CALLSYM IDENTIFIER + { emcode("cal",proclabel($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",itoa(ival)); + emcode("cal","$_clochn"); + emcode("asp",EMINTSIZE);} + | filelist ',' cross intvalue { emcode("loc",itoa(ival)); + 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= $1; + s->dimlimit[s->dimensions]=ival; + s->dimensions++; + } + | arraydcl ',' INTVALUE {$$=$1; s= $1; + if(s->dimensionsdimlimit[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((Symbol *)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); $$= "$_getrec";} + | PUTSYM cross intvalue { setchannel(ival); $$= "$_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(ival);} + +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","$_randomi");} + | RANDOMIZESYM expression + { conversion($2,INTTYPE); + emcode("cal","$_setrand"); + 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 {$$= STRINGTYPE; loadstr($1);} + | variable {$$=$1; 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(0);} + | funcname funccall ')' { $$=fcnend($2);} + | MIDSYM '$' midparms + { emcode("cal","$_mid"); + emcode("asp",EMINTSIZE); + emcode("asp",EMINTSIZE); + emcode("asp",EMPTRSIZE); + /* 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 "basic.lex" diff --git a/lang/basic/src.old/bem.c b/lang/basic/src.old/bem.c new file mode 100644 index 00000000..c91d6067 --- /dev/null +++ b/lang/basic/src.old/bem.c @@ -0,0 +1,45 @@ +#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(); +} diff --git a/lang/basic/src.old/bem.h b/lang/basic/src.old/bem.h new file mode 100644 index 00000000..7b091b4d --- /dev/null +++ b/lang/basic/src.old/bem.h @@ -0,0 +1,72 @@ +#include +#include +#include + +/* 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 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 */ + +#define void int /* Some C compilers don't know void */ + +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 *proclabel(); +extern char *typesize(); +extern char *typestring(); +extern char *salloc(); + +extern char *sprintf(); +extern char *strcpy(); +extern char *strcat(); +extern char *malloc(); diff --git a/lang/basic/src.old/compile.c b/lang/basic/src.old/compile.c new file mode 100644 index 00000000..30192203 --- /dev/null +++ b/lang/basic/src.old/compile.c @@ -0,0 +1,20 @@ +#include "bem.h" + +#ifndef NORSCID +static char rcs_id[] = "$Header$" ; +#endif + + +/* compile the next program in the list */ +/* Here we should open the input file. (for the future) */ + +FILE *yyin; + +compileprogram(dummyprog) +char *dummyprog; +{ + + while( getline()) + (void) yyparse(); + (void) fclose(yyin); +} diff --git a/lang/basic/src.old/eval.c b/lang/basic/src.old/eval.c new file mode 100644 index 00000000..e35af1c9 --- /dev/null +++ b/lang/basic/src.old/eval.c @@ -0,0 +1,440 @@ +#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': 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)); +} +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)); +} +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( dimtopdimensions==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)); +} diff --git a/lang/basic/src.old/func.c b/lang/basic/src.old/func.c new file mode 100644 index 00000000..2bbddc9a --- /dev/null +++ b/lang/basic/src.old/func.c @@ -0,0 +1,219 @@ +#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); +} + diff --git a/lang/basic/src.old/gencode.c b/lang/basic/src.old/gencode.c new file mode 100644 index 00000000..e36aa7b7 --- /dev/null +++ b/lang/basic/src.old/gencode.c @@ -0,0 +1,578 @@ +#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("loc",itoa(nr)); + emcode("cal","$_trace"); + emcode("asp","EM_WSIZE"); + } +} + +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; + /*NOSTRICT*/ l= (List *) salloc(sizeof(List)); + l->linenr= currline->linenr; + /*NOSTRICT?*/ 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 _seektab\n"); + fprintf(emfile,"_seektab\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","$_setchan"); + 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","$_setchan"); + 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 $_setchan\n"); + fprintf(emfile," asp EM_WSIZE\n"); + fprintf(emfile,"datfname\n rom \"%s\\0\"\n", datfname); + fprintf(emfile,"dattyp\n rom \"i\\0\"\n"); + fprintf(emfile,"datfdes\n rom datfname,1,%d\n", + strlen(datfname)); + fprintf(emfile,"dattdes\n rom dattyp,1,1\n"); + fprintf(emfile," lae dattdes\n"); + fprintf(emfile," lae datfdes\n"); + fprintf(emfile," loc 0\n"); + fprintf(emfile," cal $_opnchn\n"); + fprintf(emfile," asp EM_PSIZE\n"); + fprintf(emfile," asp EM_PSIZE\n"); + fprintf(emfile," asp EM_WSIZE\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"); +} diff --git a/lang/basic/src.old/graph.c b/lang/basic/src.old/graph.c new file mode 100644 index 00000000..c09b65db --- /dev/null +++ b/lang/basic/src.old/graph.c @@ -0,0 +1,294 @@ +#include "bem.h" + +#ifndef NORSCID +static char rcs_id[] = "$Header$" ; +#endif + + +List *forwardlabel=0; + +Linerecord *firstline, + *currline, + *lastline; + +List *newlist() +{ + List *l; + /*NOSTRICT*/ l= (List *) salloc(sizeof(List)); + return(l); +} + +/* 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 */ + /*NOSTRICT*/ 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= newlist(); + 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= newlist(); + 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; + + l= newlist(); + 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= newlist(); + 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= newlist(); + 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(); + (void) fclose(tmpfile); + tmpfile= fopen(tmpfname,"r"); + if( tmpfile==NULL) + fatal("tmp file disappeared"); + while( (length=fread(buf,1,512,tmpfile)) != 0) + (void) fwrite(buf,1,length,emfile); + epilogcode(); + (void) unlink(tmpfname); +} diff --git a/lang/basic/src.old/graph.h b/lang/basic/src.old/graph.h new file mode 100644 index 00000000..de6d0aea --- /dev/null +++ b/lang/basic/src.old/graph.h @@ -0,0 +1,36 @@ +# + +#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; + +extern List *gosublabel(); diff --git a/lang/basic/src.old/initialize.c b/lang/basic/src.old/initialize.c new file mode 100644 index 00000000..12a79912 --- /dev/null +++ b/lang/basic/src.old/initialize.c @@ -0,0 +1,45 @@ +#include "bem.h" +#include + +#ifndef NORSCID +static char rcs_id[] = "$Header$" ; +#endif + +/* generate temporary files etc */ + +FILE *emfile; +FILE *tmpfile; +FILE *datfile; + +initialize() +{ + register char *cindex, *cptr ; + + sprintf(tmpfname,"%s/abc%d",TMP_DIR,getpid()); + /* Find the basename */ + /* Strip leading directories */ + cindex= (char *)0 ; + for ( cptr=program ; *cptr ; cptr++ ) if ( *cptr=='/' ) cindex=cptr ; + if ( !cindex ) cindex= program ; + else { + cindex++ ; + if ( !*cindex ) { + warning("Null program name, assuming \"basic\"") ; + cindex= "basic" ; + } + } + cptr=datfname ; + while ( *cptr++ = *cindex++ ) ; + /* Strip trailing suffix */ + if ( cptr>datfname+3 && cptr[-3]=='.' ) cptr[-3]=0 ; + 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 */ +} diff --git a/lang/basic/src.old/parsepar.c b/lang/basic/src.old/parsepar.c new file mode 100644 index 00000000..15ef90b9 --- /dev/null +++ b/lang/basic/src.old/parsepar.c @@ -0,0 +1,52 @@ +#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 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 files=0 ; + int i; + char *ext; + + if(argc< 4) + { + fprintf(stderr,"usage %s \n", argv[0]); + exit(-1); + } + for(i=1;inextline) + 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; + long 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(); +} diff --git a/lang/basic/src.old/symbols.c b/lang/basic/src.old/symbols.c new file mode 100644 index 00000000..f20374de --- /dev/null +++ b/lang/basic/src.old/symbols.c @@ -0,0 +1,290 @@ +#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 */ + /*NOSTRICT*/ s= (Symbol *) salloc(sizeof(Symbol)); + s->symtype= DEFAULTTYPE; + s->nextsym= firstsym; + s->symname= (char *) salloc((unsigned)(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;idimensions;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; idimensions;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;idimensions;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() +{ + /* generate portable function size */ + int i; + for(i=0;idimensions;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(); + s= firstsym; + while(s) + { + firstsym = s->nextsym; + /*NOSTRICT*/ free((char *)s); + s= firstsym; + } + firstsym= alternate; + alternate = NIL; + fcn=NIL; +} + +dclparm(s) +Symbol *s; +{ + int 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; + } + return(s->symtype); +} +fcnend(parmcount) +int parmcount; +{ + int type; + /* check number of arguments */ + if( parmcount 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(); + 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]); +} diff --git a/lang/basic/src.old/symbols.h b/lang/basic/src.old/symbols.h new file mode 100644 index 00000000..a575d1db --- /dev/null +++ b/lang/basic/src.old/symbols.h @@ -0,0 +1,85 @@ +#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; + +extern Symbol *srchsymbol(); diff --git a/lang/basic/src.old/util.c b/lang/basic/src.old/util.c new file mode 100644 index 00000000..7ef314dc --- /dev/null +++ b/lang/basic/src.old/util.c @@ -0,0 +1,80 @@ +#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) +unsigned length; +{ + char *s,*c; + extern char *malloc() ; + s=c= malloc(length); + if ( !s ) fatal("Out of memory") ; + while(length--)*c++ =0; + return(s); +} + +char * proclabel(str) +char *str; +{ + static char buf[50]; + sprintf(buf,"$%s",str); + return(buf); +} diff --git a/lang/basic/src.old/yywrap.c b/lang/basic/src.old/yywrap.c new file mode 100644 index 00000000..096e2ad2 --- /dev/null +++ b/lang/basic/src.old/yywrap.c @@ -0,0 +1,21 @@ +#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); +} diff --git a/lang/basic/test/Makefile b/lang/basic/test/Makefile new file mode 100644 index 00000000..13aafc11 --- /dev/null +++ b/lang/basic/test/Makefile @@ -0,0 +1,12 @@ +SRC= bull.b buzzword.b checker.b creator.b grafiek.b gunner.b learn.b\ + opg1.b opg2.b opg3.b opg4.b opg5.b opg6.b som4.b test01.b test02.b\ + test03.b test04.b test05.b test06.b test07.b test08.b test09.b\ + test10.b test11.b test12.b test13.b test14.b test15.b test16.b\ + test17.b test19.b test20.b test21.b test22.b test23.b\ + test24.b test25.b test26.b test27.b test28.b test29.b test30.b\ + test31.b test32.b test33.b test34.b test35.b + +head: + for i in $(SRC) ; do runcmp $$i ; done +clean: + rm -f *.b.[rx] *.[dekmos] diff --git a/lang/basic/test/Out.std b/lang/basic/test/Out.std new file mode 100644 index 00000000..16023944 --- /dev/null +++ b/lang/basic/test/Out.std @@ -0,0 +1,55 @@ +for i in bull.b buzzword.b checker.b creator.b grafiek.b gunner.b learn.b opg1.b opg2.b opg3.b opg4.b opg5.b opg6.b som4.b test01.b test02.b test03.b test04.b test05.b test06.b test07.b test08.b test09.b test10.b test11.b test12.b test13.b test14.b test15.b test16.b test17.b test19.b test20.b test21.b test22.b test23.b test24.b test25.b test26.b test27.b test28.b test29.b test30.b test31.b test32.b test33.b test34.b test35.b ; do runcmp $i ; done +bull.b ------- execution error(s)-*- Ok +buzzword.b ------- execution error(s)-*- Ok +checker.b FATAL:improper file creation permission +------- compilation error(s) +creator.b Undefined: +__inkey +------- compilation error(s) +grafiek.b -*- Ok +gunner.b ------- execution error(s)-*- Ok +learn.b ------- execution error(s)-*- Ok +opg1.b -*- Ok +opg2.b -*- Ok +opg3.b -*- Ok +opg4.b -*- Ok +opg5.b -*- Ok +opg6.b -*- Ok +som4.b ------- execution error(s)-*- Ok +test01.b -*- Ok +test02.b -*- Ok +test03.b -*- Ok +test04.b -*- Ok +test05.b -*- Ok +test06.b -*- Ok +test07.b ------- execution error(s)-*- Ok +test08.b -*- Ok +test09.b -*- Ok +test10.b ------- execution error(s)-*- Ok +test11.b -*- Ok +test12.b -*- Ok +test13.b -*- Ok +test14.b -*- Ok +test15.b -*- Ok +test16.b -*- Ok +test17.b ------- execution error(s)-*- Ok +test19.b ------- execution error(s)-*- Ok +test20.b -*- Ok +test21.b -*- Ok +test22.b -*- Ok +test23.b ------- execution error(s)-*- Ok +test24.b -*- Ok +test25.b -*- Ok +test26.b -*- Ok +test27.b -*- Ok +test28.b ------- execution error(s)-*- Ok +test29.b -*- Ok +test30.b ------- execution error(s)-*- Ok +test31.b -*- Ok +test32.b -*- Ok +test33.b -*- Ok +test34.b LINE 3:ERROR:too many indices +LINE 4:ERROR:too many indices +LINE 5:ERROR:too many indices +------- compilation error(s) +test35.b -*- Ok diff --git a/lang/basic/test/bull.b b/lang/basic/test/bull.b new file mode 100644 index 00000000..0fceb93e --- /dev/null +++ b/lang/basic/test/bull.b @@ -0,0 +1,37 @@ +10 rem *** bullseye +20 print "game of bullseye":print:randomize +30 print "in this game, up to 20 players throw darts at a target" +40 print "with 10,20,30, and 40 point zones. The objective is" +50 print "toget 200 point.":print +60 print "throw","description",,"probable score" +70 print " 1","fast overarm",,"bullseye or complete miss" +80 print " 2","controlled overarm","10,20,30 points" +90 print " 3","underarm",,"anything":print +100 dim a$(20),s(20),w(10):r=0:m=0: for i=1 to 20:s(i)=0:nexti +110 input ;"how many players";n:print +120 for i=1 to n +130 print "name of player" i; : input a$(i) +140 nexti +150 r=r+1:print:print "round" r +160 for i=1 to n +170 print:print a$(i)"'s throw";:input t +180if t<1 or t>3 then print "input 1, 2, or 3":goto 170 +190 on t goto 200,210,220 +200 p1=.65:p2=.55:p3=.5:p4=.5:goto 230 +210p1=.99:p2=.77:p3=.43:p4=.01:goto 230 +220 p1=.95:p2=.75:p3=.45:p4=.05 +230 u=rnd(0):print "rnd="u +240 if u>=p1 then print "BULLSEYE!! 40 points":b=40:goto 290 +250 if u>=p2 then print "30-point zone":b=30:goto 290 +260 if u>=p3 then print "20-point zone":b=20:goto 290 +270 if u>=p4 then print "WHEH! 10 points":b=10:goto 290 +280 print "missed the target. too bad!":b=0 +290 s(i)=s(i)+b:print "total score="s(i):next i +300 fori=1 to n +310 if s(i)>=200 then m=m+1:w(m)=i +320 nexti +330 if m=0 then150 +340 print :print "We have a winner!!":print +350 print a$(w(m))" scored"s(w(m))"points." +360 for i=1 to m +370 print:print "thanks for the game!":nexti:end diff --git a/lang/basic/test/bull.b.g b/lang/basic/test/bull.b.g new file mode 100644 index 00000000..37ec0244 --- /dev/null +++ b/lang/basic/test/bull.b.g @@ -0,0 +1,12 @@ +game of bullseye + +in this game, up to 20 players throw darts at a target +with 10,20,30, and 40 point zones. The objective is +toget 200 point. + +throw description probable score + 1 fast overarm bullseye or complete miss + 2 controlled overarm 10,20,30 points + 3 underarm anything + +how many players?LINE 110:ERROR 2: Out of data diff --git a/lang/basic/test/buzzword.b b/lang/basic/test/buzzword.b new file mode 100644 index 00000000..c1de180a --- /dev/null +++ b/lang/basic/test/buzzword.b @@ -0,0 +1,66 @@ +100 print "This computer program demonstration us a new aid for" +110 print "preparing speeches and briefings. It's a buzzword" +120 print "generator which provides you with a set of three higly" +130 print "acceptablewords to work into your material. The words" +140 print "don't actually mean anything, but they sound great." +150 print +160 print "the procedure:" +170 print ,"Think of any three numbers between 0 and 9, enter" +180 print , "them after the '?' separated by commas. your" +190 print ,"buzzword will be printed out. Typing "100" for" +200 print ,"each of your choices stops this program." +210 print "What are your three numbers"; +220 goto 260 +230 print +240 print +250 print "Three more numbers"; +260 input n,m,p +265 if n= 100 then 1290 +267 print "continue" +270 if n<0 then 1240 +280 if p<0 then 1240 +290 if m<0 then 1240 +300 if m>9 then 1240 +310 if p>9 then 1240 +320 if n>9 then 1240 +330 print +340 on n+1 goto 640,660,680,700,720,740,760,780,800,820 +440 on m+1 goto 840,860,880,900,920,940,960,980,1000,1020 +540 on p+1 goto 1040,1060,1080,1100,1120,1140,1160,1180,1200,1220 +640 print " integrated";: goto 440 +660 print " total";: goto 440 +680 print " systematized";: goto 440 +700 print " parallel";: goto 440 +720 print " functional";: goto 440 +740 print " responsive";: goto 440 +760 print " optimal";: goto 440 +780 print " synchronized";: goto 440 +800 print " compatible";: goto 440 +820 print " balanced";: goto 440 +840 print " management"; : goto 540 +860 print " organizational"; : goto 540 +880 print " monitored"; : goto 540 +900 print " reciprocal"; : goto 540 +920 print " digital"; : goto 540 +940 print " logistical"; : goto 540 +960 print " transitional"; : goto 540 +980 print " incremental"; : goto 540 +1000 print " fifth-generation"; : goto 540 +1020 print " policy"; : goto 540 +1040 print " options";: goto 230 +1060 print " flexibility";: goto 230 +1080 print " capability";: goto 230 +1100 print " mobility";: goto 230 +1120 print " programming";: goto 230 +1140 print " concept";: goto 230 +1160 print " time-phase";: goto 230 +1180 print " projection";: goto 230 +1200 print " hardware";: goto 230 +1220 print " contingency";: goto 230 +1240 print +1260 print +1270 print "numbers must be between 0 and 9, please select three more." +1280 goto 260 +1290 print "Goodbye for now." +1300 print:print:print +1310 end diff --git a/lang/basic/test/buzzword.b.g b/lang/basic/test/buzzword.b.g new file mode 100644 index 00000000..c58bb160 --- /dev/null +++ b/lang/basic/test/buzzword.b.g @@ -0,0 +1,12 @@ +This computer program demonstration us a new aid for +preparing speeches and briefings. It's a buzzword +generator which provides you with a set of three higly +acceptablewords to work into your material. The words +don't actually mean anything, but they sound great. + +the procedure: +Think of any three numbers between 0 and 9, enter +them after the '?' separated by commas. your +buzzword will be printed out. Typing 100 for +each of your choices stops this program. +What are your three numbers?LINE 260:ERROR 2: Out of data diff --git a/lang/basic/test/checker.b b/lang/basic/test/checker.b new file mode 100644 index 00000000..b28ab06b --- /dev/null +++ b/lang/basic/test/checker.b @@ -0,0 +1,192 @@ +100 print "This program will play checkers. The computer us X," +110 print "and you are 0. The computer will go first, -note: squares" +120 print "are printed in the form-(X,Y) and sq. 1.1 is the bottom left!" +130 print "do not attempt a double jump or your piece might just" +140 print "disappear (same for triple!)" +150 print " Wait for the computer to move!!!!!!" +700 g=-1 +800 dim r(50) +900 let l=-1 +1000 dim s(10,10) +1100 data 1,0,1,0,0,0,-1,0,0,1,0,0,0,-1,0,-1,15 +1200 for x=1to8 +1300 fory=1to8 +1400 read j +1500 if j=15 then 1800 +1600 s(x,y)=j +1700 goto 2000 +1800 restore +1900 reads(x,y) +2000 nexty +2100 nextx +2200 rem +2300 l=-1*l +2400 for x=1to 8 +2500 for y=-1to8 +2600 if s(x,y)=0 then 3500 +2700 if g>0 then 3000 +2800 if s(x,y)>0 then 3500 +2900 goto 3100 +3000 if s(x,y)<0 then 3500 +3100 if abs(s(x,y))<>1 then 3300 +3200 gosub 4300 +3300 if abs(s(x,y))<>2 then 3500 +3400 gosub 6500 +3500 if x<>8 then 3800 +3600 if l=1 then 3800 +3700 rem return +3800 nexty +3900 nextx +4000 print +4100 gosub 11400 +4200 goto 2300 +4300 for a=-1 to 1 step2 +4400 let u=x+a +4500 let v=y+g +4600 if u<1 then 6300 +4700 if u>8 then 6300 +4800 if v<1 then 6300 +4900 if v>8 then 6300 +5000 if s(u,v) <> 0 then 5300 +5100 gosub 9100 +5200 goto 6300 +5300 if s(u,v)=g then 6300 +5400 if s(u,v)=2*g then 6300 +5500 u=u+a +5600 v=v+g + +5700 if u<1 then 6300 +5800 if u>8 then 6300 +5900 if v<1 then 6300 +6000 if v>8 then 6300 +6100 if s(u,v)<>0 then 6300 +6200 gosub 9100 +6300 next a +6400 return +6500 rem king moves +6600 for a=-1 to 1 step2 +6700 forb=-1to 1step2 +6800 u=x+a +6900 v=y+b +7000 if u<1 then 8700 +7100 if u>8 then 8700 +7200 if v<1 then 8700 +7300 if v>8 then 8700 +7400 if s(u,v)<>0 then 7700 +7500 gosub 9100 +7600 goto 8700 +7700 if s(umv)=g then 8700 +7800 if s(u,v)=2*g then 8700 +7900 u=u+a +8000 v=v+b +8100 if u<1 then 8700 +8200 if u>8 then 8700 +8300 if v<1 then 8700 +8400 if v>8 then 8700 +8500 if s(u,v)<>0 then 8700 +8600 gosub 9100 +8700 next b +8800 next a +8900return +9000 goto 14200 +9100 rem +9200 p=p+1 +9300 if p=k then 12300 +9400 if v<>(4.5+(3.5*g)) then 9600 +9500 q=q+2 +9600 if x<>(4.5-(3.5*g)) then9800 +9700 q=q-2 +9800 rem +9900 if u<>1 then 10100 +10000 q=q+1 +10100 if u<> 8 then 10300 +10200 q=q+1 +10300 for c=-1 to 1 step 2 +10400 if s(u+c,v+g)<1 then 10800 +10500 q=q-1 +10600 if s(u-c,v-g) <> 0 then 10800 +10700 q=q-1 +10800 rem this was the evaluation section +10900 rem +11000 next c +11100 r(p)=q +11200 q=0 +11300 return +11400 if p=0 then 18800 +11500 for j=10to-10step -1 +11600for f=1to p +11700 if r(f)=j then 12000 +11800 next f +11900 next j +12000 let k=f+p +12100 print "retry": gosub 2300 +12200 return +12300 print " I move from ("X Y") to("U;V")" +12400 letf=0 +12500 p=0 +12600 k=0 +12700 if v<>(4.5+(3.5*g)) then 13000 +12800 s(u,v)=s*g +12900 goto 13100 +13000 let s(u,v)=s(x,y) +13100 let s(x,y)=0 +13200 if(abs(x-u))<>2 then 13400 +13300 s((x+u)/2,(y+v)/2)=0 +13400 print "board"; +13500 input d$ +13600 if d$<>"yes" then 13900 +13700 gosub 14100 +13800 return +13900 gosub 15800 +14000 return +14100 print +14200 for y=8to1step -1 +14300 for x=1to8 +14400 i=2*x +14500 if s(x,y)<>0 then14700 +14600 print tab(i)"."; +14700 if s(x,y)<>1 then 14900 +14800 print tab(i)"0" +14900 if s(x,y)<>-1then 15100 +15000 print tab(i)"X" +15100 if s(x,y)<>-2 then 15300 +15200 print tab(i)"X";tab(I)"*" +15300 if s(x,y)<>2 then 15500 +15400 print tab(i)"O";tab(I)"*" +15500 next x +15600 print +15700 next y +15800 print +15900 print "from"; +16000 input e,h +16100 x=e +16200 y=h +16300 if s(x,y)<>0 then 16700 +16400 print "there is no one occupying that space" +16500 print +16600 goto 15900 +16700 print "to"; +16800 input a,b +16900 x=a +17000 y=b +17100 if s(x,y)=0 then 17500 +17200 print "that space is already occupied" +17300 print +17400 goto 16700 +17500 rem +17600 s(a,b)=s(e,h) +17700 s(e,h)=0 +17800 t=(4.5-(3.5*g)) +17900 if abs(e-a)<>2 then 18100 +18000 s((e+a)/2,(h+b)/2)=0 +18100 if b<>t then 18300 +18200 s(a,b)= -2*g +18300 for x=8to8 +18400 for y=8to8 +18500 return +18600 nexty +18700 next x +18800 print " very good, you win" +18900 print:print +19100 print " chuck out" +19200 end diff --git a/lang/basic/test/creator.b b/lang/basic/test/creator.b new file mode 100644 index 00000000..a6e023bc --- /dev/null +++ b/lang/basic/test/creator.b @@ -0,0 +1,29 @@ + 10 rem The Creator + 20 rem 80 micro jan 1983 + 80 print"This is the Creator. It will allow you to generate" + 90 print"a progam which will create and access a data file." + 100 print"For later use. Please type the proposed program name." + 110 print"You are limited to 8 alphabetic characters." + 120 print" program name=";:lineinputpn$ + 130 fori=1tolen(pn$):a$=mid$(pn$,i,1):ifa$>"z"ora$<"A"thenprint"alpha characters only!":goto 120 + 140 nexti + 150 iflen(pn$)>8thenprint"too long":goto 120 + 160 print"when the proposed program is run, which drive contains the" + 170 print"data file(0-3)?"; + 180 an$=inkey$:ifan$="" then 180 elseif(an$>"3"oran$<"0")then170 + 190 printan$ + 200 print"which drive do you want the program written on? (0-3)"; + 210 dn$=inkey$:ifdn$="" then 210 elseif(dn$>"3"ordn$<"0")then200 + + 240 print#1," 1 rem*******Program name:";pn$;"*******" + 250 print#1," 2 rem*******Data File name:";df$;"*****" + 260 print#1," 3 rem*******Data File is on drive";ans$;"******" + 270 input"What is the maximum data file size, in # of records";ms + 280 input"What is the record length(1-255)";rr:ifrr<0orrr>255then280 else r%=256/rr + 290 ifms*256/r%>85760thenprint"not enough room on a single disk for this.":goto 270 + 300 print#1,"4 rem ******maximum file size is";ms;"records******" + 310 print#1,"5 rem****** record length is";rr;"packed";r%;"per sector" + 320 q$=chr$(34) + 330 print"please type in a title for your generated program.":lineinputti$ + 340 ln=ln+10:print#1,ln;"rem change disks reinitialize here" + 350 ln=ln+10 diff --git a/lang/basic/test/grafiek.b b/lang/basic/test/grafiek.b new file mode 100644 index 00000000..3decbf66 --- /dev/null +++ b/lang/basic/test/grafiek.b @@ -0,0 +1,55 @@ +0015 print +0020 for f =2 to 72 step 2 +0030 print tab (f) "-" ; +0040 next f +0043 print +0045 c= 30 +0050 for x=6 to 360 step 12 +0060 a=30 +25*sin(x*0.01745329) +0070 b=30+25*cos(x*0.01745329) +0080 if a=c then 0130 +0090 if b=c then 0190 +0100 if a=b then 0230 +0110 if a>c then 0290 +0120 if c>a then 0380 +0130 if a>b then 0360 +0140 ifb>a then 0170 +0150 print tab(b) "." tab(a) "*" +0160 goto 0460 +0170 print tab(a) "*" tab(b) "." +0180 goto 0460 +0190 if a>b then 0210 +0200 if b>a then 0220 +0210 goto 0150 +0220 goto 0170 +0230 if a>c then 0250 +0240 if c>a then 0270 +0250 print tab(c) "I" tab(a) "*" +0260 goto 0460 +0270 print tab(a) "*" tab(c) "I" +0280 goto 0460 +0290 if b>a then 0340 +0300 if a>b then 0302 +0302 if c>b then 0320 +0305 if bc then 0360 +0320 print tab(b) "." tab(c) "I" tab(a) "*" +0330 goto 0460 +0340 print tab(c) "I" tab(a) "*" tab(b) "." +0350 goto 0460 +0360 print tab(c) "I" tab(b) "." tab(a) "*" +0370 goto 0460 +0380 if a>b then 0430 +0385 if c>b then 0410 +0387 if b>c then 0450 +0395 if a>b then 0410 +0400 if b>a then 0450 +0410 print tab(a) "*" tab(b) "." tab(c) "I" +0420 goto 0460 +0430 print tab(b) "." tab(a) "*" tab(c) "I" +0440 goto 0460 +0450 print tab(a) "*" tab(c) "I" tab(b) "." +0460 next x +0470 end + + diff --git a/lang/basic/test/grafiek.b.g b/lang/basic/test/grafiek.b.g new file mode 100644 index 00000000..b3e41f81 --- /dev/null +++ b/lang/basic/test/grafiek.b.g @@ -0,0 +1,34 @@ + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + I * . + I * . + I * . + I * . + I . * + I . * + I . * + I + . * + . I * + . I * + . I * + . I * + . I * + . I * + . I * + . * I + . * I + . * I + . * I + * . I + * . I + * . I + * . + I + * I . + * I . + * I . + * I . + * I . + * I . + * I . diff --git a/lang/basic/test/gunner.b b/lang/basic/test/gunner.b new file mode 100644 index 00000000..ef76fd3d --- /dev/null +++ b/lang/basic/test/gunner.b @@ -0,0 +1,58 @@ +10 rem gunner program +90 randomize +100 print "this program simulates the results " +110 print "of firing a field artillery weapon" +120 print +130 print "you are the officer-in-charge, giving orders to the gun" +140 print "crew, telling them the degrees of elevation you estimate" +150 print "will place the projectile on target. A hit within 100 yards" +160 print "of the target will destroy it. Take more than 5 shots," +170 print "end the enemy will destroy you!":print +180 print "maximum range of your gun is 46500 yards." +185 z=0 +190 print +195 s1=0 +200 t= 43000-30000*rnd(x) +210 s=0 +220 goto 370 +230 print"minimum elevation of the gun is one degree." +240 goto 390 +250 print "maximum elevation of gun is 89 degrees." +260 goto 390 +270 print "over target by";abs(e);"yards" +280 goto 390 +290 print "short of target by";abs(e);"yards" +300 goto 390 +310 goto 320 +320 print "*****target destroyed ****";s;"rounds of ammunition expended" +322 gosub 600 +325 s1=s1+s +330 if z=4 then 490 +340 z=z+1 +345 print +350 print "the forward observer has sighted more enemy activity." +360 goto 200 +370 print " distance to the target is";int(t);"yards...." +380 print +390 print +400 print "elevation"; +410 input b +420 if b>89 then 250 +430 if b<1 then 230 +440 s=s+1 +442 if s<6 then 450 +444 print:print "BOOM !!! You have been destroyed"; +445 gosub 600 +446 print "by the enemy":print:print:goto 495 +450 b2=2*b/57.3:let i=46500*sin(b2):x=t-i:e=int(x) +460 if abs(e)<100 then 310 +470 if e>100 then 290 +480 if e<-100 then 270 +490 print:print:print "total rounds expended were";s1 +491 if s1>15 then 495:print "nice shooting!!":gosub 600:goto 500 +495 print "better go back to fort silly for refresher training!" +500 print:print "thank you for playing!" +505 print:print "try again....":print:goto 180 +600 rem for n=1 to 10 print chr$(7): rem next n +610 return +999 end diff --git a/lang/basic/test/gunner.b.g b/lang/basic/test/gunner.b.g new file mode 100644 index 00000000..75ae3ec8 --- /dev/null +++ b/lang/basic/test/gunner.b.g @@ -0,0 +1,15 @@ +this program simulates the results +of firing a field artillery weapon + +you are the officer-in-charge, giving orders to the gun +crew, telling them the degrees of elevation you estimate +will place the projectile on target. A hit within 100 yards +of the target will destroy it. Take more than 5 shots, +end the enemy will destroy you! + +maximum range of your gun is 46500 yards. + + distance to the target is 43000 yards.... + + +elevation?LINE 410:ERROR 2: Out of data diff --git a/lang/basic/test/learn.b b/lang/basic/test/learn.b new file mode 100644 index 00000000..6fb7439c --- /dev/null +++ b/lang/basic/test/learn.b @@ -0,0 +1,25 @@ +10 REM Learning program I +15 dim variable(10), rank(10), varname$(10) +20 input "how many variable have you";v +30 for i=1to v :variable(i)=0:rank(i)=0:next i +40 print "please name these variable" +50 for i=1to v: input "variable name";varname$(i):next i +60 print "Please name the outcomes" +70 input "outcome 1";q1$ +80 input "outcome 2"; q2$ +90 for i=1 to v:variable(i)=0 +100 print "variable ";varname(i); +110 input "is this variable the case";a$ +120 if a$="y" then variable(i)=1 +130 next i +140 d=0 +150 for i=1 to v +160 d=d+variable(i)* rank(i) +170 next i +175 print "conclusion: ";d; +180 if d>=0 then print q1$ +190 if d<0 then print q2$ +195 input "is this right";a$:if a$="y" then:goto 90 +200 if d>=0 and a$="n" then: for i=1 to v:rank(i)=rank(i)-variable(i):next i +210 if d<0 and a$="n" then: for i=1 to v:rank(i)=rank(i)+variable(i):next i +220 goto 90 diff --git a/lang/basic/test/learn.b.g b/lang/basic/test/learn.b.g new file mode 100644 index 00000000..1ff75935 --- /dev/null +++ b/lang/basic/test/learn.b.g @@ -0,0 +1 @@ +how many variable have you?LINE 20:ERROR 2: Out of data diff --git a/lang/basic/test/opg1.b b/lang/basic/test/opg1.b new file mode 100644 index 00000000..54cb694e --- /dev/null +++ b/lang/basic/test/opg1.b @@ -0,0 +1,6 @@ +100 rem interest rate program page 33 +110 read m,d,p,n +300 let r= m * d /(p*(n+1)) * 200 +400 print "percent interest is",r +500 data 12, 320, 3000, 36 +600 end diff --git a/lang/basic/test/opg1.b.g b/lang/basic/test/opg1.b.g new file mode 100644 index 00000000..17bd3247 --- /dev/null +++ b/lang/basic/test/opg1.b.g @@ -0,0 +1 @@ +percent interest is 0.000173 diff --git a/lang/basic/test/opg2.b b/lang/basic/test/opg2.b new file mode 100644 index 00000000..dbbfca32 --- /dev/null +++ b/lang/basic/test/opg2.b @@ -0,0 +1,16 @@ +100 rem Square root program (47) +110 rem this program uses the newton raphson +120 rem technique to calculate the square root +130 read a,e +140 let x =(a+2)/3 +150 let x1= (x+a/x)*.5 +160 rem determine absolute value of x1-x +170 let n= x1-x +180 if n>= 0 then 200 +190 let n= 0-n +200 if n= 20 then 120 +100 let n= n+1 +110 goto 40 +120 end diff --git a/lang/basic/test/opg3.b.g b/lang/basic/test/opg3.b.g new file mode 100644 index 00000000..c81682a3 --- /dev/null +++ b/lang/basic/test/opg3.b.g @@ -0,0 +1,21 @@ +n n2 n3 1/n square root + 1 1 1 1 1 + 2 4 8 0.5 1.414214 + 3 9 27 0.333333 1.732051 + 4 16 64 0.25 2 + 5 25 125 0.2 2.236068 + 6 36 216 0.166667 2.44949 + 7 49 343 0.142857 2.645751 + 8 64 512 0.125 2.828427 + 9 81 729 0.111111 3 + 10 100 1000 0.1 3.162278 + 11 121 1331 0.090909 3.316625 + 12 144 1728 0.083333 3.464102 + 13 169 2197 0.076923 3.605551 + 14 196 2744 0.071429 3.741657 + 15 225 3375 0.066667 3.872983 + 16 256 4096 0.0625 4 + 17 289 4913 0.058824 4.123106 + 18 324 5832 0.055556 4.242641 + 19 361 6859 0.052632 4.358899 + 20 400 8000 0.05 4.472136 diff --git a/lang/basic/test/opg4.b b/lang/basic/test/opg4.b new file mode 100644 index 00000000..55a0548b --- /dev/null +++ b/lang/basic/test/opg4.b @@ -0,0 +1,10 @@ +010 rem values of n using for loop (52) +020 print "n","n2","n3","1/n","square root" +030 for n=1 to 20 +040 let n2= n*n +050 let n3= n*n*n +060 let r= 1/n +070 let s= n^ .5 +080 print n,n2,n3,r,s +090 next n +120 end diff --git a/lang/basic/test/opg4.b.g b/lang/basic/test/opg4.b.g new file mode 100644 index 00000000..c81682a3 --- /dev/null +++ b/lang/basic/test/opg4.b.g @@ -0,0 +1,21 @@ +n n2 n3 1/n square root + 1 1 1 1 1 + 2 4 8 0.5 1.414214 + 3 9 27 0.333333 1.732051 + 4 16 64 0.25 2 + 5 25 125 0.2 2.236068 + 6 36 216 0.166667 2.44949 + 7 49 343 0.142857 2.645751 + 8 64 512 0.125 2.828427 + 9 81 729 0.111111 3 + 10 100 1000 0.1 3.162278 + 11 121 1331 0.090909 3.316625 + 12 144 1728 0.083333 3.464102 + 13 169 2197 0.076923 3.605551 + 14 196 2744 0.071429 3.741657 + 15 225 3375 0.066667 3.872983 + 16 256 4096 0.0625 4 + 17 289 4913 0.058824 4.123106 + 18 324 5832 0.055556 4.242641 + 19 361 6859 0.052632 4.358899 + 20 400 8000 0.05 4.472136 diff --git a/lang/basic/test/opg5.b b/lang/basic/test/opg5.b new file mode 100644 index 00000000..83d127fa --- /dev/null +++ b/lang/basic/test/opg5.b @@ -0,0 +1,13 @@ + + 10 rem find largest number (57) + 20 read l + 30 let r=0 + 40 for z=1 to l + 50 read a + 60 if a<=r then 80 + 70 let r=a + 80 next z + 90 print "largest number is",r +100 data 10 +110 data 106, 42,-12,111,88,91,3,263,-1042,7 +120 end diff --git a/lang/basic/test/opg5.b.g b/lang/basic/test/opg5.b.g new file mode 100644 index 00000000..4d29e5aa --- /dev/null +++ b/lang/basic/test/opg5.b.g @@ -0,0 +1 @@ +largest number is 263 diff --git a/lang/basic/test/opg6.b b/lang/basic/test/opg6.b new file mode 100644 index 00000000..2ce12915 --- /dev/null +++ b/lang/basic/test/opg6.b @@ -0,0 +1,14 @@ +1000 rem Temperature conversion +1010 print "fahrenheit","centrigrade","kelvin","rankin" +1020 for s= 1 to 5 +1030 print +1040 next s +1050 for i= 1 to 12 +1060 read f +1070 let c= 5/9 *(f-32) +1080 let k = c+273 +1090 let r= f+ 460 +1100 print f,c,k,r +1110 next i +1120 data 144, 36,110,98,63,26,14,78,66,51,107,2 +1130 end diff --git a/lang/basic/test/opg6.b.g b/lang/basic/test/opg6.b.g new file mode 100644 index 00000000..e7b51cfd --- /dev/null +++ b/lang/basic/test/opg6.b.g @@ -0,0 +1,18 @@ +fahrenheit centrigrade kelvin rankin + + + + + + 144 0.00496 273.00496 604 + 36 0.138889 273.138889 496 + 110 0.007123 273.007123 570 + 98 0.008418 273.008418 558 + 63 0.017921 273.017921 523 + 26 -0.092593 272.907407 486 + 14 -0.030864 272.969136 474 + 78 0.012077 273.012077 538 + 66 0.01634 273.01634 526 + 51 0.02924 273.02924 511 + 107 0.007407 273.007407 567 + 2 -0.018519 272.981481 462 diff --git a/lang/basic/test/runcmp b/lang/basic/test/runcmp new file mode 100755 index 00000000..358ba002 --- /dev/null +++ b/lang/basic/test/runcmp @@ -0,0 +1,23 @@ +echo -n $1 " " +if abc - -o $1.x $1 +then + if $1.x >$1.r + then :; else + echo -n "------- execution error(s)" + fi + if diff $1.g $1.r >$1.d 2>/dev/null + then + echo -*- Ok + else + if test -r $1.g + then + echo ------- differences in executing $1 + cat $1.d + else + mv $1.r $1.g + fi + fi + rm $1.[rd] +else + echo "------- compilation error(s)" +fi diff --git a/lang/basic/test/som4.b b/lang/basic/test/som4.b new file mode 100644 index 00000000..3747cfb9 --- /dev/null +++ b/lang/basic/test/som4.b @@ -0,0 +1,17 @@ +0010 print " beginwaarde =a" +0020 input a +0030 print "eindwaarde =b" +0040 input b +0050 if b0 then print "ok2" elseprint "error2" +120 if 1<2 then print "1<2" else print "error 1<2" +130 if 1<0 then print "error 1<0" else print "1<0 " +220 if 1<=2 then print "1<=2" else print "error 1<=2" +230 if 1<=0 then print "error 1<=0" else print "1<=0 " +320 if 1>2 then print "error 1>2" else print "1>2" +330 if 1>0 then print "1>0" else print "error 1>0 " +420 if 1>=2 then print "error 1>=2" else print "1>=2" +430 if 1>=0 then print "1>=0" else print "error 1>=0 " +500 if -1 and -1 then print "-1 and -1" else print "error -1 and -1" +510 if -1 and 0 then print "error -1 and 0" else print "-1 and 0" +520 if -1 or -1 then print "-1 or -1" else print "error -1 and -1" +530 if -1 or 0 then print "-1 or 0" else print"error -1 or 0" +540 if 0 or 0 then print "error 0 or 0" else print "0 or 0" +600 if 1<1 then print "error 1<1" else print "1<1" +605 i=100 +610 if i=100 then print "i=100" else print "error i=100" diff --git a/lang/basic/test/test09.b.g b/lang/basic/test/test09.b.g new file mode 100644 index 00000000..12d6e038 --- /dev/null +++ b/lang/basic/test/test09.b.g @@ -0,0 +1,17 @@ +ok +ok2 +1<2 +1<0 +1<=2 +1<=0 +1>2 +1>0 +1>=2 +1>=0 +-1 and -1 +-1 and 0 +-1 or -1 +-1 or 0 +0 or 0 +1<1 +i=100 diff --git a/lang/basic/test/test10.b b/lang/basic/test/test10.b new file mode 100644 index 00000000..6edc8543 --- /dev/null +++ b/lang/basic/test/test10.b @@ -0,0 +1,7 @@ +100 rem compound goto +110 leti=1:print i +120 on i goto 130, 140, 150 +121 printi"end":stop +130 print "line130":i=i+1:goto120 +140 print "line140":i=i+1:goto120 +150 print "line150":i=i+1:goto120 diff --git a/lang/basic/test/test10.b.g b/lang/basic/test/test10.b.g new file mode 100644 index 00000000..835ea60c --- /dev/null +++ b/lang/basic/test/test10.b.g @@ -0,0 +1,5 @@ + 1 +line130 +line140 +line150 +LINE 120:ERROR 1: RETURN without GOSUB diff --git a/lang/basic/test/test11.b b/lang/basic/test/test11.b new file mode 100644 index 00000000..2ba31afc --- /dev/null +++ b/lang/basic/test/test11.b @@ -0,0 +1,4 @@ +100 rem the first forloop +110 for i=1 to 4 step2 +120 print i +130 nexti diff --git a/lang/basic/test/test11.b.g b/lang/basic/test/test11.b.g new file mode 100644 index 00000000..9855ceaa --- /dev/null +++ b/lang/basic/test/test11.b.g @@ -0,0 +1,2 @@ + 1 + 3 diff --git a/lang/basic/test/test12.b b/lang/basic/test/test12.b new file mode 100644 index 00000000..c6596340 --- /dev/null +++ b/lang/basic/test/test12.b @@ -0,0 +1,6 @@ +100 gosub 200 +110 print "succeeded" +120 stop + +200 print "subroutine" +210 return diff --git a/lang/basic/test/test12.b.g b/lang/basic/test/test12.b.g new file mode 100644 index 00000000..809b8ded --- /dev/null +++ b/lang/basic/test/test12.b.g @@ -0,0 +1,3 @@ +subroutine +succeeded +Break in 120 diff --git a/lang/basic/test/test13.b b/lang/basic/test/test13.b new file mode 100644 index 00000000..eee14636 --- /dev/null +++ b/lang/basic/test/test13.b @@ -0,0 +1,7 @@ +100 rem compound goto +110 leti=1:print i +120 on i gosub 130, 140, 150 +121 printi"end":stop +130 print "line130":i=i+1:return +140 print "line140":i=i+1:return +150 print "line150":i=i+1:return diff --git a/lang/basic/test/test13.b.g b/lang/basic/test/test13.b.g new file mode 100644 index 00000000..21a74d6d --- /dev/null +++ b/lang/basic/test/test13.b.g @@ -0,0 +1,4 @@ + 1 +line130 + 2 end +Break in 121 diff --git a/lang/basic/test/test14.b b/lang/basic/test/test14.b new file mode 100644 index 00000000..487e00f9 --- /dev/null +++ b/lang/basic/test/test14.b @@ -0,0 +1,11 @@ +100 dim a(13) +101 print "help",a(1) +102 a(1)=3: print "ok" +103 print a(1) +107 for i=0 to 13 +108 a(i)=i*i +109 nexti +112 for i=0 to 13 +113 print i, a(i) +114 nexti +115 a(-4)= 3 diff --git a/lang/basic/test/test14.b.g b/lang/basic/test/test14.b.g new file mode 100644 index 00000000..66d9610d --- /dev/null +++ b/lang/basic/test/test14.b.g @@ -0,0 +1,17 @@ +help 0 +ok + 3 + 0 0 + 1 1 + 2 4 + 3 9 + 4 16 + 5 25 + 6 36 + 7 49 + 8 64 + 9 81 + 10 100 + 11 121 + 12 144 + 13 169 diff --git a/lang/basic/test/test15.b b/lang/basic/test/test15.b new file mode 100644 index 00000000..2e262d04 --- /dev/null +++ b/lang/basic/test/test15.b @@ -0,0 +1,6 @@ +100 rem non-declared array test +110 s$(1)= "menu" +120 s(2)= "enter date" +130 print s(1) +140 print s(2) +150 print s(3) diff --git a/lang/basic/test/test15.b.g b/lang/basic/test/test15.b.g new file mode 100644 index 00000000..cd6f4253 --- /dev/null +++ b/lang/basic/test/test15.b.g @@ -0,0 +1,3 @@ +menu +enter date + diff --git a/lang/basic/test/test16.b b/lang/basic/test/test16.b new file mode 100644 index 00000000..1f155acf --- /dev/null +++ b/lang/basic/test/test16.b @@ -0,0 +1,11 @@ +100 rem two dimensional array +110 dim table(3,3) +120 for i=0 to 3 +130 for j=0 to 3 +135 print i,j +140 table(i,j)= i*j +150 next j,i +160 print "filled" +170 for i=0 to 3 +180 print table(i,i) +190 nexti diff --git a/lang/basic/test/test16.b.g b/lang/basic/test/test16.b.g new file mode 100644 index 00000000..7a6f68af --- /dev/null +++ b/lang/basic/test/test16.b.g @@ -0,0 +1,21 @@ + 0 0 + 0 1 + 0 2 + 0 3 + 1 0 + 1 1 + 1 2 + 1 3 + 2 0 + 2 1 + 2 2 + 2 3 + 3 0 + 3 1 + 3 2 + 3 3 +filled + 0 + 1 + 4 + 9 diff --git a/lang/basic/test/test17.b b/lang/basic/test/test17.b new file mode 100644 index 00000000..faae1309 --- /dev/null +++ b/lang/basic/test/test17.b @@ -0,0 +1,3 @@ +100 rem first trap handling test +110 print 1/0 +120 print "divide error not catched" diff --git a/lang/basic/test/test17.b.g b/lang/basic/test/test17.b.g new file mode 100644 index 00000000..f02f87e1 --- /dev/null +++ b/lang/basic/test/test17.b.g @@ -0,0 +1 @@ +LINE 110: FATAL ERROR: trap 8 diff --git a/lang/basic/test/test18.b b/lang/basic/test/test18.b new file mode 100644 index 00000000..e820e452 --- /dev/null +++ b/lang/basic/test/test18.b @@ -0,0 +1,11 @@ +110 rem second trap test +120 on error goto 200 +130 print 1/o +140 print "division error not catched" +200 print "division error catched", err, erl +210 on error goto 500 +220 print "waiting for interrupt" +230 goto 230 +500 print "interrupt catched" +510 print "generate error 352" +520 error 352 diff --git a/lang/basic/test/test18.b.g b/lang/basic/test/test18.b.g new file mode 100644 index 00000000..4b915d20 --- /dev/null +++ b/lang/basic/test/test18.b.g @@ -0,0 +1,5 @@ +division error catched 8 130 +waiting for interrupt +interrupt catched +generate error 352 +LINE 520:ERROR 352: Unprintable error diff --git a/lang/basic/test/test19.b b/lang/basic/test/test19.b new file mode 100644 index 00000000..8e1e4f93 --- /dev/null +++ b/lang/basic/test/test19.b @@ -0,0 +1,15 @@ +100 read a +110 print a +120 restore +130 read b +140 print b +142 restore +143 restore 170 +144 read b,c +145 print b,c +146 print "try to read beyond eof" +147 read d +148 print d +150 data 6 +170 data 8,9 +180 end diff --git a/lang/basic/test/test19.b.g b/lang/basic/test/test19.b.g new file mode 100644 index 00000000..7da15014 --- /dev/null +++ b/lang/basic/test/test19.b.g @@ -0,0 +1,5 @@ + 6 + 6 + 8 9 +try to read beyond eof +LINE 147:ERROR 2: Out of data diff --git a/lang/basic/test/test20.b b/lang/basic/test/test20.b new file mode 100644 index 00000000..f09f9e4f --- /dev/null +++ b/lang/basic/test/test20.b @@ -0,0 +1,9 @@ +100 read a +110 read b +120 read c,d, e +130 let x=a+b+c+d +140 print a,b,c,d,e,x +150 data 6 +160 data 7,3 +170 data 142, 0 +180 end diff --git a/lang/basic/test/test20.b.g b/lang/basic/test/test20.b.g new file mode 100644 index 00000000..da637dd4 --- /dev/null +++ b/lang/basic/test/test20.b.g @@ -0,0 +1,2 @@ + 6 7 3 142 0 + 158 diff --git a/lang/basic/test/test21.b b/lang/basic/test/test21.b new file mode 100644 index 00000000..d8d24d43 --- /dev/null +++ b/lang/basic/test/test21.b @@ -0,0 +1,10 @@ +80 open "i",#3,"tst/data" +100 input #3, a +105 print a +110 input #3, b +115 print b +120 input #3, c,d +125 print c,d +130 let x=a+b+c+d +140 print a,b,c,d,x +180 end diff --git a/lang/basic/test/test21.b.g b/lang/basic/test/test21.b.g new file mode 100644 index 00000000..a10b9c6c --- /dev/null +++ b/lang/basic/test/test21.b.g @@ -0,0 +1,4 @@ + 1.1 + 2.4 + 3.9 4.16 + 1.1 2.4 3.9 4.16 11.56 diff --git a/lang/basic/test/test22.b b/lang/basic/test/test22.b new file mode 100644 index 00000000..c69d7e35 --- /dev/null +++ b/lang/basic/test/test22.b @@ -0,0 +1,9 @@ +10 open "i", #6, "tst/data1" +20 input #6, s$ +30 print s$ +40 input #6, s1$ +50 print s1$ +60 print "try to read beyond" +70 input #6, s$ +80 print s$ +90 end diff --git a/lang/basic/test/test22.b.g b/lang/basic/test/test22.b.g new file mode 100644 index 00000000..8881da2d --- /dev/null +++ b/lang/basic/test/test22.b.g @@ -0,0 +1,4 @@ +hello brave new world +handicap +try to read beyond +ÿ diff --git a/lang/basic/test/test23.b b/lang/basic/test/test23.b new file mode 100644 index 00000000..55f5d52f --- /dev/null +++ b/lang/basic/test/test23.b @@ -0,0 +1,11 @@ +100 print "testing input from terminal" +130 input "integer"; a +140 print a +220 input "float:", a +240 print a +330 input b$ +340 print b$ +350 input ; "c and d "; c,d +360 print c,d +400 end + diff --git a/lang/basic/test/test23.b.g b/lang/basic/test/test23.b.g new file mode 100644 index 00000000..78d2a9ca --- /dev/null +++ b/lang/basic/test/test23.b.g @@ -0,0 +1,2 @@ +testing input from terminal +integer?LINE 130:ERROR 2: Out of data diff --git a/lang/basic/test/test24.b b/lang/basic/test/test24.b new file mode 100644 index 00000000..53434c9e --- /dev/null +++ b/lang/basic/test/test24.b @@ -0,0 +1,8 @@ +100 rem float arithmetic +110 print "1.0+3.14=" 1.0+3.14 +115 a= 1.0+3.14: print a +120 print "3.19*23.6=", 3.19*23.6 +125 b= 3.19*23.6: print b +220 print "3.19*(23.6+23)=", 3.19*(23.6+23) +225 b= 3.19*(23.6+23): print b +230 end diff --git a/lang/basic/test/test24.b.g b/lang/basic/test/test24.b.g new file mode 100644 index 00000000..cabcc411 --- /dev/null +++ b/lang/basic/test/test24.b.g @@ -0,0 +1,6 @@ +1.0+3.14= 4.14 + 4.14 +3.19*23.6= 75.284 + 75.284 +3.19*(23.6+23)= 148.654 + 148.654 diff --git a/lang/basic/test/test25.b b/lang/basic/test/test25.b new file mode 100644 index 00000000..143887b4 --- /dev/null +++ b/lang/basic/test/test25.b @@ -0,0 +1,7 @@ +100 rem declare parameterless functions +120 def fnpi= 3.14 +130 print fnpi, fnpi+2 +140 def fnsqr(x)= x*x +150 print fnsqr(2.0) +240 def fnpow(x,k)= x-k +250 print fnpow(2.0,3.0) diff --git a/lang/basic/test/test25.b.g b/lang/basic/test/test25.b.g new file mode 100644 index 00000000..77ae8871 --- /dev/null +++ b/lang/basic/test/test25.b.g @@ -0,0 +1,3 @@ + 3.14 5.14 + 4 +-1 diff --git a/lang/basic/test/test26.b b/lang/basic/test/test26.b new file mode 100644 index 00000000..17eafb65 --- /dev/null +++ b/lang/basic/test/test26.b @@ -0,0 +1,17 @@ +70 print "cint" cint(45.67), cint(-45.67) +80 print "fix" fix(58.75), fix(-58.75) +90 print "int" int(99.98), int(-12.11) +100 print "abs" abs(-1), abs(-3.14), abs(1), abs(1.0), abs(-0) +110 print "sgn" sgn(-1), sgn(-3.14), sgn(1), sgn(1.0), sgn(-0) +120 print "asc" asc("a"), asc("0") +130 print "atn" atn(0), atn(3.14/2), atn(3.14), atn(0.5) +140 print "chr" chr$(97), chr$(48) +150 print "cos" cos(0), cos(3.14/2), cos(3.14), cos(-1) +160 print "sin" sin(0), sin(3.14/2), sin(3.14), sin(-1) +170 print "exp" exp(0), exp(3.14/2), exp(3.14), exp(-1) +180 print "hex" hex(0), hex(16), hex(-1) +190 print "oct" oct(0), oct(16), oct(-1) +200 print "len" len(""), len("abc"), len("a") +270 print "tan" tan(0), tan(3.14/2), tan(3.14), tan(-1) +280 print "sqr" sqr(0), sqr(3.14/2), sqr(3.14) +290 print "log" log(3.14/2), log(3.14) diff --git a/lang/basic/test/test26.b.g b/lang/basic/test/test26.b.g new file mode 100644 index 00000000..c102d0b8 --- /dev/null +++ b/lang/basic/test/test26.b.g @@ -0,0 +1,17 @@ +cint 46 -46 +fix 58 -58 +int 99 -13 +abs 1 3.14 1 1 0 +sgn-1 -1 1 1 0 +asc 97 48 +atn 0 1.003655 1.262481 0.463648 +chra 0 +cos 1 0.000796 -0.999999 0.540302 +sin 0 1 0.001593 -0.841471 +exp 1 4.806648 23.103867 0.367879 +hex0 10 ffff +oct0 20 177777 +len 0 3 1 +tan 0 1255.765592 -0.001593 -1.557408 +sqr 0 1.252996 1.772005 +log 0.451076 1.144223 diff --git a/lang/basic/test/test27.b b/lang/basic/test/test27.b new file mode 100644 index 00000000..6927c995 --- /dev/null +++ b/lang/basic/test/test27.b @@ -0,0 +1,12 @@ +0 rem string test +110 yes$= "yes" +120 no$="no" +130 if "yes"="no" then print "130 true" else print "130 f" +140 if "yes"="yes" then print "140 true" else print "140 f" +150 if "yes"="" then print "150 true" else print "150 f" +160 if "yes"=yes then print "160 true" else print "160 f" +170 if yes="yes" then print "170 true" else print "170 f" +180 print "yes or no" +190 input answer$ +200 print answer$="yes" +210 print answer$=no diff --git a/lang/basic/test/test27.b.g b/lang/basic/test/test27.b.g new file mode 100644 index 00000000..5475f1cd --- /dev/null +++ b/lang/basic/test/test27.b.g @@ -0,0 +1,8 @@ +130 f +140 true +150 f +160 true +170 true +yes or no +? 0 + 0 diff --git a/lang/basic/test/test28.b b/lang/basic/test/test28.b new file mode 100644 index 00000000..280be4b1 --- /dev/null +++ b/lang/basic/test/test28.b @@ -0,0 +1,7 @@ +10 rem reading beyond eof +11 open "r",#1,"tst/test01" +13 print eof(#1) +20 while eof(#1) <> -1 +22 line #1, l$ +23 print eof(#1), l +24 wend diff --git a/lang/basic/test/test28.b.g b/lang/basic/test/test28.b.g new file mode 100644 index 00000000..74563f02 --- /dev/null +++ b/lang/basic/test/test28.b.g @@ -0,0 +1,2 @@ + 0 +LINE 22:ERROR 40: Syntax error in data diff --git a/lang/basic/test/test29.b b/lang/basic/test/test29.b new file mode 100644 index 00000000..4eb2b19f --- /dev/null +++ b/lang/basic/test/test29.b @@ -0,0 +1,14 @@ +5 print not 1, not 0 +10 print 1 and 1, 1 and 0, 0 and 1, 0 and 0 +13 print 1 or 1, 1 or 0, 0 or 1, 0 or 0 +15 print 1 xor 1, 1 xor 0, 0 xor 1, 0 xor 0 +20 print 1 eqv 1, 1 eqv 0, 0 eqv 1, 0 eqv 0 +30 print 1 imp 1, 1 imp 0, 0 imp 1, 0 imp 0 +40 print 63 and 16, "=16?" +50 print 15 and 14, "=14?" +60 print -1 and 8, "=8?" +70 print 4 or 2, "=6?" +80 print 10 or 10 , "is 10?" +90 print -1 or -2 "=-1?" +100 print not 13 +110 print -(13+1) diff --git a/lang/basic/test/test29.b.g b/lang/basic/test/test29.b.g new file mode 100644 index 00000000..a849926c --- /dev/null +++ b/lang/basic/test/test29.b.g @@ -0,0 +1,14 @@ +-2 -1 + 1 0 0 0 + 1 1 1 0 + 0 1 1 0 +-1 -2 -2 -1 +-1 -2 -1 -1 + 16 =16? + 14 =14? + 8 =8? + 6 =6? + 10 is 10? +-1 =-1? +-14 +-14 diff --git a/lang/basic/test/test30.b b/lang/basic/test/test30.b new file mode 100644 index 00000000..81b9a632 --- /dev/null +++ b/lang/basic/test/test30.b @@ -0,0 +1,8 @@ +100 rem writing to a file +110 open "o", #2, "tst/output" +113 open "i", #3, "tst/output" +120 a$="CAMERA": b$="93604-1" +130 write a$,b$ +140 write #2, a$, b$ +145 input #3, b$: print b$ +150 write #3, a$, b$ diff --git a/lang/basic/test/test30.b.g b/lang/basic/test/test30.b.g new file mode 100644 index 00000000..3ff31e03 --- /dev/null +++ b/lang/basic/test/test30.b.g @@ -0,0 +1,3 @@ +"CAMERA","93604-1" +CAMERA +LINE 150:ERROR 29: Bad file mode diff --git a/lang/basic/test/test31.b b/lang/basic/test/test31.b new file mode 100644 index 00000000..be46606d --- /dev/null +++ b/lang/basic/test/test31.b @@ -0,0 +1,11 @@ +10 a$(0)= "fbc" +11 a$(1)= "fcc" +12 a$(2)= "abb" +90 'bubble sort array +100 j=2: flips=1 'one more pass +110 while flips +115 flips=0 +120 for i=0 to j-1 +130 if a$(i)>a$(i+1) then swap a$(i),a$(i+1): flips=1 +140 nexti +150 wend diff --git a/lang/basic/test/test31.b.g b/lang/basic/test/test31.b.g new file mode 100644 index 00000000..e69de29b diff --git a/lang/basic/test/test32.b b/lang/basic/test/test32.b new file mode 100644 index 00000000..fa1d3c7f --- /dev/null +++ b/lang/basic/test/test32.b @@ -0,0 +1,5 @@ + 10 rem mid statement and function + 20 a$= "kansas city, mo" + 25 print mid$(a$,14) + 45 print mid$(a$,3,3) + 55 print mid$(a$,33) diff --git a/lang/basic/test/test32.b.g b/lang/basic/test/test32.b.g new file mode 100644 index 00000000..d0d7c39c --- /dev/null +++ b/lang/basic/test/test32.b.g @@ -0,0 +1,3 @@ +mo +nsa + diff --git a/lang/basic/test/test33.b b/lang/basic/test/test33.b new file mode 100644 index 00000000..0c528145 --- /dev/null +++ b/lang/basic/test/test33.b @@ -0,0 +1,6 @@ +10 rem function parameters +20 def fnf1(x%,s$)= 3123 +30 print fnf1(1,"help") +40 print fnf1(3.12,"xx") +50 rem doet i goed print fnf1("help",3) +60 rem GOED print fnf1(4) diff --git a/lang/basic/test/test33.b.g b/lang/basic/test/test33.b.g new file mode 100644 index 00000000..99a73b89 --- /dev/null +++ b/lang/basic/test/test33.b.g @@ -0,0 +1,2 @@ + 3123 + 3123 diff --git a/lang/basic/test/test34.b b/lang/basic/test/test34.b new file mode 100644 index 00000000..dd6b8655 --- /dev/null +++ b/lang/basic/test/test34.b @@ -0,0 +1,4 @@ +10 rem multidimensional arrays +20 t(3,4)= 4 +30 print t(0,0) +40 print t(3,4) diff --git a/lang/basic/test/test35.b b/lang/basic/test/test35.b new file mode 100644 index 00000000..1598676e --- /dev/null +++ b/lang/basic/test/test35.b @@ -0,0 +1,2 @@ +10 rem call external routine +20 call time(v) diff --git a/lang/basic/test/test35.b.g b/lang/basic/test/test35.b.g new file mode 100644 index 00000000..e69de29b diff --git a/lang/basic/test/tst/data b/lang/basic/test/tst/data new file mode 100644 index 00000000..8a393275 --- /dev/null +++ b/lang/basic/test/tst/data @@ -0,0 +1 @@ +1.1, 2.4, 3.9, 4.16 diff --git a/lang/basic/test/tst/data1 b/lang/basic/test/tst/data1 new file mode 100644 index 00000000..f3afab40 --- /dev/null +++ b/lang/basic/test/tst/data1 @@ -0,0 +1,2 @@ +"hello brave new world" +handicap diff --git a/lang/cem/ctest/Out2.nf.std b/lang/cem/ctest/Out2.nf.std new file mode 100644 index 00000000..29053b77 --- /dev/null +++ b/lang/cem/ctest/Out2.nf.std @@ -0,0 +1,374 @@ +Fri Feb 15 14:24:12 MET 1985 +***** ctconv +acc -DNOFLOAT conv.c +conv.c +"conv.c", line 48: warning: Overflow in constant expression +running conv.cem +comparing conv +2a3,4 +> (float) 12 = 12.000000 +> (int) 3.14 = 3 +11,$c13,$ +< char 255, int 255, unsigned 377, long 255 +< char 255, int 255, unsigned 377, long 255 +< From integer +< char 192, int -64, unsigned 177700, long -64 +< From long +< char 253, int -3, unsigned 177775, long -3 +< a[l] (l==3) -17 +< a[3l] -17 +--- +> float 127.000000 +> char 255, int 255, unsigned 377, long 255 +> float 255.000000 +> char 255, int 255, unsigned 377, long 255 +> float 255.000000 +> From integer +> char 192, int -64, unsigned 177700, long -64 +> float -64.000000 +> From long +> char 253, int -3, unsigned 177775, long -3 +> float -3.000000 +> From float +> char 121, int 121, unsigned 171, long 121, float 121.500000 +> char 0, int 0, unsigned 0, long 0, float 0.000100 +> int 32766, unsigned 77776, long 32766, float 32766.000000 +> long 1223432064, float 1223432064.000000 +> a[l] (l==3) -17 +> a[3l] -17 +***** ctdecl +acc -DNOFLOAT decl.c +decl.c +running decl.cem +comparing decl +***** ctdivers +acc -DNOFLOAT ops.c +ops.c +running ops.cem +comparing ops +***** cterr +acc -DNOFLOAT bugs.c +bugs.c +"bugs.c", line 98: warning: Overflow in constant expression +running bugs.cem +comparing bugs +***** ctest1 +acc -DNOFLOAT test.c +test.c +running test.cem +comparing test +1,$c1,$ +< End of test program, 10 tests completed, 0 errors detected +--- +> End of test program, 11 tests completed, 0 errors detected +***** ctest2 +acc -DNOFLOAT t7.c +t7.c +"t7.c", line 163: warning: statement not reached +"t7.c", line 180: warning: statement not reached +"t7.c", line 184: warning: statement not reached +"t7.c", line 188: warning: statement not reached +"t7.c", line 192: warning: statement not reached +"t7.c", line 196: warning: statement not reached +"t7.c", line 200: warning: statement not reached +"t7.c", line 207: warning: statement not reached +"t7.c", line 209: warning: statement not reached +"t7.c", line 213: warning: statement not reached +"t7.c", line 215: warning: statement not reached +"t7.c", line 289: warning: statement not reached +"t7.c", line 296: warning: statement not reached +"t7.c", line 302: warning: statement not reached +"t7.c", line 309: warning: statement not reached +"t7.c", line 345: warning: statement not reached +"t7.c", line 346: warning: statement not reached +"t7.c", line 347: warning: statement not reached +"t7.c", line 348: warning: statement not reached +"t7.c", line 350: warning: statement not reached +"t7.c", line 454: warning: statement not reached +"t7.c", line 563: warning: statement not reached +"t7.c", line 591: warning: statement not reached +running t7.cem +comparing t7 +***** ctest3 +acc -DNOFLOAT test2.c +test2.c +running test2.cem +comparing test2 +***** ctest5 +acc -DNOFLOAT test1.c +test1.c +"test1.c", line 386: warning: illegal pointer combination +"test1.c", line 387: warning: illegal pointer combination +"test1.c", line 388: warning: illegal pointer combination +"test1.c", line 400: warning: illegal pointer combination +"test1.c", line 423: warning: illegal pointer combination +"test1.c", line 424: warning: illegal pointer combination +"test1.c", line 425: warning: illegal pointer combination +"test1.c", line 437: warning: illegal pointer combination +running test1.cem +comparing test1 +1,$c1,$ +< program test1 +< 10 tests completed. Number of errors = 0 +--- +> error 13 in test 11 +> program test1 +> 11 tests completed. Number of errors = 1 +***** ctgen +sed -f bf.sed bf.c +acc -DNOFLOAT bf.c +bf.c +running bf.cem +comparing bf +sed -f cel.sed cel.c +acc -DNOFLOAT cel.c +cel.c +running cel.cem +comparing cel +sed -f clu.sed clu.c +acc -DNOFLOAT clu.c +clu.c +"clu.c", line 60: warning: Overflow in constant expression +"clu.c", line 66: warning: Overflow in constant expression +running clu.cem +comparing clu +sed -f ec.sed ec.c +acc -DNOFLOAT ec.c +ec.c +"ec.c", line 58: warning: Overflow in constant expression +"ec.c", line 64: warning: Overflow in constant expression +running ec.cem +comparing ec +sed -f ef.sed ef.c +acc -DNOFLOAT ef.c +ef.c +running ef.cem +comparing ef +sed -f ei.sed ei.c +acc -DNOFLOAT ei.c +ei.c +"ei.c", line 22: warning: Overflow in constant expression +"ei.c", line 65: warning: Overflow in constant expression +"ei.c", line 108: warning: Overflow in constant expression +running ei.cem +comparing ei +sed -f el.sed el.c +acc -DNOFLOAT el.c +el.c +running el.cem +comparing el +sed -f eu.sed eu.c +acc -DNOFLOAT eu.c +eu.c +"eu.c", line 58: warning: Overflow in constant expression +"eu.c", line 64: warning: Overflow in constant expression +running eu.cem +comparing eu +sed -f id.sed id.c +acc -DNOFLOAT id.c +id.c +running id.cem +comparing id +sed -f lc.sed lc.c +acc -DNOFLOAT lc.c +lc.c +"lc.c", line 60: warning: Overflow in constant expression +"lc.c", line 66: warning: Overflow in constant expression +running lc.cem +comparing lc +sed -f ld.sed ld.c +acc -DNOFLOAT ld.c +ld.c +running ld.cem +comparing ld +sed -f lf.sed lf.c +acc -DNOFLOAT lf.c +lf.c +running lf.cem +comparing lf +sed -f li.sed li.c +acc -DNOFLOAT li.c +li.c +"li.c", line 22: warning: Overflow in constant expression +"li.c", line 67: warning: Overflow in constant expression +"li.c", line 112: warning: Overflow in constant expression +running li.cem +comparing li +sed -f ll.sed ll.c +acc -DNOFLOAT ll.c +ll.c +running ll.cem +comparing ll +sed -f lu.sed lu.c +acc -DNOFLOAT lu.c +lu.c +running lu.cem +comparing lu +***** ctill +----- All program(s) in this directory should fail to compile. +acc -DNOFLOAT noarg.c +noarg.c +"noarg.c", line 10: declared argument name is missing +*** Error code 1 +`gen' not remade because of errors +***** ctinit +acc -DNOFLOAT init.c +init.c +"init.c", line 183: warning: Overflow in constant expression (U-) +running init.cem +comparing init +41,$c41,$ +< long +< +< lo1 14 +< lo2 -17 +< lo3 2147483647 +< lo4 -2147483648 +< lo5 0 +< lo6 1 +< +< structures +< +< st1 sta[0..2] +< s_i 0 1 2 3 +< s_ca[0] 0 97 0 0 +< s_ca[1] 0 98 0 0 +< s_ca[2] 0 99 0 0 +< s_l 0 10 0 0 +< (sta[0].s_s1)->s_i = 1 +< +< bit fields: +< +< sizeof stb 6 +< stb 1 2 3 4 3 6 7 +< +--- +> Floats: +> +> fl1 0.00000000000000000000e+00 +> fl2 2.00000000000000000000e+00 +> fl2 2.00000000000000000000e+00 +> fl4 4.00000000000000000000e+00 +> fl5 2.93873587705571892581e-39 +> fl6 1.70141173319264427000e+38 +> fl7 0.00000000000000000000e+00 +> fla1 fla2 fla3 +> 1.000000e+00 -1.000000e+00 1.100000e+01 +> 3.000000e+00 -3.000000e+00 0.000000e+00 +> 5.000000e+00 -5.000000e+00 0.000000e+00 +> 2.000000e+00 -2.000000e+00 1.200000e+01 +> 4.000000e+00 -4.000000e+00 0.000000e+00 +> 6.000000e+00 -6.000000e+00 0.000000e+00 +> 3.000000e+00 -3.000000e+00 1.300000e+01 +> 5.000000e+00 -5.000000e+00 0.000000e+00 +> 7.000000e+00 -7.000000e+00 0.000000e+00 +> 0.000000e+00 0.000000e+00 1.400000e+01 +> 0.000000e+00 0.000000e+00 0.000000e+00 +> 0.000000e+00 0.000000e+00 0.000000e+00 +> +> Doubles: +> +> dbl1 0.00000000000000000000e+00 +> dbl2 2.00000000000000000000e+00 +> dbl2 2.00000000000000000000e+00 +> dbl4 4.00000000000000000000e+00 +> dbl5 2.93873600000000034793e-39 +> dbl6 1.70141170000000000000e+38 +> dbl7 0.00000000000000000000e+00 +> dbla1 dbla2 dbla3 +> 1.000000e+00 -1.000000e+00 1.100000e+01 +> 3.000000e+00 -3.000000e+00 0.000000e+00 +> 5.000000e+00 -5.000000e+00 0.000000e+00 +> 2.000000e+00 -2.000000e+00 1.200000e+01 +> 4.000000e+00 -4.000000e+00 0.000000e+00 +> 6.000000e+00 -6.000000e+00 0.000000e+00 +> 3.000000e+00 -3.000000e+00 1.300000e+01 +> 5.000000e+00 -5.000000e+00 0.000000e+00 +> 7.000000e+00 -7.000000e+00 0.000000e+00 +> 0.000000e+00 0.000000e+00 1.400000e+01 +> 0.000000e+00 0.000000e+00 0.000000e+00 +> 0.000000e+00 0.000000e+00 0.000000e+00 +> +> long +> +> lo1 14 +> lo2 -17 +> lo3 2147483647 +> lo4 -2147483648 +> lo5 0 +> lo6 1 +> +> structures +> +> st1 sta[0..2] +> s_i 0 1 2 3 +> s_ca[0] 0 97 0 0 +> s_ca[1] 0 98 0 0 +> s_ca[2] 0 99 0 0 +> s_l 0 10 0 0 +> s_f 0.000000e+00 -1.000000e+01 0.000000e+00 0.000000e+00 +> +> (sta[0].s_s1)->s_i = 1 +> +> bit fields: +> +> sizeof stb 6 +> stb 1 2 3 4 3 6 7 +> +***** ctmargt +acc -DNOFLOAT margt.c +margt.c +running margt.cem +comparing margt +5,$c5,$ +< BELL= +< BIN=/user0/keie/bin +< CDPATH=:/usr/em/util:/usr/em/mach:/usr/em/lang +< DIT=/user0/keie/ditroff/troff/a.out +< HOME=/usr/em +< MAILHEADER=To: botter!vu44!mcvax!%t +< Subject: Re: %S +< Newsgroups: %n +< In-Reply-To: %i +< %(%[references]!=^$?References\: %[references] +< )Organization: %o +< Cc: +< Bcc: +< +< +< PATH=:/user0/keie/bin:/usr/local:/usr/ucb:/bin:/usr/bin:/usr/em/bin:/usr/new +< SHELL=/usr/local/dsh +< TERM=d80 +< TERMCAP=ME|ampex|d80|dialogue|dialogue80:am:bs:pt:if=/usr/lib/tabset/stdcrt:cl=\E;:cm=\E=%+\040%+\040:al=10\EE:ic=3\EQ:im=:ei=:dl=10\ER:dc=\EW:is=\EA:ho=^^:ce=\ET:cd=\EY:so=\Ej:se=\Ek:us=\El:ue=\Em:ul:li#24:co#80:nd=^L:up=^K:we=\Eo:ws=\En +< USER=keie +--- +> HOME=/other/keie +> PATH=:/other/keie/bin:/bin:/usr/bin +> TERM=MiniBee +***** ctprof +test profiling +procentry.c +acc -DNOFLOAT tp.c procentry.k +tp.c +procentry.k +running tp +comparing tp +***** ctstruct +acc -DNOFLOAT str.c +str.c +running str.cem +comparing str +***** ctsys +acc -DNOFLOAT tfork.c +tfork.c +running tfork.cem +comparing tfork +1,$c1,$ +< childno 5207 +< Child 5207, status 0x800 +< fork/wait ok +--- +> childno N +> Child N, status 0x800 +> fork/wait ok +Fri Feb 15 15:55:48 MET 1985 diff --git a/lang/cem/ctest/Out2.std b/lang/cem/ctest/Out2.std new file mode 100644 index 00000000..1caecbe5 --- /dev/null +++ b/lang/cem/ctest/Out2.std @@ -0,0 +1,233 @@ +Fri Feb 15 12:15:05 MET 1985 +***** ctconv +acc conv.c +conv.c +"conv.c", line 48: warning: Overflow in constant expression +running conv.cem +comparing conv +***** ctdecl +acc decl.c +decl.c +running decl.cem +comparing decl +***** ctdivers +acc ops.c +ops.c +running ops.cem +comparing ops +***** cterr +acc bugs.c +bugs.c +"bugs.c", line 98: warning: Overflow in constant expression +running bugs.cem +comparing bugs +***** ctest1 +acc test.c +test.c +running test.cem +comparing test +***** ctest2 +acc t7.c +t7.c +"t7.c", line 163: warning: statement not reached +"t7.c", line 180: warning: statement not reached +"t7.c", line 184: warning: statement not reached +"t7.c", line 188: warning: statement not reached +"t7.c", line 192: warning: statement not reached +"t7.c", line 196: warning: statement not reached +"t7.c", line 200: warning: statement not reached +"t7.c", line 207: warning: statement not reached +"t7.c", line 209: warning: statement not reached +"t7.c", line 213: warning: statement not reached +"t7.c", line 215: warning: statement not reached +"t7.c", line 289: warning: statement not reached +"t7.c", line 296: warning: statement not reached +"t7.c", line 302: warning: statement not reached +"t7.c", line 309: warning: statement not reached +"t7.c", line 345: warning: statement not reached +"t7.c", line 346: warning: statement not reached +"t7.c", line 347: warning: statement not reached +"t7.c", line 348: warning: statement not reached +"t7.c", line 350: warning: statement not reached +"t7.c", line 454: warning: statement not reached +"t7.c", line 563: warning: statement not reached +"t7.c", line 591: warning: statement not reached +running t7.cem +comparing t7 +***** ctest3 +acc test2.c +test2.c +running test2.cem +comparing test2 +***** ctest5 +acc test1.c +test1.c +"test1.c", line 386: warning: illegal pointer combination +"test1.c", line 387: warning: illegal pointer combination +"test1.c", line 388: warning: illegal pointer combination +"test1.c", line 400: warning: illegal pointer combination +"test1.c", line 423: warning: illegal pointer combination +"test1.c", line 424: warning: illegal pointer combination +"test1.c", line 425: warning: illegal pointer combination +"test1.c", line 437: warning: illegal pointer combination +running test1.cem +comparing test1 +***** ctgen +sed -f bf.sed bf.c +acc bf.c +bf.c +running bf.cem +comparing bf +sed -f cel.sed cel.c +acc cel.c +cel.c +running cel.cem +comparing cel +sed -f clu.sed clu.c +acc clu.c +clu.c +"clu.c", line 60: warning: Overflow in constant expression +"clu.c", line 66: warning: Overflow in constant expression +running clu.cem +comparing clu +sed -f ec.sed ec.c +acc ec.c +ec.c +"ec.c", line 58: warning: Overflow in constant expression +"ec.c", line 64: warning: Overflow in constant expression +running ec.cem +comparing ec +sed -f ef.sed ef.c +acc ef.c +ef.c +running ef.cem +comparing ef +sed -f ei.sed ei.c +acc ei.c +ei.c +"ei.c", line 22: warning: Overflow in constant expression +"ei.c", line 65: warning: Overflow in constant expression +"ei.c", line 108: warning: Overflow in constant expression +running ei.cem +comparing ei +sed -f el.sed el.c +acc el.c +el.c +running el.cem +comparing el +sed -f eu.sed eu.c +acc eu.c +eu.c +"eu.c", line 58: warning: Overflow in constant expression +"eu.c", line 64: warning: Overflow in constant expression +running eu.cem +comparing eu +sed -f id.sed id.c +acc id.c +id.c +running id.cem +comparing id +sed -f lc.sed lc.c +acc lc.c +lc.c +"lc.c", line 60: warning: Overflow in constant expression +"lc.c", line 66: warning: Overflow in constant expression +running lc.cem +comparing lc +sed -f ld.sed ld.c +acc ld.c +ld.c +running ld.cem +comparing ld +sed -f lf.sed lf.c +acc lf.c +lf.c +running lf.cem +comparing lf +sed -f li.sed li.c +acc li.c +li.c +"li.c", line 22: warning: Overflow in constant expression +"li.c", line 67: warning: Overflow in constant expression +"li.c", line 112: warning: Overflow in constant expression +running li.cem +comparing li +sed -f ll.sed ll.c +acc ll.c +ll.c +running ll.cem +comparing ll +sed -f lu.sed lu.c +acc lu.c +lu.c +running lu.cem +comparing lu +***** ctill +----- All program(s) in this directory should fail to compile. +acc noarg.c +noarg.c +"noarg.c", line 10: declared argument name is missing +*** Error code 1 +`gen' not remade because of errors +***** ctinit +acc init.c +init.c +"init.c", line 183: warning: Overflow in constant expression (U-) +running init.cem +comparing init +***** ctmargt +acc margt.c +margt.c +running margt.cem +comparing margt +5,$c5,$ +< BELL= +< BIN=/usr/em/bin +< CDPATH=:/usr/em/util:/usr/em/mach:/usr/em/lang +< DIT=/usr/em/ditroff/troff/a.out +< HOME=/usr/em +< MAILHEADER=To: botter!vu44!mcvax!%t +< Subject: Re: %S +< Newsgroups: %n +< In-Reply-To: %i +< %(%[references]!=^$?References\: %[references] +< )Organization: %o +< Cc: +< Bcc: +< +< +< PATH=:/usr/em/bin:/usr/local:/usr/ucb:/bin:/usr/bin:/usr/em/bin:/usr/new +< SHELL=/usr/local/dsh +< TERM=d80 +< USER=keie +--- +> HOME=/other/keie +> PATH=:/other/keie/bin:/bin:/usr/bin +> TERM=MiniBee +***** ctprof +test profiling +procentry.c +acc tp.c procentry.k +tp.c +procentry.k +running tp +comparing tp +***** ctstruct +acc str.c +str.c +running str.cem +comparing str +***** ctsys +acc tfork.c +tfork.c +running tfork.cem +comparing tfork +1,$c1,$ +< childno 1928 +< Child 1928, status 0x800 +< fork/wait ok +--- +> childno N +> Child N, status 0x800 +> fork/wait ok +Fri Feb 15 13:29:05 MET 1985 diff --git a/lang/cem/ctest/READ_ME b/lang/cem/ctest/READ_ME new file mode 100644 index 00000000..2f36a409 --- /dev/null +++ b/lang/cem/ctest/READ_ME @@ -0,0 +1,54 @@ +The test are subdivided into several directories. +Only the directory ctgen contains more than one program, but it +is an exception anyhow. +All other directories contain one program, say test.c. +It is translated with a file test.cem as result. +This test is run, producing output on test.cem.r. +The 'expected' output is distributed on files named test.cem.g. +The run files in these directories use the makefile in this +directory to create the ...cem, ....cem.r files. +After creating the ....cem.r files a diff is run between the .r +and .g files. The output of these diffs is preceded by the line +comparing ....cem +Not all differences are caused by errors. +Part of the output in the subdirectory ctmargt is a printout +of the current environment variables. These will differ per +user. +The expected output in the directory ctconv is for a compiler +that considers char's as unsigned quantaties. +The expected output in all directories is generated using +16-bit arithmetic, using 32-bit arithmetic will cause several +discrepancies to occur with the expected output in the ...cem.g +files. + +The output of a run with a compiler using 2-bytes int can be found +in the file out.std. + +If any other differences with the expected output occur, the error +causing the diffence has to be rooted out by a person with some +experience with the kit. Most errors will be caused by the +backend programs, so looking at the assembly code generated by +such a backend from EM code is a good strategy when looking for +a cause. + +The programs in the directory ctgen are structured somewhat +differently. This directory contains a file 'OPS' with a +prototype program. This prototype program performs all C +arithmetic operations on a few operands. The operands are +X, Y, S, Z1, Z2. X, Y and S can be arbitrary expressions, +but S is used as a shift count and must be less then 16 (32). +Z1 and Z2 must be lvalue's. +The name ISTART indicates global declarations and LSTART +indicates local declarations. +The files ....sed (e.g. test.sed) are used +to produce legal C programs from the OPS file, in which +the result of all expressions is printed. +The programs are run in the way described above. + +If one has a implementation without floating point one can +use the -DNOFLOAT flag. +Most programs use compile time #ifdef's to hide the use of +floating point they make. +For an example, look at makefile.i86. +Differences are to be expected in the output of such a run. +Look at the file Out2.nf.std to see what can be expected. diff --git a/lang/cem/ctest/ctconv/conv.c b/lang/cem/ctest/ctconv/conv.c new file mode 100644 index 00000000..20dcad18 --- /dev/null +++ b/lang/cem/ctest/ctconv/conv.c @@ -0,0 +1,147 @@ +/* + * (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 */ + +char rcs_id[] = "$Header$" ; + +main() { + t1() ; + return 0 ; +} + +t1() { + char c ; int i ; long l ; unsigned u ; +#ifndef NOFLOAT + float f ; +#endif + + /* test conversions */ + + /* first some conversions on constants */ + + printf("(int) '\\377' = %d\n",(int) '\377') ; + printf("(long) -1 = %ld\n",(long) -1 ) ; +#ifndef NOFLOAT + printf("(float) 12 = %f\n",(float) 12 ) ; + printf("(int) 3.14 = %d\n",(int) 3.14 ) ; +#endif + printf("(int) 32767L = %d\n",(int) 32767L ) ; + printf("(int) -32768L = %d\n",(int) -32768L ) ; + printf("(char) 128L = %d\n",(char) 128L) ; + printf("(char) 0377 = %d\n",(char) 0377 ) ; + printf("(char) -1 = %d\n",(char) -1 ) ; + printf("(char) 10000 = %d\n",(char) 10000 ) ; + + /* conversions from characters */ + printf("From character\n") ; + c = 127 ; + i=c ; + l=c ; + u=c ; +#ifndef NOFLOAT + f=c ; +#endif + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld\n",c,i,u,l) ; +#ifndef NOFLOAT + printf("\t\t\t\t\tfloat %f\n",f) ; +#endif + c = -1 ; + i=c ; + l=c ; + u=c ; +#ifndef NOFLOAT + f=c ; +#endif + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld\n",c,i,u,l) ; +#ifndef NOFLOAT + printf("\t\t\t\t\tfloat %f\n",f) ; +#endif + c = 0377 ; + i=c ; + l=c ; + u=c ; +#ifndef NOFLOAT + f=c ; +#endif + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld\n",c,i,u,l) ; +#ifndef NOFLOAT + printf("\t\t\t\t\tfloat %f\n",f) ; +#endif + + /* from integer */ + printf("From integer\n") ; + i= -64 ; + c=i ; + l=i ; + u=i ; +#ifndef NOFLOAT + f=i ; +#endif + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld\n",c,i,u,l) ; +#ifndef NOFLOAT + printf("\t\t\t\t\tfloat %f\n",f) ; +#endif + /* from long */ + printf("From long\n") ; + l = -3 ; + c = l ; + i = l ; + u = l ; +#ifndef NOFLOAT + f = l ; +#endif + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld\n",c,i,u,l) ; +#ifndef NOFLOAT + printf("\t\t\t\t\tfloat %f\n",f) ; +#endif + +#ifndef NOFLOAT + printf("From float\n") ; + f = 121.5 ; + c = f ; + i = f ; + u = f ; + l = f ; + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld, float %f\n",c,i,u,l,f) ; + f = 1e-4 ; + c = f ; + i = f ; + u = f ; + l = f ; + printf("\tchar %5d, int %6d, unsigned %6o, long %11ld, float %f\n",c,i,u,l,f) ; + f = 3276.6e1 ; + i = f ; + u = f ; + l = f ; + printf("\tint %6d, unsigned %6o, long %11ld, float %f\n",i,u,l,f) ; + f = 1223432e3 ; + l = f ; + printf("\tlong %11ld, float %f\n",l,f) ; +#endif + + /* some special cases */ + { + int a[4] ; + + l = 3 ; a[3]= -17 ; + printf("a[l] (l==%ld) %d\n",l,a[l]) ; + printf("a[3l] %d\n",a[3l] ) ; + + } + return 0 ; +} diff --git a/lang/cem/ctest/ctconv/conv.cem.g b/lang/cem/ctest/ctconv/conv.cem.g new file mode 100644 index 00000000..9dc42b05 --- /dev/null +++ b/lang/cem/ctest/ctconv/conv.cem.g @@ -0,0 +1,30 @@ +(int) '\377' = 255 +(long) -1 = -1 +(float) 12 = 12.000000 +(int) 3.14 = 3 +(int) 32767L = 32767 +(int) -32768L = -32768 +(char) 128L = 128 +(char) 0377 = 255 +(char) -1 = 255 +(char) 10000 = 16 +From character + char 127, int 127, unsigned 177, long 127 + float 127.000000 + char 255, int 255, unsigned 377, long 255 + float 255.000000 + char 255, int 255, unsigned 377, long 255 + float 255.000000 +From integer + char 192, int -64, unsigned 177700, long -64 + float -64.000000 +From long + char 253, int -3, unsigned 177775, long -3 + float -3.000000 +From float + char 121, int 121, unsigned 171, long 121, float 121.500000 + char 0, int 0, unsigned 0, long 0, float 0.000100 + int 32766, unsigned 77776, long 32766, float 32766.000000 + long 1223432064, float 1223432064.000000 +a[l] (l==3) -17 +a[3l] -17 diff --git a/lang/cem/ctest/ctconv/run b/lang/cem/ctest/ctconv/run new file mode 100644 index 00000000..f1014171 --- /dev/null +++ b/lang/cem/ctest/ctconv/run @@ -0,0 +1 @@ +make "P=conv" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctdecl/decl.c b/lang/cem/ctest/ctdecl/decl.c new file mode 100644 index 00000000..275931c7 --- /dev/null +++ b/lang/cem/ctest/ctdecl/decl.c @@ -0,0 +1,87 @@ +/* + * (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 */ + +char rcs_id[] = "$Header$" ; + +/* Test a few declaration features */ +/* Such as: + forward function declarations, + redeclarations, + pointer to function declarations. +*/ + +static int sqr() ; /* forward declarations */ +extern int sqrt(); + +main() { + fdcl() ; + hidden() ; + return 0 ; +} + +fdcl() { + int (*a[2])() ; + + printf("sqr(4) %d\n",sqr(4)) ; + + a[0]=sqr ; a[1]=sqrt ; + printf("(*a[0])(16) %d\n",(*a[0])(16) ) ; + printf("(*a[1])( (*a[0])(3) ) %d\n", (*a[1])( (*a[0])(3) ) ) ; +} + +static int sqr(par) int par ; { + return par*par ; +} + +int sqrt(par) int par ; { + int x1,x2 ; + int i ; + + if ( par<0 ) return -1 ; + x1 = par ; + i=0 ; + do { + x2 = x1 ; + x1 = ( x2*x2 + par ) / (2*x2) ; + if ( i++>=100 ) return -2 ; + } while ( ( x2 0 ) ; + return (x1+x2)/2 ; +} + +int a = -8 ; + +hidden() { + hide() ; + printf("a outside hide %d\n",a) ; +} + +int hide() { + int a ; + + a = 4 ; + printf("a in hide %d\n",a) ; + { + int a ; + + a = 16 ; + printf("a in in hide %d\n",a) ; + + } + printf("a in hide %d\n",a) ; +} diff --git a/lang/cem/ctest/ctdecl/decl.cem.g b/lang/cem/ctest/ctdecl/decl.cem.g new file mode 100644 index 00000000..e53c5262 --- /dev/null +++ b/lang/cem/ctest/ctdecl/decl.cem.g @@ -0,0 +1,7 @@ +sqr(4) 16 +(*a[0])(16) 256 +(*a[1])( (*a[0])(3) ) 3 +a in hide 4 +a in in hide 16 +a in hide 4 +a outside hide -8 diff --git a/lang/cem/ctest/ctdecl/run b/lang/cem/ctest/ctdecl/run new file mode 100644 index 00000000..fea9ea6c --- /dev/null +++ b/lang/cem/ctest/ctdecl/run @@ -0,0 +1 @@ +make "P=decl" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctdivers/ops.c b/lang/cem/ctest/ctdivers/ops.c new file mode 100644 index 00000000..bfc4e7f8 --- /dev/null +++ b/lang/cem/ctest/ctdivers/ops.c @@ -0,0 +1,167 @@ +/* + * (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 */ + +char rcs_id[] = "$Header$" ; + +main() { + + assnull() ; + ushift() ; + lshift() ; + uadd() ; + return 0 ; +} + +int a,b ; +assnull() { + int c,d ; + /* test a few cases handled especially by the cem-compiler */ + + a= -1 ; b= -1 ; c= -1 ; d = -1 ; + + a=b=0 ; + c=d=0 ; + printf("a %d, b %d, c %d, d %d\n",a,b,c,d) ; + a = b = c = d = -32 ; + printf (" (a=0) %d, (c=0) %d\n",(a=0),(c=0) ) ; + printf("a %d, b %d, c %d, d %d\n",a,b,c,d) ; + +} +ushift() { + unsigned u ; + + printf("Unsigned shifts by constants\n") ; + u = 0150715 ; + printf(" u = %06o\n",u) ; + printf(" u>>0 %06o\n", u>>0 ) ; + printf(" u>>1 %06o\n", u>>1 ) ; + printf(" u>>2 %06o\n", u>>2 ) ; + printf(" u>>3 %06o\n", u>>3 ) ; + printf(" u>>4 %06o\n", u>>4 ) ; + printf(" u>>5 %06o\n", u>>5 ) ; + printf(" u>>6 %06o\n", u>>6 ) ; + printf(" u>>7 %06o\n", u>>7 ) ; + printf(" u>>8 %06o\n", u>>8 ) ; + printf(" u>>9 %06o\n", u>>9 ) ; + printf(" u>>10 %06o\n", u>>10 ) ; + printf(" u>>11 %06o\n", u>>11 ) ; + printf(" u>>12 %06o\n", u>>12 ) ; + printf(" u>>13 %06o\n", u>>13 ) ; + printf(" u>>14 %06o\n", u>>14 ) ; + printf(" u>>15 %06o\n", u>>15 ) ; + printf(" u>>16 %06o\n", u>>16 ) ; + printf(" u<<0 %06o\n", u<<0 ) ; + printf(" u<<1 %06o\n", u<<1 ) ; + printf(" u<<2 %06o\n", u<<2 ) ; + printf(" u<<3 %06o\n", u<<3 ) ; + printf(" u<<4 %06o\n", u<<4 ) ; + printf(" u<<5 %06o\n", u<<5 ) ; + printf(" u<<6 %06o\n", u<<6 ) ; + printf(" u<<7 %06o\n", u<<7 ) ; + printf(" u<<8 %06o\n", u<<8 ) ; + printf(" u<<9 %06o\n", u<<9 ) ; + printf(" u<<10 %06o\n", u<<10 ) ; + printf(" u<<11 %06o\n", u<<11 ) ; + printf(" u<<12 %06o\n", u<<12 ) ; + printf(" u<<13 %06o\n", u<<13 ) ; + printf(" u<<14 %06o\n", u<<14 ) ; + printf(" u<<15 %06o\n", u<<15 ) ; + printf(" u<<16 %06o\n", u<<16 ) ; +} + +lshift() { + long ll ; + + printf("Long shifts by constants\n") ; + ll = 400000L - 0532 ; + printf(" ll = %011O\n",ll) ; + printf(" ll>>0 %011O\n", ll>>0 ) ; + printf(" ll>>1 %011O\n", ll>>1 ) ; + printf(" ll>>2 %011O\n", ll>>2 ) ; + printf(" ll>>3 %011O\n", ll>>3 ) ; + printf(" ll>>4 %011O\n", ll>>4 ) ; + printf(" ll>>5 %011O\n", ll>>5 ) ; + printf(" ll>>6 %011O\n", ll>>6 ) ; + printf(" ll>>7 %011O\n", ll>>7 ) ; + printf(" ll>>8 %011O\n", ll>>8 ) ; + printf(" ll>>9 %011O\n", ll>>9 ) ; + printf(" ll>>10 %011O\n", ll>>10 ) ; + printf(" ll>>11 %011O\n", ll>>11 ) ; + printf(" ll>>12 %011O\n", ll>>12 ) ; + printf(" ll>>13 %011O\n", ll>>13 ) ; + printf(" ll>>14 %011O\n", ll>>14 ) ; + printf(" ll>>15 %011O\n", ll>>15 ) ; + printf(" ll>>16 %011O\n", ll>>16 ) ; + printf(" ll>>17 %011O\n", ll>>17 ) ; + printf(" ll>>18 %011O\n", ll>>18 ) ; + printf(" ll>>19 %011O\n", ll>>19 ) ; + printf(" ll>>20 %011O\n", ll>>20 ) ; + printf(" ll>>21 %011O\n", ll>>21 ) ; + printf(" ll>>22 %011O\n", ll>>22 ) ; + printf(" ll>>23 %011O\n", ll>>23 ) ; + printf(" ll>>24 %011O\n", ll>>24 ) ; + printf(" ll>>25 %011O\n", ll>>25 ) ; + printf(" ll>>26 %011O\n", ll>>26 ) ; + printf(" ll>>27 %011O\n", ll>>27 ) ; + printf(" ll>>28 %011O\n", ll>>28 ) ; + printf(" ll>>29 %011O\n", ll>>29 ) ; + printf(" ll>>30 %011O\n", ll>>30 ) ; + printf(" ll>>31 %011O\n", ll>>31 ) ; + ll = 1 ; + printf(" ll<<0 %011O\n", ll<<0 ) ; + printf(" ll<<1 %011O\n", ll<<1 ) ; + printf(" ll<<2 %011O\n", ll<<2 ) ; + printf(" ll<<3 %011O\n", ll<<3 ) ; + printf(" ll<<4 %011O\n", ll<<4 ) ; + printf(" ll<<5 %011O\n", ll<<5 ) ; + printf(" ll<<6 %011O\n", ll<<6 ) ; + printf(" ll<<7 %011O\n", ll<<7 ) ; + printf(" ll<<8 %011O\n", ll<<8 ) ; + printf(" ll<<9 %011O\n", ll<<9 ) ; + printf(" ll<<10 %011O\n", ll<<10 ) ; + printf(" ll<<11 %011O\n", ll<<11 ) ; + printf(" ll<<12 %011O\n", ll<<12 ) ; + printf(" ll<<13 %011O\n", ll<<13 ) ; + printf(" ll<<14 %011O\n", ll<<14 ) ; + printf(" ll<<15 %011O\n", ll<<15 ) ; + printf(" ll<<16 %011O\n", ll<<16 ) ; + printf(" ll<<17 %011O\n", ll<<17 ) ; + printf(" ll<<18 %011O\n", ll<<18 ) ; + printf(" ll<<19 %011O\n", ll<<19 ) ; + printf(" ll<<20 %011O\n", ll<<20 ) ; + printf(" ll<<21 %011O\n", ll<<21 ) ; + printf(" ll<<22 %011O\n", ll<<22 ) ; + printf(" ll<<23 %011O\n", ll<<23 ) ; + printf(" ll<<24 %011O\n", ll<<24 ) ; + printf(" ll<<25 %011O\n", ll<<25 ) ; + printf(" ll<<26 %011O\n", ll<<26 ) ; + printf(" ll<<27 %011O\n", ll<<27 ) ; + printf(" ll<<28 %011O\n", ll<<28 ) ; + printf(" ll<<29 %011O\n", ll<<29 ) ; + printf(" ll<<30 %011O\n", ll<<30 ) ; +} +uadd() { + unsigned u ; + int i ; + + u = 32760 ; + for ( i=0 ; i<=16 ; ++i ) { + printf("%2d %06o\n",i,u+i) ; + } +} diff --git a/lang/cem/ctest/ctdivers/ops.cem.g b/lang/cem/ctest/ctdivers/ops.cem.g new file mode 100644 index 00000000..1c4eb2cb --- /dev/null +++ b/lang/cem/ctest/ctdivers/ops.cem.g @@ -0,0 +1,121 @@ +a 0, b 0, c 0, d 0 + (a=0) 0, (c=0) 0 +a 0, b -32, c 0, d -32 +Unsigned shifts by constants + u = 150715 + u>>0 150715 + u>>1 064346 + u>>2 032163 + u>>3 015071 + u>>4 006434 + u>>5 003216 + u>>6 001507 + u>>7 000643 + u>>8 000321 + u>>9 000150 + u>>10 000064 + u>>11 000032 + u>>12 000015 + u>>13 000006 + u>>14 000003 + u>>15 000001 + u>>16 000000 + u<<0 150715 + u<<1 121632 + u<<2 043464 + u<<3 107150 + u<<4 016320 + u<<5 034640 + u<<6 071500 + u<<7 163200 + u<<8 146400 + u<<9 115000 + u<<10 032000 + u<<11 064000 + u<<12 150000 + u<<13 120000 + u<<14 040000 + u<<15 100000 + u<<16 000000 +Long shifts by constants + ll = 00001414446 + ll>>0 00001414446 + ll>>1 00000606223 + ll>>2 00000303111 + ll>>3 00000141444 + ll>>4 00000060622 + ll>>5 00000030311 + ll>>6 00000014144 + ll>>7 00000006062 + ll>>8 00000003031 + ll>>9 00000001414 + ll>>10 00000000606 + ll>>11 00000000303 + ll>>12 00000000141 + ll>>13 00000000060 + ll>>14 00000000030 + ll>>15 00000000014 + ll>>16 00000000006 + ll>>17 00000000003 + ll>>18 00000000001 + ll>>19 00000000000 + ll>>20 00000000000 + ll>>21 00000000000 + ll>>22 00000000000 + ll>>23 00000000000 + ll>>24 00000000000 + ll>>25 00000000000 + ll>>26 00000000000 + ll>>27 00000000000 + ll>>28 00000000000 + ll>>29 00000000000 + ll>>30 00000000000 + ll>>31 00000000000 + ll<<0 00000000001 + ll<<1 00000000002 + ll<<2 00000000004 + ll<<3 00000000010 + ll<<4 00000000020 + ll<<5 00000000040 + ll<<6 00000000100 + ll<<7 00000000200 + ll<<8 00000000400 + ll<<9 00000001000 + ll<<10 00000002000 + ll<<11 00000004000 + ll<<12 00000010000 + ll<<13 00000020000 + ll<<14 00000040000 + ll<<15 00000100000 + ll<<16 00000200000 + ll<<17 00000400000 + ll<<18 00001000000 + ll<<19 00002000000 + ll<<20 00004000000 + ll<<21 00010000000 + ll<<22 00020000000 + ll<<23 00040000000 + ll<<24 00100000000 + ll<<25 00200000000 + ll<<26 00400000000 + ll<<27 01000000000 + ll<<28 02000000000 + ll<<29 04000000000 + ll<<30 10000000000 + 0 077770 + 1 077771 + 2 077772 + 3 077773 + 4 077774 + 5 077775 + 6 077776 + 7 077777 + 8 100000 + 9 100001 +10 100002 +11 100003 +12 100004 +13 100005 +14 100006 +15 100007 +16 100010 diff --git a/lang/cem/ctest/ctdivers/run b/lang/cem/ctest/ctdivers/run new file mode 100644 index 00000000..f9d13f99 --- /dev/null +++ b/lang/cem/ctest/ctdivers/run @@ -0,0 +1 @@ +make "P=ops" -fskk ../makefile ${1-gen} diff --git a/lang/cem/ctest/cterr/bugs.c b/lang/cem/ctest/cterr/bugs.c new file mode 100644 index 00000000..959dbbf8 --- /dev/null +++ b/lang/cem/ctest/cterr/bugs.c @@ -0,0 +1,179 @@ +/* + * (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 */ + +char rcs_id[] = "$Header$" ; + +/* This programs is a collection of derived from small tests develloped + for specific bugs/features in the C->EM compiler +*/ + +char * err_name ; + +set_err(s) char *s ; { + printf("%s\n",s) ; + err_name= s ; +} +e(i) { + printf("%s: error %d\n",err_name,i) ; +} + +main() { + cmp_rev() ; + loc_dif() ; + con_fold() ; + ass_res() ; + c_to_l() ; + acc_struct() ; + char_param() ; + addr_lb() ; + compl_ind() ; + printf("END\n") ; +} + +cmp_rev() { + /* Some compilers magically transform the second < into a > */ + int i,j ; + int result ; + + set_err("cmp_rev") ; + i=2 ; j=1 ; + result= ( (j-i<0) == (j-i<0) ) ? 1 : 0 ; + if ( !result ) e(1) ; +} + +loc_dif() { + set_err("loc_dif") ; + loc_fa(1,2) ; +} + +loc_fa(p1,p2) { + int i ; + if ( &p1-&p2 != -1 ) e(1) ; + if ( &i-&p1 >=0 ) e(2) ; + if ( &p1-&i <=0 ) e(3) ; +} + +con_fold() { + set_err("con_fold") ; +#ifndef NOFLOAT + con_flo( (1 ? 3 : 4.5), 200, 200, 200 ) ; +#endif + con_lo( 4L + 3, 1 ) ; +} +#ifndef NOFLOAT +con_flo(d) double d ; { + if ( d>3.00001 || d<2.99999 ) e(1) ; +} +#endif +con_lo(l) long l ; { + if ( l!=7 ) e(2) ; +} + +ass_res() { + char c, *pc ; + int i ; + int s_extend ; + + set_err("ass_res") ; + c = -1 ; i=c ; + s_extend= i== -1 ; + + pc = &c ; + i = ( *pc++ = 01777 ) ; + switch ( i ) { + case 01777 : + e(1) ; break ; + case -1 : + if ( !s_extend ) e(2) ; + break ; + case 0377 : + if ( s_extend ) e(3) ; + break ; + default : + e(4) ; + } +} + +c_to_l() { + char c = -1 ; + long l ; + + set_err("c_to_l") ; + l= c ; + if ( c==255 ) { + if ( l!=255 ) e(1) ; + } else { + if ( l!= -1 ) e(2) ; + } +} + +acc_struct() { + struct s1 { char s1_a[3] ; } ss1, is1 ; + struct s2 { + int s2_i ; + struct s1 s2_s1 ; + } ; + struct s3 { + int s3_i ; + struct s2 s3_s2 ; + } ss3, *ps3 ; + + set_err("acc_struct") ; + ps3 = &ss3 ; + is1.s1_a[0]=1 ; is1.s1_a[1]=100 ; is1.s1_a[2]=127 ; + ss3.s3_s2.s2_s1= is1 ; + ss1 = ps3->s3_s2.s2_s1 ; + if ( ss1.s1_a[0]!=1 ) e(1) ; + if ( ss1.s1_a[1]!=100 ) e(2) ; + if ( ss1.s1_a[2]!=127 ) e(3) ; +} + +char_param() { + set_err("char_param") ; + fcall(1,01002,-1) ; +} + +fcall(c1,c2,c3) char c1,c2,c3 ; { + if ( c1!=1 ) e(1) ; + if ( c2!=2 ) e(2) ; + c_alter(&c1,127) ; + if ( c1!=127 ) e(3) ; + c_alter(&c3,0) ; + if ( c3 ) e(4) ; +} + +c_alter(ptr,val) char *ptr ; int val ; { + *ptr= val ; +} + +addr_lb() { + char a[6] ; + int i ; + + set_err("addr_lb"); + i=6 ; + if ( &a[6] != a+i ) e(1) ; +} +compl_ind() { + char arr[20] ; + int i ; + set_err("compl_ind") ; + arr[10]=111 ; + i=0 ; if ( arr[i+10] != 111 ) e(1) ; +} diff --git a/lang/cem/ctest/cterr/bugs.cem.g b/lang/cem/ctest/cterr/bugs.cem.g new file mode 100644 index 00000000..af856d08 --- /dev/null +++ b/lang/cem/ctest/cterr/bugs.cem.g @@ -0,0 +1,10 @@ +cmp_rev +loc_dif +con_fold +ass_res +c_to_l +acc_struct +char_param +addr_lb +compl_ind +END diff --git a/lang/cem/ctest/cterr/run b/lang/cem/ctest/cterr/run new file mode 100755 index 00000000..678a422e --- /dev/null +++ b/lang/cem/ctest/cterr/run @@ -0,0 +1 @@ +make "P=bugs" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctest1/run b/lang/cem/ctest/ctest1/run new file mode 100644 index 00000000..ae27a4ff --- /dev/null +++ b/lang/cem/ctest/ctest1/run @@ -0,0 +1 @@ +make "P=test" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctest1/test.c b/lang/cem/ctest/ctest1/test.c new file mode 100644 index 00000000..4befc978 --- /dev/null +++ b/lang/cem/ctest/ctest1/test.c @@ -0,0 +1,1256 @@ +/* + * (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 + * + */ + +char rcs_id[] = "$Header$" ; + +/* C-compiler test 1 */ +/* This program can be used to test C-compilers */ + +#ifndef NOFLOAT +# define EPSD 1e-6 +# define EPSF 1e-6 +#endif + +/* global counters */ + +int t, /* the value indicates the number of the test procedure */ + ect, /* error counter */ + tct; /* count the number of test procedures called */ + +/****************************************************************************/ +/* + * The following is tested: + * INTEGER CONSTANTS in test1 + * GLOBAL INTEGER VARIABLES in test2 + * LOCAL INTEGER VARIABLES in test3 + * GLOBAL LONG VARIABLES in test4 + * LOCAL LONG VARIABLES in test5 + * REAL ARITHMETIC in test6 + * GLOBAL RECORDS in test7 + * LOCAL RECORDS in test8 + * GLOBAL ARRAYS in test9 + * LOCAL ARRAYS in test10 + * GLOBAL POINTERS in test11 + */ +/***************************************************************************/ +char alstr[1000] ; +char *alptr = alstr ; + +char *alloc(size) { + register char *retval ; + + retval=alptr ; + alptr += size ; + if ( alptr-alstr>sizeof alstr ) { + printf("allocation overflow\n") ; + exit(8) ; + } + return(retval) ; +} + +#ifndef NOFLOAT +double fabs(a) double a ; { return( a<0 ? -a : a) ; } +#endif + + + +/* global variables for the test procedures */ + +int i,j,k,l,m; + +long li,lj,lk,ll,lm; + +#ifndef NOFLOAT +float xf, yf, zf; + +double xd, yd, zd; +#endif + +struct tp2 { + char c1; + int i,j; +#ifndef NOFLOAT + float aaa; + double bbb; +#endif +} r1, r2; + +int p, *p1, *p11, **p2, ***p3, ****p4, *****p5; + +struct tp2 *pp1, *pp2, *pp3; +int a1[20]; +#ifndef NOFLOAT +float a2[20]; +double a3[20]; +#endif + +main() +{ + tct = 0; + ect = 0; + test1(); + test2(); + test3(); + test4(); + test5(); + test6(); + test7(); + test8(); + test9(); + test10(); +#ifndef NOFLOAT + test11(); +#endif + printf("End of test program, %d tests completed, %d errors detected\n", + tct,ect); + return 0 ; +} + + + +e(n) +int n; +{ + ect++; + printf("Error %d in test%d \n",n,t); +} + + + +test1() /* testing integer constants */ +{ + t = 1; + tct++; + if (0) e(1); + if (!1) e(2); + if ( 1+2 != 3 ) e(3); + if (-500 - 234 != -734) e(4); + if (-32 + 155 != 123) e(5); + if ( 2*3 != 6) e(6); + if ( 3*4*5*6 != 360) e(7); + if ( 654-3*2 != 648) e(8); + if (5*5 + 5*5 != 50) e(9); + if ( 1+1-1+1-1+1-1+1-1+1 != 2) e(10); +/**********************************************************************/ + if ( ((((((((((((((((((((0)))))))))))))))))))) ) e(11); + if ( (((-2))) - ((((-3)))) * (3+((2))) != 13 ) e(12); + if ( 1+1 != 2 ) e(13); + if ( 3333 + 258 != 3591) e(14); + if (3*4 != 12) e(15); + if (111*111 != 12321) e(16); + if (50 / 5 != 10) e(17); + if (7498 / 75 != 99) e(18); + if (456 - 345 != 111) e(19); + if (1+(-2) != -1) e(20); + if (-3 * -4 != 12) e(21); + if (-2 / 2 != -1) e(22); + if (-5 / 1 != -5) e(23); + if (-4 - -5 != 1) e(24); + if ( 03 + 02 != 05) e(25); + if ( 03456 + 88 != 03606 ) e(26); + if ( 0100 * 23 != 02700 ) e(27); + if ( 045 / 020 != 2 ) e(28); + if ( 0472 - 0377 != 073 ) e(29); + if ( 'a' != 'a' ) e(30); + if ( 'a' + 'c' != 'b' + 'b' ) e(31); + if ( 'z' * 'z' != 14884 ) e(32); + if ( -'z' / 01 != -'z' ) e(33); + if ( 077777 >> 3 != 07777 ) e(34); + if ( 077777 >> 15 ) e(35); + if ( ( 0124 & 07765 ) != 0124 ) e(37); + if ( ( 34 & 31 ) != 2 ) e(38); + if (( 5 | 013 | 020 ) != 31 ) e(39); + if ( ( -7 ^ 3 ) != -6 ) e(40); + if ( (07373 ^ 4632 ) != 016343 ) e(41); + if ( (1+2+3)*(2+3+4)*(3+5+5) / 2 != ((3*((5+3+2)*10)+51)*6)/6 ) e(42); + if ( (1000*2+5*7+13)/8 != 2*2*2*2*4*4 ) e(43); + if ( ( 1*2*3*4*5*6*7 / 5040 ) != 5040 / 7 / 6 / 5 / 4 / 3 / 2 / 1 ) e(44); + if ( (-(-(-(-(-(-(1))))))) != 1) e(45); + if ( - 1 != -((((((((1)))))))) ) e(46); + if ( -1-1-1-1-1-1 != -6+3-3 ) e(47); + if ( 2<1 ) e(48); + if ( 2==3 ) e(49); + if ( 2 != 2 ) e(50); + if ( 2>3 ) e(51); + if ( 2+0 != 2 ) e(52); + if ( 2-0 != 2 ) e(53); + if ( 2*0 != 0 ) e(54); + if ( 0/1 != 0 ) e(55); + if ( 0*0 != 0 ) e(56); + if (32767 > 32767) e(57); + if ( -32768 > -32767 ) e(58); + if ( 0456 < 0400 ) e(59); + if ( 0456 != ( 0400 | 050 | 06 ) ) e(60); + if ( 2*2 + (2<<2) != 12 ) e(61); + if ( 0 || 0 ) e(62); + if ( 1 && 0 ) e(63); + if ( ( 123 ? 123*4 : 345 ) != 492 ) e(64); + if ( ( 0 ? 345 : 280 ) != 280 ) e(65); + if ( ( 4>>10 ) + 3 != 3 ) e(66); + if ( ! ( 111 || 23 && 0 ) ) e(67); + if ( !1 ) e(68); + if ( !0 == 0 ) e(69); + if ( !!!!!!!!!!0 ) e(70); + if ( 2*2*2*2 != 4*4 ) e(71); + if ( 0 && 0 && 0 && 0000 && 000000000000 ) e(72); + if ( 1 & 1 & 1 && 1 & 1 && 1 & 0 ) e(73); + if ( 01 + 01 + 01 != 1 + 1 + 1 ) e(74); + if ( 07 + 1 != 010 ) e(75); + if ( ('a' & 017777) != 'a' ) e(76); + if ( ( 3 >> 0 ) != 3 ) e(77); + if ( ( 3 << 0 ) != 3 ) e(78); + if ( ((((((((((3)))))))))) << ((((((((((((2)))))))))))) != 12 ) e(79); + if ( (((3 << 4)) >> 4) != 3 ) e(80); + if ( (2+'a')*'b' != 2*'b' + 'a'*'b' ) e(81); + if ( 'a' * 'a' < 0 ) e(82); + if ( ('a'-'a'+'a'-'a'+('a'-'a')*'h') >> 3 ) e(82); + if ( 'z' - 01 != 'y' + 00 ) e(83); + if ( 'a' ^ 'a' ) e(84); + if ( 'h' ^ 'h' ^ 'a' ^ 'a' ) e(85); + if ( 0567 ^ (0500 | 060 | 7 ) ) e(86); + if ( 0 ^ 0 ^ 0 ^ 00 ) e(87); + if ( ( !0 ) ^ (!0) ) e(88); + if ( ( !!!40 ) ^ (!!!050) ) e(89); + if ( ( 6^7 ) * 345 != 345 ) e(90); + if ( !!!!!!!!!!!!! 'k' ) e(91); + if ( !!!((('k'))) ) e(92); + if ( -0 != 0 ) e(93) ; +} + + + + +test2() /* testing global integer variables */ +{ + t = 2; + tct++; + i = 1; + j = 2; + k = 3; + l = 4; + m = 10; + if ( i + j != k ) e(1); + if ( i + k != l ) e(2); + if ( j - k != -i ) e(3); + if ( j*(j+k) != m ) e(4); + if ( -m != -(k+k+l) ) e(5); + if ( i/i != 1 ) e(6); + if ( m*m / m != m ) e(7); + if ( 10*m != 100 ) e(8); + if ( m * (-10) != -100 ) e(9); + if ( j/k != 0 ) e(10); + if ( 100/k != 33 ) e(11); + if ( i+j*k+l+m / j+50 / k != 32 ) e(12); + if ( j*k*m / 6 != 10 ) e(13); + if ( (k>4) || (k>=4) || (k==4) ) e(14); + if ( (mj ) e(19); + if ( (i>j ? k : k*j) != 6 ) e(20); + if ( (i> i != i ) e(25); + if ( i++ != 1 ) e(26); + if ( --i != 1 ) e(27); + if ( i-- != 1 ) e(28); + if ( (i+j) && (i<0) || (m-10) && (064) ) e(29); + if ( (i+j) && !(i>=0) || (m-10) && !(0) ) e(30); + i = 2; + j = 4; + k = 8; + l = 16; + m = 32; + if ( i != 02 ) e(31); + if ( j != 04 ) e(32); + if ( k != 010 ) e(33); + if ( l != 020 ) e(34); + if ( i & j ) e(35); + if ( i & j & k & l & m ) e(36); + if ( ! ( i & j & k & l & m | i ) ) e(37); + if ( ( i >> 0 ) != i ) e(38); + if ( (( i/i ) << 1 ) != 02 ) e(39); + if ( ( i | (j) | (k) | (l) | (m) ) != i+j+k+l+m ) e(40); + if (!(i^j) ) e(41); + if ( !(i^j^k^l^m) ) e(42); + if ( ( --i << 1 ) != 2 ) e(43); + if ( ( i << 01 ) != 2 ) e(44); + if ( i%j != i ) e(45); + if ( k%l != k ) e(46); + if (( (m/l) << i >> i ) != 2 ) e(47); + if ( (i = j = k = l = m) != m ) e(48); + if ( ( i!=j ) || ( j!=k ) || !(l==m) ) e(49); + if ( (ii) || (k>3)%(i/i)) ) e(52); + if ( ! ( i++ == j++ ) ) e(53); + if ( i != j ) e(54); + if ( i++ != (j++) ) e(55); + i = 1; + j = i + 1; + if ( -i != -i ) e(56); + if ( i != --j ) e(57); + if ( (((((i))))) != -(-(-(-(i)))) ) e(59); + if ( j != 1 ) e(60); +} + + + + +test3() /* testing local integer variables */ +{ + int a,b,c,d,f; + + t = 3; + tct++; + a = 1; + b = 2; + c = 3; + d = 4; + f = 10; + if ( a + b != c ) e(1); + if ( a + c != d ) e(2); + if ( b - c != -a ) e(3); + if ( b*(b+c) != f ) e(4); + if ( -f != -(c+c+d) ) e(5); + if ( a/a != 1 ) e(6); + if ( f*f / f != f ) e(7); + if ( 10*f != 100 ) e(8); + if ( f * (-10) != -100 ) e(9); + if ( b/c != 0 ) e(10); + if ( 100/c != 33 ) e(11); + if ( a+b*c+d+f / b+50 / c != 32 ) e(12); + if ( b*c*f / 6 != 10 ) e(13); + if ( (c>4) || (c>=4) || (c==4) ) e(14); + if ( (fb ) e(19); + if ( (a>b ? c : c*b) != 6 ) e(20); + if ( (a> a != a ) e(25); + if ( a++ != 1 ) e(26); + if ( --a != 1 ) e(27); + if ( a-- != 1 ) e(28); + if ( (a+b) && (a<0) || (f-10) && (064) ) e(29); + if ( (a+b) && !(a>=0) || (f-10) && !(0) ) e(30); + a = 2; + b = 4; + c = 8; + d = 16; + f = 32; + if ( a != 02 ) e(31); + if ( b != 04 ) e(32); + if ( c != 010 ) e(33); + if ( d != 020 ) e(34); + if ( a & b ) e(35); + if ( a & b & c & d & f ) e(36); + if ( ! ( a & b & c & d & f | a ) ) e(37); + if ( ( a >> 0 ) != a ) e(38); + if ( (( a/a ) << 1 ) != 02 ) e(39); + if ( ( a | (b) | (c) | (d) | (f) ) != a+b+c+d+f ) e(40); + if (!(a^b) ) e(41); + if ( !(a^b^c^d^f) ) e(42); + if ( ( --a << 1 ) != 2 ) e(43); + if ( ( a << 01 ) != 2 ) e(44); + if ( a%b != a ) e(45); + if ( c%d != c ) e(46); + if (( (f/d) << a >> a ) != 2 ) e(47); + if ( (a = b = c = d = f) != f ) e(48); + if ( ( a!=b ) || ( b!=c ) || !(d==f) ) e(49); + if ( (aa) || (c>3)%(a/a)) ) e(52); + if ( ! ( a++ == b++ ) ) e(53); + if ( a != b ) e(54); + if ( a++ != (b++) ) e(55); + a = 1; + b = a + 1; + if ( -a != -a ) e(56); + if ( a != --b ) e(57); + if ( (((((a))))) != -(-(-(-(a)))) ) e(59); + if ( b != 1 ) e(60); +} + + + + +test4() /* testing global long variables */ +{ + t = 4; + tct++; + li = 1; + lj = 2; + lk = 3; + ll = 4; + lm = 10; + if ( li + lj != lk ) e(1); + if ( li + lk != ll ) e(2); + if ( lj - lk != -li ) e(3); + if ( lj*(lj+lk) != lm ) e(4); + if ( -lm != -(lk+lk+ll) ) e(5); + if ( li/li != 1 ) e(6); + if ( lm*lm / lm != lm ) e(7); + if ( 10*lm != 100 ) e(8); + if ( lm * (-10) != -100 ) e(9); + if ( lj/lk != 0 ) e(10); + if ( 100/lk != 33 ) e(11); + if ( li+lj*lk+ll+lm / lj+50 / lk != 32 ) e(12); + if ( lj*lk*lm / 6 != 10 ) e(13); + if ( (lk>4) || (lk>=4) || (lk==4) ) e(14); + if ( (lmlj ) e(19); + if ( (li>lj ? lk : lk*lj) != 6 ) e(20); + if ( (li> li != li ) e(25); + if ( li++ != 1 ) e(26); + if ( --li != 1 ) e(27); + if ( li-- != 1 ) e(28); + if ( (li+lj) && (li<0) || (lm-10) && (064) ) e(29); + if ( (li+lj) && !(li>=0) || (lm-10) && !(0) ) e(30); + li = 2; + lj = 4; + lk = 8; + ll = 16; + lm = 32; + if ( li != 02 ) e(31); + if ( lj != 04 ) e(32); + if ( lk != 010 ) e(33); + if ( ll != 020 ) e(34); + if ( li & lj ) e(35); + if ( li & lj & lk & ll & lm ) e(36); + if ( ! ( li & lj & lk & ll & lm | li ) ) e(37); + if ( ( li >> 0 ) != li ) e(38); + if ( (( li/li ) << 1 ) != 02 ) e(39); + if ( ( li | (lj) | (lk) | (ll) | (lm) ) != li+lj+lk+ll+lm ) e(40); + if (!(li^lj) ) e(41); + if ( !(li^lj^lk^ll^lm) ) e(42); + if ( ( --li << 1 ) != 2 ) e(43); + if ( ( li << 01 ) != 2 ) e(44); + if ( li%lj != li ) e(45); + if ( lk%ll != lk ) e(46); + if (( (lm/ll) << li >> li ) != 2 ) e(47); + if ( (li = lj = lk = ll = lm) != lm ) e(48); + if ( ( li!=lj ) || ( lj!=lk ) || !(ll==lm) ) e(49); + if ( (lili) || (lk>3)%(li/li)) ) e(52); + if ( ! ( li++ == lj++ ) ) e(53); + if ( li != lj ) e(54); + if ( li++ != (lj++) ) e(55); + li = 1; + lj = li + 1; + if ( -li != -li ) e(56); + if ( li != --lj ) e(57); + if ( (((((li))))) != -(-(-(-(li)))) ) e(59); + if ( lj != 1 ) e(60); + li = 40000; + lj = 80000; + lk = 800000L; + ll = -800000L; + lm = 1200000L; + if ( lk != -ll ) e(61); + if ( 10 * li != 400000L ) e(62); + if ( 2 * li != lj ) e(63); + if ( -(-(-(-(li)))) != li ) e(64); + if ( 10 * lj != lk ) e(65); + if ( lm + lm != 2 * lm ) e(66); + if ( lm - lm ) e(67); + if ( lk / lk != 1 ) e(68); + if ( lk / lj != 10 ) e(69); + if ( lm / li != 30 ) e(70); + if ( li + lj != lm / 10 ) e(71); + if ( li - 40000 - 1 != lk - 800001L ) e(72); + if ( li + li + li + li +li + li != lj + lj + lj ) e(73); + if ( li > lj ) e(74); + if ( lj > lk ) e(75); + if ( lm < ll ) e(76); + if ( (lm<1000000L) || (((lk-lj-lj*10)>0)) ) e(77); + if ( lm / 01 != lm ) e(78); + if ( lm * 01 != lm ) e(79); + if ( lm + 'a' != lm + 'b' -1 ) e(80); + if ( (lm % 'a') % 'a' != lm % 'a' ) e(81); + if ( lm % lm ) e(82); + if ( lj % li ) e(83); + if ( (lm<<1) != lm * 2 ) e(84); + if ( ! ( ( --lm % li ) + 1 ) ) e(86); + if ( ( lj >> 1 ) ^ li ) e(87); + li = 1; + if ( li != 1 ) e(89); + li <<= 20; + lj = 2; + if ( (lj<<19) != li ) e(90); + li = lj = lk= ll = lm = -345678L; + if ( (li != lj) || (lj != lk) || (ll != lm) ) e(91); + if ( (li != lj) || (lj != lk) || (lk != ll) || (ll != lm) ) e(92); + if ( li != -345678L ) e(93); + li = 1 | 2; + li <<= 20; + lj = li & li & li & li & li | li | li | li; + if ( li != lj ) e(94); + if ( ! ( li & lj ) ) e(95); + if ( li ^ lj ) e(96); + if ( ! (li | lj) ) e(97); + if ( (li >> 20) != 3 ) e(98); + li = 20000; + li *= 2; + if ( li < 0 ) e(99); + if ( 1 * li != li ) e(100); + lj = 20000; + if ( (lj<<1) != li ) e(101); + if ( (5*lj)/10 != lj/2 ) e(102); + if ( 4*lj != 1*01*2*2*lj ) e(103); + li = lj = 30000; + if ( li != li * lj / 30000 ) e(104); + if ( ++li != ++lj ) e(105); + lk = 5; + ll = 150000L; + if ( lk * (li-1) != ll ) e(106); +} + + + + +test5() /* testing local long variables */ +{ + long la, lb, lc, ld, lf; + + t = 5; + tct++; + la = 1; + lb = 2; + lc = 3; + ld = 4; + lf = 10; + if ( la + lb != lc ) e(1); + if ( la + lc != ld ) e(2); + if ( lb - lc != -la ) e(3); + if ( lb*(lb+lc) != lf ) e(4); + if ( -lf != -(lc+lc+ld) ) e(5); + if ( la/la != 1 ) e(6); + if ( lf*lf / lf != lf ) e(7); + if ( 10*lf != 100 ) e(8); + if ( lf * (-10) != -100 ) e(9); + if ( lb/lc != 0 ) e(10); + if ( 100/lc != 33 ) e(11); + if ( la+lb*lc+ld+lf / lb+50 / lc != 32 ) e(12); + if ( lb*lc*lf / 6 != 10 ) e(13); + if ( (lc>4) || (lc>=4) || (lc==4) ) e(14); + if ( (lflb ) e(19); + if ( (la>lb ? lc : lc*lb) != 6 ) e(20); + if ( (la> la != la ) e(25); + if ( la++ != 1 ) e(26); + if ( --la != 1 ) e(27); + if ( la-- != 1 ) e(28); + if ( (la+lb) && (la<0) || (lf-10) && (064) ) e(29); + if ( (la+lb) && !(la>=0) || (lf-10) && !(0) ) e(30); + la = 2; + lb = 4; + lc = 8; + ld = 16; + lf = 32; + if ( la != 02 ) e(31); + if ( lb != 04 ) e(32); + if ( lc != 010 ) e(33); + if ( ld != 020 ) e(34); + if ( la & lb ) e(35); + if ( la & lb & lc & ld & lf ) e(36); + if ( ! ( la & lb & lc & ld & lf | la ) ) e(37); + if ( ( la >> 0 ) != la ) e(38); + if ( (( la/la ) << 1 ) != 02 ) e(39); + if ( ( la | (lb) | (lc) | (ld) | (lf) ) != la+lb+lc+ld+lf ) e(40); + if (!(la^lb) ) e(41); + if ( !(la^lb^lc^ld^lf) ) e(42); + if ( ( --la << 1 ) != 2 ) e(43); + if ( ( la << 01 ) != 2 ) e(44); + if ( la%lb != la ) e(45); + if ( lc%ld != lc ) e(46); + if (( (lf/ld) << la >> la ) != 2 ) e(47); + if ( (la = lb = lc = ld = lf) != lf ) e(48); + if ( ( la!=lb ) || ( lb!=lc ) || !(ld==lf) ) e(49); + if ( (lala) || (lc>3)%(la/la)) ) e(52); + if ( ! ( la++ == lb++ ) ) e(53); + if ( la != lb ) e(54); + if ( la++ != (lb++) ) e(55); + la = 1; + lb = la + 1; + if ( -la != -la ) e(56); + if ( la != --lb ) e(57); + if ( (((((la))))) != -(-(-(-(la)))) ) e(59); + if ( lb != 1 ) e(60); + la = 40000; + lb = 80000; + lc = 800000L; + ld = -800000L; + lf = 1200000L; + if ( lc != -ld ) e(61); + if ( 10 * la != 400000L ) e(62); + if ( 2 * la != lb ) e(63); + if ( -(-(-(-(la)))) != la ) e(64); + if ( 10 * lb != lc ) e(65); + if ( lf + lf != 2 * lf ) e(66); + if ( lf - lf ) e(67); + if ( lc / lc != 1 ) e(68); + if ( lc / lb != 10 ) e(69); + if ( lf / la != 30 ) e(70); + if ( la + lb != lf / 10 ) e(71); + if ( la - 40000 - 1 != lc - 800001L ) e(72); + if ( la + la + la + la +la + la != lb + lb + lb ) e(73); + if ( la > lb ) e(74); + if ( lb > lc ) e(75); + if ( lf < ld ) e(76); + if ( (lf<1000000L) || (((lc-lb-lb*10)>0)) ) e(77); + if ( lf / 01 != lf ) e(78); + if ( lf * 01 != lf ) e(79); + if ( lf + 'a' != lf + 'b' -1 ) e(80); + if ( (lf % 'a') % 'a' != lf % 'a' ) e(81); + if ( lf % lf ) e(82); + if ( lb % la ) e(83); + if ( (lf<<1) != lf * 2 ) e(84); + if ( ! ( ( --lf % la ) + 1 ) ) e(86); + if ( ( lb >> 1 ) ^ la ) e(87); + la = 1; + if ( la != 1 ) e(89); + la <<= 20; + lb = 2; + if ( (lb<<19) != la ) e(90); + la = lb = lc= ld = lf = -345678L; + if ( (la != lb) || (lb != lc) || (ld != lf) ) e(91); + if ( (la != lb) || (lb != lc) || (lc != ld) || (ld != lf) ) e(92); + if ( la != -345678L ) e(93); + la = 1 | 2; + la <<= 20; + lb = la & la & la & la & la | la | la | la; + if ( la != lb ) e(94); + if ( ! ( la & lb ) ) e(95); + if ( la ^ lb ) e(96); + if ( ! (la | lb) ) e(97); + if ( (la >> 20) != 3 ) e(98); + la = 20000; + la *= 2; + if ( la < 0 ) e(99); + if ( 1 * la != la ) e(100); + lb = 20000; + if ( (lb<<1) != la ) e(101); + if ( (5*lb)/10 != lb/2 ) e(102); + if ( 4*lb != 1*01*2*2*lb ) e(103); + la = lb = 30000; + if ( la != la * lb / 30000 ) e(104); + if ( ++la != ++lb ) e(105); + lc = 5; + ld = 150000L; + if ( lc * (la-1) != ld ) e(106); +} + + + +test6() /* global records */ +{ +#ifndef NOFLOAT + double epsd; + float epsf; + double fabs(); +#endif + + t = 6; + tct++; +#ifndef NOFLOAT + epsd = EPSD; + epsf = EPSF; +#endif + r1.c1 = 'x'; + r1.i = 40; + r1.j = 50; +#ifndef NOFLOAT + r1.aaa = 3.0; + r1.bbb = 4.0; +#endif + r2.c1 = r1.c1; + r2.i = 50; + r2.j = 40; +#ifndef NOFLOAT + r2.aaa = 4.0; + r2.bbb = 5.0; +#endif + if ( r1.c1 != 'x' || r1.i != 40 ) e(1); +#ifndef NOFLOAT + if ( r1.aaa != 3.0 ) e(1); +#endif + if ( r1.i != 40 || r2.i != 50 ) e(2); + if ( r2.j != 40 || r1.j != 50 ) e(3); + if ( (r1.c1 + r2.c1)/2 != 'x' ) e(4); +#ifndef NOFLOAT + if ( r1.aaa * r1.aaa + r2.aaa * r2.aaa != r2.bbb * r2.bbb ) e(5); + r1.i = r1.j = r2.i = r2.j = 3.0; +#else + r1.i = r1.j = r2.i = r2.j = 3; +#endif + if ( r1.i != 3 ) e(6); + if ( r1.i * r2.j - 9 ) e(7); + r1.i++; + if ( r1.i != 4 ) e(8); + if ( --r1.i != 3 ) e(9); + if ( (++r2.i) * (--r2.j) != 8 ) e(10); + if ( (r2.i = r2.j = r1.j = r1.i = -5 ) != -5 ) e(11); + if ( r2.i * r1.j / 25 != 1 ) e(12); + r1.c1 = '\0'; + if ( r1.i * r1.j * r2.i * r1.c1 * r2.j ) e(13); + r2.c1 = 'j'; + if ( r1.c1 + r2.c1 != 'j' ) e(14); + if ( r1.c1 * r2.c1 ) e(15); + r2.j = r1.i = r2.i = r1.j = 1; + if ( (r1.i<<0) != r1.j ) e(16); + if ( (r1.i >> -0 ) != ( r1.j >> 0 ) ) e(17); + if ( (r1.i<<1) != 2 ) e(18); + if ( (r1.i<<2) != 4 ) e(19); + if ( (r1.j<<3) != (r2.j<<3) ) e(20); + if ( (r1.i | r1.i | r1.i | r1.i | r1.i) != r1.i ) e(21); + if ( (r2.j & r1.j & r2.j & r2.i) != (r1.i<<3>>3) ) e(22); + r1.j = 1; +#ifndef NOFLOAT + r1.aaa = 2.0; + if ( fabs ( r1.j * r1.aaa - 2.0 ) > epsd ) e(23); + if ( (r1.j << 4) * r1.aaa != (r1.j << 4) * r1.aaa ) e(24); + if ( ((r1.j<<6)&r1.j) * r1.aaa ) e(25); + if ((r1.j | (r1.j << 1)) * r1.aaa != ((r1.j << 1) ^ r1.j) * r1.aaa) e(26); +#endif + r1.i = r1.j = r2.i = r2.j = -2; + if ( r1.i > 0 || r1.j >= 0 ) e(27); + if ( r1.i != r2.j ) e(28); + if ( !!! ((((( r1.i == r2.j ))))) ) e(28); + if ( -(-(r1.j)) != r2.j ) e(29); + if ( r1.i % r1.j ) e(30); + if ( (r1.i % r1.j) % r1.i ) e(31); + if ( 0 % r2.j ) e(32); + if ( 03 * r1.i != -6 ) e(33); +#ifndef NOFLOAT + r1.aaa = r2.aaa = -4; + r1.bbb = r2.bbb = 4; + if ( r1.aaa > -3.5 ) e(34); + if ( fabs ( r1.aaa - r2.aaa ) > epsf ) e(35); +#endif + r1.c1 = '\03'; +#ifndef NOFLOAT + if ( fabs ( r2.aaa * r1.aaa - r1.c1 * 5 - 1.0 ) > epsf ) e(36); +#else + if ( 5*r1.c1 != 15 ) e(36) ; +#endif +} + + + + +test7() /* local records */ +{ +#ifndef NOFLOAT + double epsd; + float epsf; + double fabs(); +#endif + struct tp2 s1, s2; + + t = 7; + tct++; +#ifndef NOFLOAT + epsd = EPSD; + epsf = EPSF; +#endif + s1.c1 = 'x'; + s1.i = 40; + s1.j = 50; +#ifndef NOFLOAT + s1.aaa = 3.0; + s1.bbb = 4.0; +#endif + s2.c1 = s1.c1; + s2.i = 50; + s2.j = 40; +#ifndef NOFLOAT + s2.aaa = 4.0; + s2.bbb = 5.0; +#endif + if ( s1.c1 != 'x' || s1.i != 40 ) e(1); +#ifndef NOFLOAT + if ( s1.aaa != 3.0 ) e(1); +#endif + if ( s1.i != 40 || s2.i != 50 ) e(2); + if ( s2.j != 40 || s1.j != 50 ) e(3); + if ( (s1.c1 + s2.c1)/2 != 'x' ) e(4); +#ifndef NOFLOAT + if ( s1.aaa * s1.aaa + s2.aaa * s2.aaa != s2.bbb * s2.bbb ) e(5); + s1.i = s1.j = s2.i = s2.j = 3.0; +#else + s1.i = s1.j = s2.i = s2.j = 3; +#endif + if ( s1.i != 3 ) e(6); + if ( s1.i * s2.j - 9 ) e(7); + s1.i++; + if ( s1.i != 4 ) e(8); + if ( --s1.i != 3 ) e(9); + if ( (++s2.i) * (--s2.j) != 8 ) e(10); + if ( (s2.i = s2.j = s1.j = s1.i = -5 ) != -5 ) e(11); + if ( s2.i * s1.j / 25 != 1 ) e(12); + s1.c1 = '\0'; + if ( s1.i * s1.j * s2.i * s1.c1 * s2.j ) e(13); + s2.c1 = 'j'; + if ( s1.c1 + s2.c1 != 'j' ) e(14); + if ( s1.c1 * s2.c1 ) e(15); + s2.j = s1.i = s2.i = s1.j = 1; + if ( (s1.i<<0) != s1.j ) e(16); + if ( (s1.i >> -0 ) != ( s1.j >> 0 ) ) e(17); + if ( (s1.i<<1) != 2 ) e(18); + if ( (s1.i<<2) != 4 ) e(19); + if ( (s1.j<<3) != (s2.j<<3) ) e(20); + if ( (s1.i | s1.i | s1.i | s1.i | s1.i) != s1.i ) e(21); + if ( (s2.j & s1.j & s2.j & s2.i) != (s1.i<<3>>3) ) e(22); + s1.j = 1; +#ifndef NOFLOAT + s1.aaa = 2.0; + if ( fabs ( s1.j * s1.aaa - 2.0 ) > epsd ) e(23); + if ( (s1.j << 4) * s1.aaa != (s1.j << 4) * s1.aaa ) e(24); + if ( ((s1.j<<6)&s1.j) * s1.aaa ) e(25); + if ((s1.j | (s1.j << 1)) * s1.aaa != ((s1.j << 1) ^ s1.j) * s1.aaa) e(26); +#endif + s1.i = s1.j = s2.i = s2.j = -2; + if ( s1.i > 0 || s1.j >= 0 ) e(27); + if ( s1.i != s2.j ) e(28); + if ( !!! ((((( s1.i == s2.j ))))) ) e(28); + if ( -(-(s1.j)) != s2.j ) e(29); + if ( s1.i % s1.j ) e(30); + if ( (s1.i % s1.j) % s1.i ) e(31); + if ( 0 % s2.j ) e(32); + if ( 03 * s1.i != -6 ) e(33); +#ifndef NOFLOAT + s1.aaa = s2.aaa = -4; + s1.bbb = s2.bbb = 4; + if ( s1.aaa > -3.5 ) e(34); + if ( fabs ( s1.aaa - s2.aaa ) > epsf ) e(35); +#endif + s1.c1 = '\03'; +#ifndef NOFLOAT + if ( fabs ( s2.aaa * s1.aaa - s1.c1 * 5 - 1.0 ) > epsf ) e(36); +#else + if ( 5*r1.c1 != 15 ) e(36) ; +#endif +} + + + + +test8() /* global arrays */ +{ +#ifndef NOFLOAT + float epsf; + double epsd; + double fabs(); +#endif + + t = 8; + tct++; +#ifndef NOFLOAT + epsf = EPSF; + epsd = EPSD; +#endif + for ( i=0; i<20 ; i++ ) + a1[i] = i*i; + if ( a1[9] != 81 || a1[17] != 289 || a1[0] != 0 ) e(1); + if ( a1[1] + a1[2] + a1[3] != 14 ) e(2); + if ( ! a1[15] ) e(3); + if ( a1[8] / a1[4] != 4 ) e(4); +#ifndef NOFLOAT + for ( i=0; i<20; i++ ) + a2[i] = 10.0e-1 + i/54.324e-1; + if ( fabs(a2[4]*a2[4]-a2[4]*(10.0e-1 + 4/54.324e-1 ) ) > epsf ) e(5); + if ( fabs(a2[8]/a2[8]*a2[9]/a2[9]-a2[10]+a2[10]-1.0 ) > epsf ) e(6); + if ( fabs(a2[5]-a2[4]-1/54.324e-1 ) > epsf ) e(7); + for ( i=0; i<20; i++) + a3[i]= 10.0e-1 + i/54.324e-1; + if ( fabs(a3[4]*a3[4]-a3[4]*(1.0e0+4/54.324e-1 )) > epsd ) e(8); + if ( fabs( a3[8]*a3[9]/a3[8]/a3[9]-a3[10]+a3[10]-1000e-3) > epsd ) e(9); + if ( fabs(a3[8]+a3[6]-2*a3[7]) > epsd ) e(10); +#endif + for ( i=0; i<20; i++ ) + a1[i] = i+1; + if ( a1[a1[a1[a1[a1[a1[0]]]]]] != 6 ) e(11); + if ( a1[a1[0]+a1[1]+a1[2]+a1[3]] != 11 ) e(12); + if ( (a1[0] << 2) != 4 ) e(13); + if ( (a1[0] >> 2) ) e(14); + if ( (a1[0] << 3 >> 3) != a1[0] ) e(15); + if ( a1[a1[0] << 1] != 3 ) e(16); + if ( a1[4<<1] != 9 ) e(17); + if ( a1[4 << 1] != 9 ) e(18); + if ( (1 << a1[0]) != 2 ) e(19); + if ( (1 & a1[0]) != 1 ) e(20); + if ( a1[4]++ != 5 ) e(21); + if ( a1[4] != 6 ) e(22); + if ( --a1[4] != 5 ) e(23); + if ( a1[ --a1[10] ] != 10 ) e(24); + a1[0] = 0; + a1[1] = 1; + a1[2] = 2; + a1[3] = 3; + i = 3; + if ( a1[--i] != 2 ) e(25); + if ( a1[ a1[--i] ] != 1 ) e(26); + if ( a1[a1[a1[a1[a1[a1[a1[a1[3]]]]]]]] != 3 ) e(27); + if ( a1[1+2] != 3 ) e(28); + if ( a1[1+2] != a1[3/3] + 2 ) e(29); + if ( a1[i=2] != 2 ) e(30); + if ( -a1[i==3] ) e(31); + if ( a1[3*2 + a1[0]*6 - 10/2 -4 + 3/1] != 0 ) e(32); + if ( a1['a' + 'c' -2*'b'] ) e(33); + if ( a1[ a1[0]==a1[1] ] ) e(34); + if ( a1[a1[1<<1]>>1] != 1 ) e(35); + a1[i=j=4] = 10; + if ( (i!=4) || (j!=4) || (i!=j) ) e(36); + if ( a1[4] != 10 ) e(37); + if ( a1[--i] != 3 ) e(38); + if ( a1[i++] != 3 ) e(39); + if ( --a1[--i] != 2 ) e(40); + a1[a1[a1[a1[a1[0]=7]=5]=8]=2]=0; + if ( a1[0] != 7) e(41); + if ((a1[7] != 5) || (a1[5]!=8) || (a1[8]!=2))e(42); + if (a1[2]) e(43); + for ( i=0 ; i<20; i++) + a1[i] = i; + a1[0] = 0; + a1[1] = 01; + a1[2] = 02; + a1[3] = 04; + a1[4] = 010; + if ((a1[0] | a1[1] | a1[2] | a1[3] | a1[4]) != 017 ) e(44); + if ( a1[0]<<4 ) e(45); + if ( (a1[4]>>3) != 1 ) e(46); + a1[4] = 04; + a1[010] = 010; + if ( a1[8] != 8 ) e(47); + if ( a1[0|1|2|4|8] != (a1[0]|a1[1]|a1[2]|a1[4]|a1[8]) ) e(48); + if ( a1[a1[0]|a1[1]|a1[2]|a1[4]|a1[8]] != a1[017] ) e(49); + if ( a1[a1[1]^a1[2]^a1[4]^a1[8]] != a1[a1[1]|a1[2]|a1[4]|a1[8]] ) e(50); + for ( i = 0; i<20; i++ ) + a1[i] = i+1; +#ifndef NOFLOAT + for ( i = 0; i<20; i++ ) + a2[i] = a3[i] = a1[i]; + if ( a2[5] != 6.0 ) e(51); + if ( a2[13] != 14.0 ) e(52); + if ( a2[a1[a1[a1[a1[a1[0]]]]]] != 6.0 ) e(53); +#endif + if ( a1[12] != 13 ) e(54); +#ifndef NOFLOAT + if ( a1[ a1[12] = a2[a1[11]] ] != 14 ) e(55); + if ( fabs( a2[13] - a2[a1[12]] ) > epsf ) e(56); + if ( a2[8] != a1[8] ) e(57); +#endif +} + + + + +test9() /* local arrays */ +{ +#ifndef NOFLOAT + float epsf; + double epsd; + double fabs(); +#endif + int b1[20]; +#ifndef NOFLOAT + float b2[20]; + double b3[20]; +#endif + + t = 9; + tct++; +#ifndef NOFLOAT + epsf = EPSF; + epsd = EPSD; +#endif + for ( i=0; i<20 ; i++ ) + b1[i] = i*i; + if ( b1[9] != 81 || b1[17] != 289 || b1[0] != 0 ) e(1); + if ( b1[1] + b1[2] + b1[3] != 14 ) e(2); + if ( ! b1[15] ) e(3); + if ( b1[8] / b1[4] != 4 ) e(4); +#ifndef NOFLOAT + for ( i=0; i<20; i++ ) + b2[i] = 10.0e-1 + i/54.324e-1; + if ( fabs(b2[4]*b2[4]-b2[4]*(10.0e-1 + 4/54.324e-1 ) ) > epsf ) e(5); + if ( fabs(b2[8]/b2[8]*b2[9]/b2[9]-b2[10]+b2[10]-1.0 ) > epsf ) e(6); + if ( fabs(b2[5]-b2[4]-1/54.324e-1 ) > epsf ) e(7); + for ( i=0; i<20; i++) + b3[i]= 10.0e-1 + i/54.324e-1; + if ( fabs(b3[4]*b3[4]-b3[4]*(1.0e0+4/54.324e-1 )) > epsd ) e(8); + if ( fabs( b3[8]*b3[9]/b3[8]/b3[9]-b3[10]+b3[10]-1000e-3) > epsd ) e(9); + if ( fabs(b3[8]+b3[6]-2*b3[7]) > epsd ) e(10); +#endif + for ( i=0; i<20; i++ ) + b1[i] = i+1; + if ( b1[b1[b1[b1[b1[b1[0]]]]]] != 6 ) e(11); + if ( b1[b1[0]+b1[1]+b1[2]+b1[3]] != 11 ) e(12); + if ( (b1[0] << 2) != 4 ) e(13); + if ( (b1[0] >> 2) ) e(14); + if ( (b1[0] << 3 >> 3) != b1[0] ) e(15); + if ( b1[b1[0] << 1] != 3 ) e(16); + if ( b1[4<<1] != 9 ) e(17); + if ( b1[4 << 1] != 9 ) e(18); + if ( (1 << b1[0]) != 2 ) e(19); + if ( (1 & b1[0]) != 1 ) e(20); + if ( b1[4]++ != 5 ) e(21); + if ( b1[4] != 6 ) e(22); + if ( --b1[4] != 5 ) e(23); + if ( b1[ --b1[10] ] != 10 ) e(24); + b1[0] = 0; + b1[1] = 1; + b1[2] = 2; + b1[3] = 3; + i = 3; + if ( b1[--i] != 2 ) e(25); + if ( b1[ b1[--i] ] != 1 ) e(26); + if ( b1[b1[b1[b1[b1[b1[b1[b1[3]]]]]]]] != 3 ) e(27); + if ( b1[1+2] != 3 ) e(28); + if ( b1[1+2] != b1[3/3] + 2 ) e(29); + if ( b1[i=2] != 2 ) e(30); + if ( -b1[i==3] ) e(31); + if ( b1[3*2 + b1[0]*6 - 10/2 -4 + 3/1] != 0 ) e(32); + if ( b1['a' + 'c' -2*'b'] ) e(33); + if ( b1[ b1[0]==b1[1] ] ) e(34); + if ( b1[b1[1<<1]>>1] != 1 ) e(35); + b1[i=j=4] = 10; + if ( (i!=4) || (j!=4) || (i!=j) ) e(36); + if ( b1[4] != 10 ) e(37); + if ( b1[--i] != 3 ) e(38); + if ( b1[i++] != 3 ) e(39); + if ( --b1[--i] != 2 ) e(40); + b1[b1[b1[b1[b1[0]=7]=5]=8]=2]=0; + if ( b1[0] != 7) e(41); + if ((b1[7] != 5) || (b1[5]!=8) || (b1[8]!=2))e(42); + if (b1[2]) e(43); + for ( i=0 ; i<20; i++) + b1[i] = i; + b1[0] = 0; + b1[1] = 01; + b1[2] = 02; + b1[3] = 04; + b1[4] = 010; + if ((b1[0] | b1[1] | b1[2] | b1[3] | b1[4]) != 017 ) e(44); + if ( b1[0]<<4 ) e(45); + if ( (b1[4]>>3) != 1 ) e(46); + b1[4] = 04; + b1[010] = 010; + if ( b1[8] != 8 ) e(47); + if ( b1[0|1|2|4|8] != (b1[0]|b1[1]|b1[2]|b1[4]|b1[8]) ) e(48); + if ( b1[b1[0]|b1[1]|b1[2]|b1[4]|b1[8]] != b1[017] ) e(49); + if ( b1[b1[1]^b1[2]^b1[4]^b1[8]] != b1[b1[1]|b1[2]|b1[4]|b1[8]] ) e(50); + for ( i = 0; i<20; i++ ) + b1[i] = i+1; +#ifndef NOFLOAT + for ( i = 0; i<20; i++ ) + b2[i] = b3[i] = b1[i]; + if ( b2[5] != 6.0 ) e(51); + if ( b2[13] != 14.0 ) e(52); + if ( b2[b1[b1[b1[b1[b1[0]]]]]] != 6.0 ) e(53); +#endif + if ( b1[12] != 13 ) e(54); +#ifndef NOFLOAT + if ( b1[ b1[12] = b2[b1[11]] ] != 14 ) e(55); + if ( fabs( b2[13] - b2[b1[12]] ) > epsf ) e(56); + if ( b2[8] != b1[8] ) e(57); +#endif +} + + + + +test10() /* global pointers */ +{ +#ifndef NOFLOAT + float epsf; + double fabs(); +#endif + int li; + struct tp2 strp2; + +#ifndef NOFLOAT + epsf = EPSF; +#endif + t = 10; + tct++; + p1 = &li; + li = 076; + if ( p1 != &li ) e(1); + p11 = &li; + if ( p1 != p11 ) e(3); + if ( *p1 != *p11 ) e(4); + if ( &li != p11 ) e(5); + if ( *&p1 != p1 ) e(6); + if ( &*p1 != p1 ) e(7); + if ( **&p1 != *&*p1 ) e(10); + if ( *&*&*&*&*&li != li ) e(11); + p1 = &p ; + p2 = &p1; + *p1 = **p2 = 34; + if ( p1 != *p2 ) e(25); + li = 4; + p1 = &li; + p2 = &p1; + p3 = &p2; + p4 = &p3; + p5 = &p4; + if ( *p1 != **p2 ) e(26); + if ( **p2 != **p2 ) e(27); + if ( ***p3 != **p2 ) e(28); + if ( *****p5 != 4 ) e(30); + li = 3; + if ( *p1 - *p1 ) e(44); + if ( p1 != &li ) e(46); + pp1 = (struct tp2 *) alloc( sizeof *pp1 ); + pp2 = (struct tp2 *) alloc( sizeof *pp2 ); + pp3 = (struct tp2 *) alloc( sizeof *pp3 ); + pp1->i = 1325; + if ( pp1->i != 1325 ) e(47); + pp1->i = pp2->i = pp3->i = 3; + if ( pp1->i * pp1->i != 9 ) e(48); + if ( pp1->i * pp2->i * pp3->i != pp2->i * 3 * 3 ) e(49); + if ( pp1->i - pp3->i ) e(50); + if ( (*pp1).i != pp1->i ) e(51); + pp1->i++; + if ( ++pp2->i != pp1->i ) e(52); + if ( pp2->i != 4 ) e(53); +#ifndef NOFLOAT + pp1->aaa = 3.0; + pp2->aaa = -3.0; + pp3->bbb = 25.0; + if ( pp1->aaa != 3.0 ) e(54); + if ( fabs( pp1->aaa + pp2->aaa ) > epsf ) e(55); + if ( fabs( pp1->aaa * pp2->aaa + pp3->bbb - 16 ) > epsf ) e(56); + if ( fabs( pp1->aaa / pp2->aaa + 1 ) > epsf ) e(57); +#endif + pp1->c1 = 'x'; + pp1->i = pp1->j = 45; +#ifndef NOFLOAT + pp1->aaa = 100.0; + pp1->bbb = 1024.0; +#endif + strp2.c1 = pp1->c1; /* strp2 is a local struct */ + strp2.i = pp1->i = strp2.j = pp1->j; +#ifndef NOFLOAT + strp2.aaa = pp1->aaa; + strp2.bbb = pp1->bbb; +#endif + if ( strp2.c1 != 'x' ) e(58); + if ( strp2.i != strp2.j ) e(59); +#ifndef NOFLOAT + if ( strp2.aaa != pp1->aaa ) e(60); + if ( strp2.bbb != pp1->bbb ) e(61); +#endif +} + +#ifndef NOFLOAT + +test11() /* real arithmetic */ +{ + double fabs(); + double epsd; + float epsf; + float locxf; + + t = 11 ; + tct++; + epsf = EPSF; + epsd = EPSD; + xf = 1.50; + yf = 3.00; + zf = 0.10; + xd = 1.50; + yd = 3.00; + zd = 0.10; + if ( fabs(1.0 + 1.0 - 2.0) > epsd ) e(1); + if ( fabs( 1e10-1e10 ) > epsd ) e(2); + if ( fabs( 1.0e+5 * 1.0e+5 - 100e+8 ) > epsd ) e(3); + if ( fabs( 10.0/3.0 * 3.0/10.0 - 100e-2 ) > epsd ) e(4); + if ( 0.0e0 != 0 ) e(5); + if ( fabs( 32767.0 - 32767 ) > epsd ) e(6); + if ( fabs( 1.0+2+5+3.0e0+7.5e+1+140e-1-100.0 ) > epsd ) e(7); + if ( fabs(-1+(-1)+(-1.0)+(-1.0e0)+(-1.0e-0)+(-1e0)+6 ) > epsd ) e(8); + if ( fabs(5.0*yf*zf-xf) > epsf ) e(9); + if ( fabs(5.0*yd*zd-xd) > epsd ) e(10); + if ( fabs(yd*yd - (2.0*xd)*(2.0*xd) ) > epsd ) e(11); + if ( fabs(yf*yf - (2.0*xf)*(2.0*xf) ) > epsf ) e(12); + if ( fabs( yd*yd+zd*zd+2.0*yd*zd-(yd+zd)*(zd+yd) ) > epsf ) e(13); + if ( fabs( yf*yf+zf*zf+2.0*yf*zf-(yf+zf)*(zf+yf) ) > epsf ) e(14); + xf = 1.10; + yf = 1.20; + if ( yd=yd ) e(18); + if ( yd epsd ) e(20); + if ( 1.0 * 3.0 != 3.0 * 1.0 ) e(21); + if ( 1.0 != 1e+0 ) e(22); + if ( 4.5 < 4.4 ) e(23); + if ( -3.4 != -3.4 ) e(24); + if ( 10/3.0 - 10/3.0 != 0.0 ) e(25); + if ( fabs( (1<<0) * (-5.3) + 5.3 ) > epsd ) e(26); + if ( fabs( (1<<3) * 5.0 - 4e+1 ) > epsd ) e(27); + if ( fabs( ((1<<5)>>5) - 1e-0 ) > epsd ) e(28); + if ( fabs ( 00000 * 3.0 ) > epsd ) e(29); + if ( fabs ( 8 * 5.0 - 02 * 02 + 04 / 1.0 -40.0 ) > epsd ) e(30); + if ( fabs ( 'a' / 1.0 - 'a' ) > epsd ) e(31); + if ( fabs ( (!1) * ( 2.0 / -34e-1 ) ) > epsd ) e(32); + if ( fabs ( (01 | 1 | 2) * 4.0 - 12.0 ) > epsd ) e(33); + if ( fabs ( 1.0 * 2.0 * 3.0 * 4.0 * 5.0 - 120.0 ) > epsd ) e(34); + if ( fabs ( 1.0 * 2.0 * (1 | (4>>1)) - 6 ) > epsd ) e(35); + if ( fabs ( ( 0 ^ 0 ^ 0 ^ 0 ) * 0.0 ) > epsd ) e(36); + if ( fabs ( 1.0 * 2.0 * (1 ^ (4>>1)) - 6 ) > epsd ) e(37); + if ( fabs ( (((((-1.0 * (((((-1.0))))) - 1.0 ))))) ) > epsd) e(38); + if ( fabs ( ( 2==3 ) * 3.0 ) > epsd ) e(39); + if ( ( 4 + 3 > 5 ? 3.4 : -5e+3 ) != 3.4 ) e(40); + if ( ( -4 -'a' > 0 ? 3.4 : -5e+3 ) != -5e+3 ) e(41); + locxf = 3.0; + xf = 3.0; + if ( locxf != locxf ) e(42); + if ( locxf != xf ) e(43); + if ( locxf * xf != xf * locxf ) e(44); + if ( fabs ( ((2*3)>>1) / 3.0 - 1.0 ) > epsd ) e(45); + if ( fabs ( 'a' / locxf - 'a' / xf ) > epsd ) e(46); + if ( fabs( xf * locxf - 9.0 ) > epsd ) e(47); + yd = 3.0; + if ( fabs( xf*yd - 9.0) > epsd ) e(48); + if ( yd >= 4 ) e(49); + if ( locxf == 2 ) e(50); +} + +#endif + + diff --git a/lang/cem/ctest/ctest1/test.cem.g b/lang/cem/ctest/ctest1/test.cem.g new file mode 100644 index 00000000..efe00e30 --- /dev/null +++ b/lang/cem/ctest/ctest1/test.cem.g @@ -0,0 +1 @@ +End of test program, 11 tests completed, 0 errors detected diff --git a/lang/cem/ctest/ctest2/run b/lang/cem/ctest/ctest2/run new file mode 100644 index 00000000..66088486 --- /dev/null +++ b/lang/cem/ctest/ctest2/run @@ -0,0 +1 @@ +make "P=t7" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctest2/t7.c b/lang/cem/ctest/ctest2/t7.c new file mode 100644 index 00000000..3eaa5bf2 --- /dev/null +++ b/lang/cem/ctest/ctest2/t7.c @@ -0,0 +1,639 @@ +# +/* + * (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 + * + */ + +char rcs_id[] = "$Header$" ; + + +/* +#define TEST1 1 +*/ + + +/* This program can be used to test C-compilers */ +/* It is supposed the first test program (= "test1") */ +/* is used to test the basic arithmetic */ + +/* The following are global counters */ + +int t, /* the value indicates the number of the test procedure */ + ect, /* error counter */ + tct; /* count the number of test procedures called */ + +/************************************************************************/ +/* */ +/* The following is tested: */ +/* FOR STATEMENTS in test1 */ +/* WHILE STATEMENTS in test2 */ +/* WHILE and FOR STATEMENTS in test3 */ +/* DO STATEMENTS in test4 */ +/* SWITCH STATEMENTS in test5 */ +/* */ +/************************************************************************/ + + + +char *pp1 = "End of test program, "; +char *pp2 = " test(s) completed, "; +char *pp3 = " errors detected\n"; +char *pp4 = "Error "; +char *pp5 = " in test"; +char *pp6 = "\n"; + +itoa(p,ptr) +/* converts integer "p" to ascii string "ptr" */ +int p; +char *ptr; +{ + register int k,l; + register char *str; + int sign; + + str=ptr; + k=p; + if ((sign=k)<0) + k = -k; + do + { + l = k % 10; + k /= 10; + *str++ = l + '0'; + } + while(k); + if (sign<0) + *str++ = '-'; + *str = '\0'; + reverse(ptr); +} + + + +reverse(s) +char s[]; +{ + register int c,i,j; + + for (i=0, j=strlen(s)-1; i32700; i--) + j++; + if (j != 67) e(23); + j=0; + for (i= -32768; i<-32700; i++) + j++; + if (j != 68) e(24); +} + + + + +test2() /* Testing the while statement */ +{ + int i, j; + + t = 2; + tct++; + while(1) + { + break; + e(1); + return; + } + while(0) + { + e(2); + break; + e(3); + return; + } + while (1 || 0) + { + break; + e(4); + return; + } + while (1 && 0) + { + e(5); + break; + e(6); + return; + } + j = 10; + while (--j) + ; + if (j != 0) e(7); + while (j) + { + e(8); + break; + } + while ( i=j ) + { + e(9); + break; + } + while ( (i==j) && (i!=j) ) + { + e(10); + break; + } + j = 1; + while (j) + while(j) + while(j) + while(j) + while(j) + while(--j) + ; + if (j != 0) e(11); + if (j) e(12); + j = 30; + while (--j) + { + continue; + continue; + continue; + continue; + continue; + break; + e(13); + } +} + + + + +test3() /* Combined FOR and WHILE statements */ +{ + int i,j; + + t = 3; + tct++; + j = 0; + for (i=3; i; i++) + { + while (i--) + ; + if (++j > 1) e(1); + } +} + + + + +test4() /* Do statement */ +{ + int i; + + t = 4; + tct++; + i = 0; + do + if (i) e(1); + while (i); + do + { + do + { + do + { + do + { + i++; + } + while (!i); + i++; + } + while (!i); + i++; + } + while (!i); + i++; + } + while (!i); + if (i != 4) e(2); +} + + + + +test5() /* SWITCH statement */ +{ + int i,j; + + t = 5; + tct++; + for (i=0; i<10; i++) + { + switch (i) + { + case 0: if (i != 0) e(1); + break; + case 1: if (i != 1) e(2); + break; + case 2: if (i != 2) e(3); + break; + case 3: if (i != 3) e(4); + i++; + case 4: if (i != 4) e(5); + case 5: + case 6: + case 7: + case 8: + case 9: + break; + default: e(6); + } + } + for (i=j= -18; i<10; i++, j++) + { + switch (i) + { + case -3: + case 7: + case 1: switch (j) + { + case -3: + case 7: + case 1: + break; + default: e(7); + } + break; + e(8); + case -4: switch (j) + { + case -4: if (i != -4) e(9); + break; + default: e(10); + } + } + } + i = 'a'; + switch (i) + { + case 'a': + switch ( i ) + { + case 'a': + switch ( i ) + { + case 'a': + break; + default: e(11); + } + break; + default: e(12); + } + break; + default: e(13); + } +} + + + +test6() /* goto statement */ +{ + int k; + + t = 6; + tct++; + k = 0; + goto lab0; +xl1: + k = 1; + goto lab1; +xl2: + k = 2; + goto lab2; +xl3: + k = 3; + goto lab3; +xl4: + k = 4; + goto llab1; +llab2: goto llab3; +llab4: goto llab5; +llab6: goto llab7; +llab8: if ( k != 4 ) e(5); + return ; +llab1: goto llab2; +llab3: goto llab4; +llab5: goto llab6; +llab7: goto llab8; +lab0: if ( k!= 0 ) e(1); + goto xl1 ; +lab1: if ( k!= 1 ) e(2); + goto xl2 ; +lab2: if ( k!= 2 ) e(3); + goto xl3 ; +lab3: if ( k!= 3 ) e(4); + goto xl4 ; +} + + + +test7() /* Combinations of FOR, WHILE, DO and SWITCH statements */ +{ + int i,j,k; + + t = 7; + tct++; + for ( i=j=k=0; i<6; i++, j++, k++ ) + { + if ( i != j ) e(1); + if ( i != k ) e(2); + if ( j != k ) e(3); + while ( i > j ) + { + e(4); + break; + } + while ( i > k ) + { + e(5); + break; + } + while ( j != k ) + { + e(6); + break; + } + switch(i) + { + case 0: + switch(j) + { + case 0: + switch(k) + { + case 0: if ( i+j+k != 0 ) e(7); + break; + e(8); + default: if ( i+j+k != k ) e(9); + } + break; + default: if ( j > 6 ) e(10); + if ( k != j ) e(11); + } + break; + case 1: + case 2: + case 3: + case 4: + case 5: break; + default: e(12); + } + } + for ( i=j= -3; i<0; i++,j++) + if ( j == -3 ) + do + if ( i ) + switch ( i ) + { + case -3: if ( j != i ) e(13); + case -2: if ( j != i ) e(14); + case -1: for ( k=i; k < 2*j-j; k++) + { + e(15); + break; + } + break; + case 0: e(16); + break; + default: e(17); + break; + } + else e(18); + while ( 0 ); + if ( i != j ) e(19); +} + + + + +test8() +{ + int *p1, *p2; + int i,j,k; + int a1[1], a2[2][2], a3[3][3][3]; + + t = 8; + tct++; + a1[0] = 0; + for ( i=0; i<2; i++ ) + for ( j=0; j<2; j++ ) + a2[i][j] = (i*j) ^ (i+j); + if ( a2[0][0] != 0 ) e(1); + if ( a2[0][1] != 1 ) e(2); + if ( a2[1][0] != a2[0][1] ) e(3); + for ( i=0; i<3; i++) + for (j=0; j<3; j++) + for (k=0; k<3; k++) + a3[i][j][k] = i | j | k; + if ( a3[0][0][0] != 0 ) e(4); + if ( a3[0][1][2] != a3[2][0][1] ) e(5); + if ( a3[2][1][1] != (2 | 1 | 1) ) e(6); + p2 = &a3[0][1][2]; + p1 = &a3[0][1][2]; + for ( ; p1 == p2 ; p1++ ) + { + switch ( *p1 ) + { + case 3: break; + default: e(7); + } + if ( *p1 != *p2 ) e(8); + } +} diff --git a/lang/cem/ctest/ctest2/t7.cem.g b/lang/cem/ctest/ctest2/t7.cem.g new file mode 100644 index 00000000..e2a3df7e --- /dev/null +++ b/lang/cem/ctest/ctest2/t7.cem.g @@ -0,0 +1 @@ +End of test program, 8 test(s) completed, 0 errors detected diff --git a/lang/cem/ctest/ctest3/run b/lang/cem/ctest/ctest3/run new file mode 100755 index 00000000..09df784d --- /dev/null +++ b/lang/cem/ctest/ctest3/run @@ -0,0 +1 @@ +make "P=test2" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctest3/test2.c b/lang/cem/ctest/ctest3/test2.c new file mode 100644 index 00000000..1a302d04 --- /dev/null +++ b/lang/cem/ctest/ctest3/test2.c @@ -0,0 +1,461 @@ +/* + * (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 + * + */ + +char rcs_id[] = "$Header$" ; + +/* This program can be used to test C-compilers */ + + +int t, ect, tct; + + +/**********************************************************************/ +/* + * Testing basic function calls + * + */ + + + +main() +{ + tct = 0; + ect = 0; + test1(); + test2(); + test3(); + test4(); + test5(); + test6(); + printf("End of test program, %d tests completed, %d errors detected\n", + tct,ect); + return 0 ; +} + + + + +e(n) +int n; +{ + ect++; + printf("Error %d in test%d \n",n,t); +} + + + + +one() +{ + return(1); +} + + + + +two() +{ + return(2); +} + + + + +three() +{ + return(3); +} + + + + +four() +{ + return(4); +} + + + + +five() +{ + return(5); +} + + + + +plus() +{ + return ( one() + two() + three() + four() + five() ); +} + + + + +multipl() +{ + return( one() * two() * three() * four() * five() ); +} + + + + +subtr() +{ + return( - one() - two() - three() - four() - five() ); +} + + + + +test1() +{ + int i; + int count; + + t = 1; + tct++; + if ( one() != 1 ) e(1); + if ( two() != 2 ) e(2); + if ( three() != 3 ) e(3); + if ( four() != 4 ) e(4); + if ( five() != 5 ) e(5); + if ( (one() + two()) != 3 ) e(6); + if ( ((((((one() + two())))))) != 3) e(7); + if ( (one() * three()) != 3) e(8); + if (( (four() + three()) * two()) != 14) e(9); + if ( (four() + four()) != (two() * four()) ) e(10); + if ( (four() - four()) / three() ) e(11); + if (( four() + 3 * 12 - ( one() * two() * 2 ) ) != 36 ) e(12); + if ( one() & two() & four() & three() ) e(13); + if ( !( three() && two() ) ) e(14); + for (i=0; i<8; i++) + { + count = one() + two() + three() + four(); + count = count * one(); + count = count * two() - one() - two() - three() - four(); + } + if (count != 10) e(15); + if ( !one() ) e(16); + if ( plus() != 15 ) e(17); + if ( multipl() != 120 ) e(18); + if ( subtr() != -15 ) e(19); + if ( -subtr() != plus() ) e(18); + if ( -subtr() != plus() ) e(21); +} + + + + +echo(a) +int a; +{ + return ( a ); +} + + + + +min(a,b) +int a,b; +{ + if ( a < b ) + return(a); + return(b); +} + + + + +max1(a,b) +int a,b; +{ + if ( a < b ) + return(b); + return(a); +} + + + + +max2(a,b) +int a,b; +{ + return ( ( a < b ? b : a ) ); +} + + + + +test2() +{ + int i,j; + int a,b; + + t = 2; + tct++; + if ( echo(1) != 1 ) e(1); + if ( echo(3) != 3 ) e(2); + if ( echo(0) ) e(3); + if ( echo(2) + echo(3) != echo(5) ) e(4); + if ( echo( 2 + 3 ) != 5 ) e(5); + if ( echo ( 1 + 2 + 3 + 4 + 5 ) != 10 + echo(5) ) e(6); + if (( echo( 2<<1 ) ) != 4 ) e(7); + if ( echo( 2 >> 1 ) != 1 ) e(8); + if ( echo( 1 << 4 ) != echo( 2 << 3 ) ) e(9); + if ( echo( echo(4) ) != echo(4) ) e(10); + if (( echo ( echo ( echo( echo ( echo ( 3 ) ) ) ) ) ) != 3 ) e(11); + if ( echo( echo( echo(2+3-4+echo(4)*echo(2))) ) != 9 ) e(12); + if ( min(1,2) != 1) e(13); + if (min(0,45) != 0) e(14); + if (min(45,0) != 0) e(15); + if (min(-72,-100) != -100) e(16); + if (min(-100,-72) != -100) e(17); + if (min(1<<3,2<<3) != (1<<3) ) e(18); + if ( min( echo(3), echo(3) ) != echo (echo(3)) ) e(19); + if ( max1('a','b') != 'b' ) e(20); + if ( max1('b','a') != 'b' ) e(21); + if ( max1(-3,54+2) != ( -3 < 54+2 ? 54+2 : -3 ) ) e(22); + if (max1('a'+'b'+34,'a'*2) != max2('a'*2,'a'+'b'+34)) e(23); + if (max1(345/23,4) != max1( echo(345/23), 4) ) e(24); + if ( max1( max1(2,3), max1(2,3) ) != max1(2,3) ) e(25); + for (i=3; i<5; i++) + if ((max1(i,-i)) != i) e(26); + for (j=min('a',34); jmax1(min(34,'a'),max2(34,'a')) ) e(28); + } + a=b= -32768; + if ( min(echo(a),a) != a) e(29); + if ( max1(echo(b),max1(b,b)) != b) e(30); +} + + + + +sum(k) +int k; +{ + if (k<=0) + return(0); + return(k+sum(k-1)); +} + + + + +formula(k) +int k; +{ + if (k<=0) + return(0); + return ( ((((( (k*(k+1))/2 ))))) ); +} + + + + +test3() +{ + int k; + int count; + + t = 3; + tct++; + count=0; + if ( sum(-4) != 0 ) e(1); + if ( sum(0) != 0 ) e(2); + if ( sum(2) != 3 ) e(3); + if ( sum(10) != 55 ) e(4); + if ( sum(34) != formula(34) ) e(5); + if ( sum(101) != formula(101) ) e(6); + if ( sum( sum(11) ) != formula( formula(11) ) ) e(7); + if ( sum( sum(11) ) != formula( sum(11) ) ) e(8); + if ( sum( sum( sum(4) )) != sum ( formula ( sum( 4) )) ) e(9); + for (k = sum(-45); ksizeof alstr ) { + printf("allocation overflow\n") ; + exit(8) ; + } + return(retval) ; +} + +int abs(a) int a ; { return ( a<0 ? -a : a) ; } +#ifndef NOFLOAT +double fabs(a) double a ; { return( a<0 ? -a : a) ; } +#endif + +e(n) +{ ect++; printf("error %d in test %d \n",n,t); +} + +inc(n) +{ return(++n);} + +/***********************************************************************/ + +test1() +/*arithmetic on constants */ +{ t = 1; pct++; + if (1+1 != 2) e(1); + if (3333 + 258 != 3591) e(2); + if (3*4 != 12) e(3); + if (111*111 != 12321) e(4); + if (50 / 5 != 10) e(5); + if (7498 / 75 != 99) e(6); + if (456 - 345 != 111) e(7); + if (1+(-2) != -1) e(8); + if (-3 * -4 != 12) e(9); + if (-2 / 2 != -1) e(10); + if (-5 / 1 != -5 ) e(11); + if (-4 - -5 != 1) e(12); + if ( 03 + 02 != 05) e(13); + if ( 03456 + 88 != 03606 ) e(14); + if ( 0100 * 23 != 02700 ) e(15); + if ( 045 / 020 != 2) e(16); + if (0472 - 0377 != 073 ) e(17); + if ('a' + 3 != 100) e(18); + if ('a' + 'c' != 'b' + 'b') e(19); + if ( 'z' * 'z' != 14884 ) e(20); + if ( -'z' / 01 != -'z' ) e(21); + if ( 077777 >> 3 != 07777 ) e(22); + if ( 077777 >> 15 ) e(23); + if ( 234 << 6 != 234 << 6 ) e(24); + if ( 0124 & 07765 != 0124 ) e(25); + if ( 34 & 31 != 2 ) e(26); + if ( ( -4 | 3 ) != -1 ) e(27); + if ( ( 5 | 013 | 020 ) != 31 ) e(28); + if ( ( -7 ^ 3 ) != -6 ) e(29); + if ( ( 07373 ^ 4632 ) != 016343 ) e(30); + if ( (1+2+3)*(2+3+4)*(3+5+5) / 2 != ((3*((5+3+2)*10)+51)*6)/6 ) e(31); + if ( (1000*2+5*7+13)/ 8 != 2*2*2*2*4*4 ) e(32); + if ((1*2*3*4*5*6*7 / 5040 != + 5040 / 7 / 6 / 5 / 4 / 3 / 2 / 1 )) e(33); + if ( -(-(-(-(-(-(1)))))) != 1 ) e(34); + if (- 1 != -((((((((((1)))))))))) ) e(35); + if ( -1-1-1-1-1-1 != -6-3+3 ) e(36); + if ( -4 * -5 != 20 ) e(37); + if ( 2<1 ) e(38); + if ( 2<= 1 ) e(39); + if ( 2==3 ) e(40); + if ( 2 != 2 ) e(41); + if ( 2 >= 3) e(42); + if ( 2 > 3 ) e(43); + if (2 + 0 != 2 ) e(44); + if (2 - 0 != 2 ) e(45); + if (2 * 0 != 0 ) e(46); + if ( 0 / 1 != 0 ) e(47); + if ( -0 != 0 ) e(48); + if ( 0 * 0 != 0 ) e(49); + if ( 32767 > 32767 ) e(50); + if ( 0456 < 0400 ) e(51); + if ( 0456 != ( 0400 | 050 | 06 ) ) e(52); + if ( 2*2<<2*2/4 != 010 ) e(53); + if ( 0 || 0 ) e(54); + if ( 1 && 0 ) e(55); + if ( ( 123 ? 123 * 4 :345) != 492 ) e(56); + if ( ( 0 ? 345 : 280) != 280 ) e(57); + if ( ( (2*2/2<<2)|(2/2) ) != 9 ) e(58); + if ( !( 111 || 23 && 0 ) ) e(59); + if ( !1 ) e(60); + if ( !0 == 0 ) e(61); + if ( !!!!!!!!0 ) e(62); +} + +/***********************************************************************/ + +test2() +/*arithmetic on global integer variables*/ +{ t = 2; pct++; + i = 1; j = 2; k = 3; l = 4; m = 10; + if ( i+j != k ) e(1); + if ( i+k != l ) e(2); + if ( j-k != -i ) e(3); + if ( j*(j + k) != m ) e(4); + if ( -m != -(k+k+l) ) e(5); + if ( i / i != 1 ) e(6); + if ( m*m / m != m ) e(7); + if ( 10 * m != 100 ) e(8); + if ( m * (-10) != -100 ) e(9); + if ( j / k != 0 ) e(10); + if ( 100 / k != 33 ) e(11); + if ( i+j*k+l+m / j + 50 / k != 32 ) e(12); + if ( j*k*m / 6 != 10 ) e(13); + if ( (k>4) || (k>=4) || (k==4) ) e(14); + if ( (m j ) e(19); + if ( (i > j ? k : k*j ) != 6 ) e(20); + if ( (i < j ? k : k*j ) != 3 ) e(21); + if ( j<> i != i ) e(25); + if ( i++ != 1 ) e(26); + if ( --i != 1 ) e(27); + if ( i-- != 1 ) e(28); + if ( ( i+j ) && ( i<0 ) || (m-10) && (064) ) e(29); + if ( ( i+j ) && !(i>=0) || (m-10) && !( 0 ) ) e(30); +} + +/***********************************************************************/ + +test3() +/*arithmetic on local integer variables*/ +{ int a,b,c,d,f; + t = 3; pct++; + a = 1; b = 2; c = 3; d = 4; f = 10; + if ( a+b != c ) e(1); + if ( a+c != d ) e(2); + if ( b-c != -a ) e(3); + if ( b*(b + c) != f ) e(4); + if ( -f != -(c+c+d) ) e(5); + if ( a / a != 1 ) e(6); + if ( f*f / f != f ) e(7); + if ( 10 * f != 100 ) e(8); + if ( f * (-10) != -100 ) e(9); + if ( b / c != 0 ) e(10); + if ( 100 / c != 33 ) e(11); + if ( a+b*c+d+f / b + 50 / c != 32 ) e(12); + if ( b*c*f / 6 != 10 ) e(13); + if ( (c>4) || (c>=4) || (c==4) ) e(14); + if ( (f b ) e(19); + if ( (a > b ? c : c*b ) != 6 ) e(20); + if ( (a < b ? c : c*b ) != 3 ) e(21); + if ( b<> a != a ) e(25); + if ( a++ != 1 ) e(26); + if ( --a != 1 ) e(27); + if ( a-- != 1 ) e(28); + if ( ( a+b ) && ( a<0 ) || (f-10) && (064) ) e(29); + if ( ( a+b ) && !(a>=0) || (f-10) && !( 0 ) ) e(30); +} + +/***********************************************************************/ + +test4() +/* global arrays */ +{ +#ifndef NOFLOAT + float epsf; + double epsd; +#endif + t=4; pct++; +#ifndef NOFLOAT + epsf = 1e-7; epsd = 1e-17; +#endif + for ( i=0; i<20 ; i++ ) a1[i] = i*i; + if ( a1[9] != 81 || a1[17] != 289 || a1[0] != 0 ) e(1); + if ( a1[1] + a1[2] + a1[3] != 14 ) e(2); + if ( ! a1[15] ) e(3); + if ( a1[8] / a1[4] != 4 ) e(4); +#ifndef NOFLOAT + for ( i=0; i<20; i++ ) a2[i] = 10.0e-1 + i/54.324e-1; + if ( fabs(a2[4]*a2[4]-a2[4]*(10.0e-1 + 4/54.324e-1 ) ) > epsf ) e(5); + if ( fabs(a2[8]/a2[8]*a2[9]/a2[9]-a2[10]+a2[10]-1.0 ) > epsf ) e(6); + if ( fabs(a2[5]-a2[4]-1/54.324e-1 ) > epsf ) e(7); + for ( i=0; i<20; i++ ) a3[i]= 10.0e-1 + i/54.324e-1; + if ( fabs(a3[4]*a3[4]-a3[4]*(1.0e0+4/54.324e-1 )) > epsd ) e(8); + if ( fabs( a3[8]*a3[9]/a3[8]/a3[9]-a3[10]+a3[10]-1000e-3) > epsd ) e(9); + if ( fabs(a3[8]+a3[6]-2*a3[7]) > epsd ) e(10); +#endif +} + +/****************************************************************/ + +test5() +/* local arrays */ +{ int b1[20]; +#ifndef NOFLOAT + float epsf, b2[20]; double b3[20],epsd; + epsf = 1e-7; epsd = 1e-17; +#endif + t = 5; pct++; + for ( i=0; i<20 ; i++ ) b1[i] = i*i; + if ( b1[9]-b1[8] != 17 ) e(1); + if ( b1[3] + b1[4] != b1[5] ) e(2); + if ( b1[1] != 1||b1[3] != 9 || b1[5] != 25 || b1[7] != 49 ) e(3); + if ( b1[12] / b1[6] != 4 ) e(4); +#ifndef NOFLOAT + for ( i=0; i<20; i += 1) b2[i] = 10.0e-1+i/54.324e-1; + if (fabs(b2[4]*b2[4]-b2[4]*(10.0e-1+4/54.324e-1)) > epsf ) e(5); + if (fabs(b2[8]/b2[8]*b2[9]/b2[9]-b2[10]+b2[10]-1.0) > epsf ) e(6); + if ( fabs(b2[5]-b2[4]-1/5.4324 ) > epsf ) e(7); + for ( i=0; i<20 ; i += 1 ) b3[i] = 10.0e-1+i/54.324e-1; + if (fabs(b3[4]*b3[4]-b3[4]*(10.0e-1+4/54.324e-1)) > epsd ) e(8); + if (fabs(b3[8]*b3[9]/b3[8]/b3[9]+b3[10]-b3[10]-1.0) > epsd ) e(9); + if (fabs(b3[10]+b3[18]-2*b3[14]) > epsd ) e(10); +#endif +} + + +/****************************************************************/ + + + +test6() +/* mixed local and global */ +{ int li,b1[20]; +#ifndef NOFLOAT + double b3[10],xxd,epsd; +#endif + t = 6; pct++; +#ifndef NOFLOAT + epsd = 1e-17; +#endif + li = 6; i = li ; + if ( i != 6 ) e(1); + i = 6; li = i; + if ( i != li ) e(2); + if ( i % li ) e(3); + i=li=i=li=i=li=i=i=i=li=j; + if ( i != li || i != j ) e(4); + for ( i=li=0; i<20 ; i=li ) { b1[li]= (li+1)*(i+1) ; li++; } + if ( b1[9] != a1[10] ) e(5); + if ( b1[7]/a1[4] != a1[2] ) e(6); + li = i = 121; + if ( b1[10] != i && a1[11]!= li ) e(7); +#ifndef NOFLOAT + for ( li=0 ; li<10; li++ ) b3[li]= 1.0e0 + li/54.324e-1; + if ( fabs(b3[9]-a3[9]) > epsd ) e(8); + if ( fabs(8/54.324e-1 - b3[9]+a3[1] ) > epsd ) e(9); +#endif +} + +/***************************************************************/ + + +test7() +/*global records */ +{ t=7; pct++; + r1.c1= 'x';r1.i=40;r1.j=50; +#ifndef NOFLOAT + r1.aaa=3.0;r1.bbb=4.0; +#endif + r2.c1=r1.c1; + r2.i= 50; + r2.j=40; +#ifndef NOFLOAT + r2.aaa=4.0;r2.bbb=5.0; +#endif + if (r1.c1 != 'x' || r1.i != 40 ) e(1); +#ifndef NOFLOAT + if ( r1.aaa != 3.0 ) e(1); +#endif + i = 25;j=75; + if (r1.i != 40 || r2.i != 50 ) e(2); + if ( r2.j != 40 || r1.j != 50 ) e(3); + if ( (r1.c1 + r2.c1)/2 != 'x' ) e(4); +#ifndef NOFLOAT + if ( r1.aaa*r1.aaa+r2.aaa*r2.aaa != r2.bbb*r2.bbb) e(5); +#endif + r1.i = 34; if ( i!=25 ) e(6); +} + + +/****************************************************************/ + + +test8() +/*local records */ +{ struct tp2 s1,s2; + t=8; pct++; + s1.c1= 'x';s1.i=40;s1.j=50; +#ifndef NOFLOAT + s1.aaa=3.0;s1.bbb=4.0; +#endif + s2.c1=s1.c1; + s2.i= 50; + s2.j=40; +#ifndef NOFLOAT + s2.aaa=4.0;s2.bbb=5.0; +#endif + if (s1.c1 != 'x' || s1.i != 40 ) e(1); +#ifndef NOFLOAT + if ( s1.aaa != 3.0 ) e(1); +#endif + i = 25;j=75; + if (s1.i != 40 || s2.i != 50 ) e(2); + if ( s2.j != 40 || s1.j != 50 ) e(3); + if ( (s1.c1 + s2.c1)/2 != 'x' ) e(4); +#ifndef NOFLOAT + if ( s1.aaa*s1.aaa+s2.aaa*s2.aaa != s2.bbb*s2.bbb) e(5); +#endif + s1.i = 34; if ( i!=25 ) e(6); +} + + + +/***********************************************************************/ +test9() +/*global pointers */ +{ t=9; pct++; + p1=alloc( sizeof *p1 ); + p2=alloc( sizeof *p2); + p3=alloc(sizeof *p3); + *p1 = 1066; + if ( *p1 != 1066 ) e(1); + p3->i = 1215; + if ( p3->i != 1215 ) e(2); + p2->val = 1566; + if ( p2->val != 1566 || p2->next ) e(3); + if ( a1 != &a1[0] ) e(4); + p1 = a1; + if ( ++p1 != &a1[1] ) e(5); + head = 0; + for (i=0;i<=100;i += 1) + { tail = alloc(sizeof *p2); + tail->val = 100+i;tail->next = head; + head = tail; + } + if ( tail->val != 200 || tail->next->val != 199 ) e(6); + if ( tail->next->next->next->next->next->val != 195) e(7); + tail->next->next->next->next->next->val = 1; + if ( tail->next->next->next->next->next->val != 1) e(8); + i = 27; + if ( *&i != 27 ) e(9); + if ( &*&*&*&i != &i ) e(10); + p1 = &i;i++; + if ( p1 != &i ) e(11); +} + +/*****************************************************************/ +test10() +/*local pointers */ +{ struct tp2 *pp3; + struct node *pp2,*ingang,*uitgang; + int *pp1; + int b1[20]; + t=10; pct++; + pp1=alloc( sizeof *pp1 ); + pp2=alloc( sizeof *p2); + pp3=alloc(sizeof *pp3); + *pp1 = 1066; + if ( *pp1 != 1066 ) e(1); + pp3->i = 1215; + if ( pp3->i != 1215 ) e(2); + pp2->val = 1566; + if ( pp2->val != 1566 || p2->next ) e(3); + if ( b1 != &b1[0] ) e(4); + pp1 = b1; + if ( ++pp1 != &b1[1] ) e(5); + ingang = 0; + for (i=0;i<=100;i += 1) + { uitgang = alloc(sizeof *pp2); + uitgang->val = 100+i;uitgang->next = ingang; + ingang = uitgang; + } + if ( uitgang->val != 200 || uitgang->next->val != 199 ) e(6); + if ( uitgang->next->next->next->next->next->val != 195 ) e(7); + uitgang->next->next->next->next->next->val = 1; + if ( uitgang->next->next->next->next->next->val != 1) e(8); +} + +/***************************************************************/ + +#ifndef NOFLOAT +test11() +/* real arithmetic */ +{ + double epsd; float epsf; + t = 11; pct++; epsf = 1e-7; epsd = 1e-16; + xf = 1.50 ; yf = 3.00 ; zf = 0.10; + xd = 1.50 ; yd = 3.00 ; zd = 0.10; + if ( fabs(1.0 + 1.0 - 2.0 ) > epsd ) e(1); + if ( fabs( 1e10-1e10 ) > epsd ) e(2); + if ( abs( 1.0e+5*1.0e+5-100e+8 ) > epsd ) e(3); + if ( fabs( 10.0/3.0*3.0/10.0-100e-2 ) > epsd ) e(4); + if ( 0.0e0 != 0 ) e(5); + if ( fabs( 32767.0 - 32767 ) > epsd ) e(6); + if ( fabs( 1.0+2+5+3.0e0+7.5e+1+140e-1-100.0 ) > epsd ) e(7); + if ( fabs(-1+(-1)+(-1.0)+(-1.0e0)+(-1.0e-0)+(-1e0)+6 ) > epsd ) e(8); + if ( fabs(5.0*yf*zf-xf) > epsf ) e(9); + if ( fabs(5.0*yd*zd-xd) > epsd ) e(10); + if ( fabs(yd*yd - (2.0*xd)*(2.0*xd) ) > epsd ) e(11); + if ( fabs(yf*yf - (2.0*xf)*(2.0*xf) ) > epsf ) e(12); + if ( fabs( yd*yd+zd*zd+2.0*yd*zd-(yd+zd)*(zd+yd) ) > epsd ) e(13); + if ( fabs( yf*yf+zf*zf+2.0*yf*zf-(yf+zf)*(zf+yf) ) > epsf ) e(14); + xf=1.10;yf=1.20; + if ( yd=yd ) e(18); + if ( yd epsd ) e(20); +} +#endif + + +/*****************************************************************/ diff --git a/lang/cem/ctest/ctest5/test1.cem.g b/lang/cem/ctest/ctest5/test1.cem.g new file mode 100644 index 00000000..0436d0e5 --- /dev/null +++ b/lang/cem/ctest/ctest5/test1.cem.g @@ -0,0 +1,3 @@ +error 13 in test 11 +program test1 +11 tests completed. Number of errors = 1 diff --git a/lang/cem/ctest/ctgen/OPS b/lang/cem/ctest/ctgen/OPS new file mode 100644 index 00000000..a9bb1b83 --- /dev/null +++ b/lang/cem/ctest/ctgen/OPS @@ -0,0 +1,143 @@ +ISTART +FN() { +teff() ; tass() ; tsta() ; tasssta() ; tiff() ; tifass() ; +return 0 ; +} +teff() { +/* simple operator test */ +/* first evaluate for side effects */ +LSTART +X + Y +X - Y +X / Y +X % Y +X * Y +X & Y +X | Y +X ^ Y +X || Y +X && Y +X << S +X >> S +-X +!X +~X +X == Y +X != Y +X <= Y +X >= Y +X < Y +X > Y +X ? X : Y +} +tass() { +LSTART +/* assignment ops */ +Z1 = X +Z1 += X +Z1 -= X +Z1 /= X +Z1 %= X +Z1 *= X +Z1 &= X +Z1 |= X +Z1 ^= X +Z1 <<= S +Z1 >>= S +Z1 ++ +Z1 -- +-- Z1 +++ Z1 +} +tsta() { +/* secondly evaluate and use the value */ +LSTART +Z2 = ( X + Y ) +Z2 = ( X - Y ) +Z2 = ( X / Y ) +Z2 = ( X % Y ) +Z2 = ( X * Y ) +Z2 = ( X & Y ) +Z2 = ( X | Y ) +Z2 = ( X ^ Y ) +Z2 = ( X || Y ) +Z2 = ( X && Y ) +Z2 = ( X << S ) +Z2 = ( X >> S ) +Z2 = ( -X ) +Z2 = ( !X ) +Z2 = ( ~X ) +Z2 = ( X == Y ) +Z2 = ( X != Y ) +Z2 = ( X <= Y ) +Z2 = ( X >= Y ) +Z2 = ( X < Y ) +Z2 = ( X > Y ) +Z2 = ( X ? X : Y ) +} +tasssta() { +/* assignment ops */ +LSTART +Z2 = ( Z1 = X ) +Z2 = ( Z1 += X ) +Z2 = ( Z1 -= X ) +Z2 = ( Z1 /= X ) +Z2 = ( Z1 %= X ) +Z2 = ( Z1 *= X ) +Z2 = ( Z1 &= X ) +Z2 = ( Z1 |= X ) +Z2 = ( Z1 ^= X ) +Z2 = ( Z1 <<= S ) +Z2 = ( Z1 >>= S ) +Z2 = ( Z1 ++ ) +Z2 = ( Z1 -- ) +Z2 = ( -- Z1 ) +Z2 = ( ++ Z1 ) +} +tiff() { +LSTART +/* conditional context */ +if ( X + Y ) yes() ; else no() +if ( X - Y ) yes() ; else no() +if ( X / Y ) yes() ; else no() +if ( X % Y ) yes() ; else no() +if ( X * Y ) yes() ; else no() +if ( X & Y ) yes() ; else no() +if ( X | Y ) yes() ; else no() +if ( X ^ Y ) yes() ; else no() +if ( X || Y ) yes() ; else no() +if ( X && Y ) yes() ; else no() +if ( X << S ) yes() ; else no() +if ( X >> S ) yes() ; else no() +if ( -X ) yes() ; else no() +if ( !X ) yes() ; else no() +if ( ~X ) yes() ; else no() +if ( X == Y ) yes() ; else no() +if ( X != Y ) yes() ; else no() +if ( X <= Y ) yes() ; else no() +if ( X >= Y ) yes() ; else no() +if ( X < Y ) yes() ; else no() +if ( X > Y ) yes() ; else no() +if ( X ? X : Y ) yes() ; else no() +} +tifass() { +LSTART +/* assignment ops */ +if ( Z1 = X ) yes() ; else no() +if ( Z1 += X ) yes() ; else no() +if ( Z1 -= X ) yes() ; else no() +if ( Z1 /= X ) yes() ; else no() +if ( Z1 %= X ) yes() ; else no() +if ( Z1 *= X ) yes() ; else no() +if ( Z1 &= X ) yes() ; else no() +if ( Z1 |= X ) yes() ; else no() +if ( Z1 ^= X ) yes() ; else no() +if ( Z1 <<= S ) yes() ; else no() +if ( Z1 >>= S ) yes() ; else no() +if ( Z1 ++ ) yes() ; else no() +if ( Z1 -- ) yes() ; else no() +if ( -- Z1 ) yes() ; else no() +if ( ++ Z1 ) yes() ; else no() +} +yes() { printf("yes ") ; } +no() { printf("no ") ; } diff --git a/lang/cem/ctest/ctgen/bf.cem.g b/lang/cem/ctest/ctgen/bf.cem.g new file mode 100644 index 00000000..122205a1 --- /dev/null +++ b/lang/cem/ctest/ctgen/bf.cem.g @@ -0,0 +1,111 @@ +bfs.bf1 + bfs.bf2 +bfs.bf1 - bfs.bf2 +bfs.bf1 / bfs.bf2 +bfs.bf1 % bfs.bf2 +bfs.bf1 * bfs.bf2 +bfs.bf1 & bfs.bf2 +bfs.bf1 | bfs.bf2 +bfs.bf1 ^ bfs.bf2 +bfs.bf1 || bfs.bf2 +bfs.bf1 && bfs.bf2 +bfs.bf1 << 1 +bfs.bf1 >> 1 +-bfs.bf1 +!bfs.bf1 +~bfs.bf1 +bfs.bf1 == bfs.bf2 +bfs.bf1 != bfs.bf2 +bfs.bf1 <= bfs.bf2 +bfs.bf1 >= bfs.bf2 +bfs.bf1 < bfs.bf2 +bfs.bf1 > bfs.bf2 +bfs.bf1 ? bfs.bf1 : bfs.bf2 +bfs.bf3 = bfs.bf1 1 +bfs.bf3 += bfs.bf1 0 +bfs.bf3 -= bfs.bf1 254 +bfs.bf3 /= bfs.bf1 255 +bfs.bf3 %= bfs.bf1 0 +bfs.bf3 *= bfs.bf1 255 +bfs.bf3 &= bfs.bf1 1 +bfs.bf3 |= bfs.bf1 255 +bfs.bf3 ^= bfs.bf1 254 +bfs.bf3 <<= 1 254 +bfs.bf3 >>= 1 127 +bfs.bf3 ++ 0 +bfs.bf3 -- 254 +-- bfs.bf3 254 +++ bfs.bf3 0 +bfs.bf4 = ( bfs.bf1 + bfs.bf2 ) 9 +bfs.bf4 = ( bfs.bf1 - bfs.bf2 ) -7 +bfs.bf4 = ( bfs.bf1 / bfs.bf2 ) 0 +bfs.bf4 = ( bfs.bf1 % bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 * bfs.bf2 ) 8 +bfs.bf4 = ( bfs.bf1 & bfs.bf2 ) 0 +bfs.bf4 = ( bfs.bf1 | bfs.bf2 ) 9 +bfs.bf4 = ( bfs.bf1 ^ bfs.bf2 ) 9 +bfs.bf4 = ( bfs.bf1 || bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 && bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 << 1 ) 2 +bfs.bf4 = ( bfs.bf1 >> 1 ) 0 +bfs.bf4 = ( -bfs.bf1 ) -1 +bfs.bf4 = ( !bfs.bf1 ) 0 +bfs.bf4 = ( ~bfs.bf1 ) -2 +bfs.bf4 = ( bfs.bf1 == bfs.bf2 ) 0 +bfs.bf4 = ( bfs.bf1 != bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 <= bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 >= bfs.bf2 ) 0 +bfs.bf4 = ( bfs.bf1 < bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf1 > bfs.bf2 ) 0 +bfs.bf4 = ( bfs.bf1 ? bfs.bf1 : bfs.bf2 ) 1 +bfs.bf4 = ( bfs.bf3 = bfs.bf1 ) 1 1 +bfs.bf4 = ( bfs.bf3 += bfs.bf1 ) 0 0 +bfs.bf4 = ( bfs.bf3 -= bfs.bf1 ) 254 254 +bfs.bf4 = ( bfs.bf3 /= bfs.bf1 ) 255 255 +bfs.bf4 = ( bfs.bf3 %= bfs.bf1 ) 0 0 +bfs.bf4 = ( bfs.bf3 *= bfs.bf1 ) 255 255 +bfs.bf4 = ( bfs.bf3 &= bfs.bf1 ) 1 1 +bfs.bf4 = ( bfs.bf3 |= bfs.bf1 ) 255 255 +bfs.bf4 = ( bfs.bf3 ^= bfs.bf1 ) 254 254 +bfs.bf4 = ( bfs.bf3 <<= 1 ) 254 254 +bfs.bf4 = ( bfs.bf3 >>= 1 ) 127 127 +bfs.bf4 = ( bfs.bf3 ++ ) 0 255 +bfs.bf4 = ( bfs.bf3 -- ) 254 255 +bfs.bf4 = ( -- bfs.bf3 ) 254 254 +bfs.bf4 = ( ++ bfs.bf3 ) 0 0 +yes if ( bfs.bf1 + bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 - bfs.bf2 ) yes() ; else no() +no if ( bfs.bf1 / bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 % bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 * bfs.bf2 ) yes() ; else no() +no if ( bfs.bf1 & bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 | bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 ^ bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 || bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 && bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 << 1 ) yes() ; else no() +no if ( bfs.bf1 >> 1 ) yes() ; else no() +yes if ( -bfs.bf1 ) yes() ; else no() +no if ( !bfs.bf1 ) yes() ; else no() +yes if ( ~bfs.bf1 ) yes() ; else no() +no if ( bfs.bf1 == bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 != bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 <= bfs.bf2 ) yes() ; else no() +no if ( bfs.bf1 >= bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 < bfs.bf2 ) yes() ; else no() +no if ( bfs.bf1 > bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf1 ? bfs.bf1 : bfs.bf2 ) yes() ; else no() +yes if ( bfs.bf3 = bfs.bf1 ) yes() ; else no() 1 +no if ( bfs.bf3 += bfs.bf1 ) yes() ; else no() 0 +yes if ( bfs.bf3 -= bfs.bf1 ) yes() ; else no() 254 +yes if ( bfs.bf3 /= bfs.bf1 ) yes() ; else no() 255 +no if ( bfs.bf3 %= bfs.bf1 ) yes() ; else no() 0 +yes if ( bfs.bf3 *= bfs.bf1 ) yes() ; else no() 255 +yes if ( bfs.bf3 &= bfs.bf1 ) yes() ; else no() 1 +yes if ( bfs.bf3 |= bfs.bf1 ) yes() ; else no() 255 +yes if ( bfs.bf3 ^= bfs.bf1 ) yes() ; else no() 254 +yes if ( bfs.bf3 <<= 1 ) yes() ; else no() 254 +yes if ( bfs.bf3 >>= 1 ) yes() ; else no() 127 +yes if ( bfs.bf3 ++ ) yes() ; else no() 0 +yes if ( bfs.bf3 -- ) yes() ; else no() 254 +yes if ( -- bfs.bf3 ) yes() ; else no() 254 +no if ( ++ bfs.bf3 ) yes() ; else no() 0 diff --git a/lang/cem/ctest/ctgen/bf.sed b/lang/cem/ctest/ctgen/bf.sed new file mode 100644 index 00000000..b0ca3526 --- /dev/null +++ b/lang/cem/ctest/ctgen/bf.sed @@ -0,0 +1,26 @@ +/ISTART/c\ +/* test bit fields */\ +struct bfs {\ + int bf1:1 ;\ + int bf2:4 ;\ + int bf3:8 ;\ + int bf4:16 ;\ +} bfs ; +s/FN/main/ +/LSTART/c\ + bfs.bf1=1 ; bfs.bf2=8 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 255 ; / +/Z2/s/^/Z2 = 3 ; / +/[XYZS]/s/^/ / +s/X/bfs.bf1/g +s/Y/bfs.bf2/g +s/S/1/g +s/Z1/bfs.bf3/g +s/Z2/bfs.bf4/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/cel.cem.g b/lang/cem/ctest/ctgen/cel.cem.g new file mode 100644 index 00000000..e0d209bd --- /dev/null +++ b/lang/cem/ctest/ctgen/cel.cem.g @@ -0,0 +1,111 @@ +40000 + 30000 +40000 - 30000 +40000 / 30000 +40000 % 30000 +40000 * 30000 +40000 & 30000 +40000 | 30000 +40000 ^ 30000 +40000 || 30000 +40000 && 30000 +40000 << 9 +40000 >> 9 +-40000 +!40000 +~40000 +40000 == 30000 +40000 != 30000 +40000 <= 30000 +40000 >= 30000 +40000 < 30000 +40000 > 30000 +40000 ? 40000 : 30000 +x = 40000 40000 +x += 40000 40010 +x -= 40000 -39990 +x /= 40000 0 +x %= 40000 10 +x *= 40000 400000 +x &= 40000 0 +x |= 40000 40010 +x ^= 40000 40010 +x <<= 9 5120 +x >>= 9 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( 40000 + 30000 ) 70000 +y = ( 40000 - 30000 ) 10000 +y = ( 40000 / 30000 ) 1 +y = ( 40000 % 30000 ) 10000 +y = ( 40000 * 30000 ) 1200000000 +y = ( 40000 & 30000 ) 5120 +y = ( 40000 | 30000 ) 64880 +y = ( 40000 ^ 30000 ) 59760 +y = ( 40000 || 30000 ) 1 +y = ( 40000 && 30000 ) 1 +y = ( 40000 << 9 ) 20480000 +y = ( 40000 >> 9 ) 78 +y = ( -40000 ) -40000 +y = ( !40000 ) 0 +y = ( ~40000 ) -40001 +y = ( 40000 == 30000 ) 0 +y = ( 40000 != 30000 ) 1 +y = ( 40000 <= 30000 ) 0 +y = ( 40000 >= 30000 ) 1 +y = ( 40000 < 30000 ) 0 +y = ( 40000 > 30000 ) 1 +y = ( 40000 ? 40000 : 30000 ) 40000 +y = ( x = 40000 ) 40000 40000 +y = ( x += 40000 ) 40010 40010 +y = ( x -= 40000 ) -39990 -39990 +y = ( x /= 40000 ) 0 0 +y = ( x %= 40000 ) 10 10 +y = ( x *= 40000 ) 400000 400000 +y = ( x &= 40000 ) 0 0 +y = ( x |= 40000 ) 40010 40010 +y = ( x ^= 40000 ) 40010 40010 +y = ( x <<= 9 ) 5120 5120 +y = ( x >>= 9 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( 40000 + 30000 ) yes() ; else no() +yes if ( 40000 - 30000 ) yes() ; else no() +yes if ( 40000 / 30000 ) yes() ; else no() +yes if ( 40000 % 30000 ) yes() ; else no() +yes if ( 40000 * 30000 ) yes() ; else no() +yes if ( 40000 & 30000 ) yes() ; else no() +yes if ( 40000 | 30000 ) yes() ; else no() +yes if ( 40000 ^ 30000 ) yes() ; else no() +yes if ( 40000 || 30000 ) yes() ; else no() +yes if ( 40000 && 30000 ) yes() ; else no() +yes if ( 40000 << 9 ) yes() ; else no() +yes if ( 40000 >> 9 ) yes() ; else no() +yes if ( -40000 ) yes() ; else no() +no if ( !40000 ) yes() ; else no() +yes if ( ~40000 ) yes() ; else no() +no if ( 40000 == 30000 ) yes() ; else no() +yes if ( 40000 != 30000 ) yes() ; else no() +no if ( 40000 <= 30000 ) yes() ; else no() +yes if ( 40000 >= 30000 ) yes() ; else no() +no if ( 40000 < 30000 ) yes() ; else no() +yes if ( 40000 > 30000 ) yes() ; else no() +yes if ( 40000 ? 40000 : 30000 ) yes() ; else no() +yes if ( x = 40000 ) yes() ; else no() 40000 +yes if ( x += 40000 ) yes() ; else no() 40010 +yes if ( x -= 40000 ) yes() ; else no() -39990 +no if ( x /= 40000 ) yes() ; else no() 0 +yes if ( x %= 40000 ) yes() ; else no() 10 +yes if ( x *= 40000 ) yes() ; else no() 400000 +no if ( x &= 40000 ) yes() ; else no() 0 +yes if ( x |= 40000 ) yes() ; else no() 40010 +yes if ( x ^= 40000 ) yes() ; else no() 40010 +yes if ( x <<= 9 ) yes() ; else no() 5120 +no if ( x >>= 9 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/cel.sed b/lang/cem/ctest/ctgen/cel.sed new file mode 100644 index 00000000..f9bc6d26 --- /dev/null +++ b/lang/cem/ctest/ctgen/cel.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/LSTART/d +s/FN/main/ +/ISTART/c\ + long x=100234 , y= -301 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %D&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %D&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/40000/g +s/Y/30000/g +s/S/9/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/clu.cem.g b/lang/cem/ctest/ctgen/clu.cem.g new file mode 100644 index 00000000..ed4e098a --- /dev/null +++ b/lang/cem/ctest/ctgen/clu.cem.g @@ -0,0 +1,111 @@ +40000 + 8012 +40000 - 8012 +40000 / 8012 +40000 % 8012 +40000 * 8012 +40000 & 8012 +40000 | 8012 +40000 ^ 8012 +40000 || 8012 +40000 && 8012 +40000 << 9 +40000 >> 9 +-40000 +!40000 +~40000 +40000 == 8012 +40000 != 8012 +40000 <= 8012 +40000 >= 8012 +40000 < 8012 +40000 > 8012 +40000 ? 40000 : 8012 +x = 40000 -25536 +x += 40000 -25526 +x -= 40000 25546 +x /= 40000 0 +x %= 40000 10 +x *= 40000 6784 +x &= 40000 0 +x |= 40000 -25526 +x ^= 40000 -25526 +x <<= 9 5120 +x >>= 9 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( 40000 + 8012 ) -17524 +y = ( 40000 - 8012 ) 31988 +y = ( 40000 / 8012 ) 4 +y = ( 40000 % 8012 ) 7952 +y = ( 40000 * 8012 ) 8960 +y = ( 40000 & 8012 ) 7232 +y = ( 40000 | 8012 ) -24756 +y = ( 40000 ^ 8012 ) -31988 +y = ( 40000 || 8012 ) 1 +y = ( 40000 && 8012 ) 1 +y = ( 40000 << 9 ) -32768 +y = ( 40000 >> 9 ) 78 +y = ( -40000 ) 25536 +y = ( !40000 ) 0 +y = ( ~40000 ) 25535 +y = ( 40000 == 8012 ) 0 +y = ( 40000 != 8012 ) 1 +y = ( 40000 <= 8012 ) 0 +y = ( 40000 >= 8012 ) 1 +y = ( 40000 < 8012 ) 0 +y = ( 40000 > 8012 ) 1 +y = ( 40000 ? 40000 : 8012 ) -25536 +y = ( x = 40000 ) -25536 -25536 +y = ( x += 40000 ) -25526 -25526 +y = ( x -= 40000 ) 25546 25546 +y = ( x /= 40000 ) 0 0 +y = ( x %= 40000 ) 10 10 +y = ( x *= 40000 ) 6784 6784 +y = ( x &= 40000 ) 0 0 +y = ( x |= 40000 ) -25526 -25526 +y = ( x ^= 40000 ) -25526 -25526 +y = ( x <<= 9 ) 5120 5120 +y = ( x >>= 9 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( 40000 + 8012 ) yes() ; else no() +yes if ( 40000 - 8012 ) yes() ; else no() +yes if ( 40000 / 8012 ) yes() ; else no() +yes if ( 40000 % 8012 ) yes() ; else no() +yes if ( 40000 * 8012 ) yes() ; else no() +yes if ( 40000 & 8012 ) yes() ; else no() +yes if ( 40000 | 8012 ) yes() ; else no() +yes if ( 40000 ^ 8012 ) yes() ; else no() +yes if ( 40000 || 8012 ) yes() ; else no() +yes if ( 40000 && 8012 ) yes() ; else no() +yes if ( 40000 << 9 ) yes() ; else no() +yes if ( 40000 >> 9 ) yes() ; else no() +yes if ( -40000 ) yes() ; else no() +no if ( !40000 ) yes() ; else no() +yes if ( ~40000 ) yes() ; else no() +no if ( 40000 == 8012 ) yes() ; else no() +yes if ( 40000 != 8012 ) yes() ; else no() +no if ( 40000 <= 8012 ) yes() ; else no() +yes if ( 40000 >= 8012 ) yes() ; else no() +no if ( 40000 < 8012 ) yes() ; else no() +yes if ( 40000 > 8012 ) yes() ; else no() +yes if ( 40000 ? 40000 : 8012 ) yes() ; else no() +yes if ( x = 40000 ) yes() ; else no() -25536 +yes if ( x += 40000 ) yes() ; else no() -25526 +yes if ( x -= 40000 ) yes() ; else no() 25546 +no if ( x /= 40000 ) yes() ; else no() 0 +yes if ( x %= 40000 ) yes() ; else no() 10 +yes if ( x *= 40000 ) yes() ; else no() 6784 +no if ( x &= 40000 ) yes() ; else no() 0 +yes if ( x |= 40000 ) yes() ; else no() -25526 +yes if ( x ^= 40000 ) yes() ; else no() -25526 +yes if ( x <<= 9 ) yes() ; else no() 5120 +no if ( x >>= 9 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/clu.sed b/lang/cem/ctest/ctgen/clu.sed new file mode 100644 index 00000000..2e6a8822 --- /dev/null +++ b/lang/cem/ctest/ctgen/clu.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/ISTART/d +s/FN/main/ +/LSTART/c\ + unsigned x=40234 , y= 301 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/40000/g +s/Y/8012/g +s/S/9/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/ec.cem.g b/lang/cem/ctest/ctgen/ec.cem.g new file mode 100644 index 00000000..8972fadd --- /dev/null +++ b/lang/cem/ctest/ctgen/ec.cem.g @@ -0,0 +1,111 @@ +'0' + '1' +'0' - '1' +'0' / '1' +'0' % '1' +'0' * '1' +'0' & '1' +'0' | '1' +'0' ^ '1' +'0' || '1' +'0' && '1' +'0' << 4 +'0' >> 4 +-'0' +!'0' +~'0' +'0' == '1' +'0' != '1' +'0' <= '1' +'0' >= '1' +'0' < '1' +'0' > '1' +'0' ? '0' : '1' +x = '0' 48 +x += '0' 58 +x -= '0' 218 +x /= '0' 0 +x %= '0' 10 +x *= '0' 224 +x &= '0' 0 +x |= '0' 58 +x ^= '0' 58 +x <<= 4 160 +x >>= 4 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( '0' + '1' ) 97 +y = ( '0' - '1' ) 255 +y = ( '0' / '1' ) 0 +y = ( '0' % '1' ) 48 +y = ( '0' * '1' ) 48 +y = ( '0' & '1' ) 48 +y = ( '0' | '1' ) 49 +y = ( '0' ^ '1' ) 1 +y = ( '0' || '1' ) 1 +y = ( '0' && '1' ) 1 +y = ( '0' << 4 ) 0 +y = ( '0' >> 4 ) 3 +y = ( -'0' ) 208 +y = ( !'0' ) 0 +y = ( ~'0' ) 207 +y = ( '0' == '1' ) 0 +y = ( '0' != '1' ) 1 +y = ( '0' <= '1' ) 1 +y = ( '0' >= '1' ) 0 +y = ( '0' < '1' ) 1 +y = ( '0' > '1' ) 0 +y = ( '0' ? '0' : '1' ) 48 +y = ( x = '0' ) 48 48 +y = ( x += '0' ) 58 58 +y = ( x -= '0' ) 218 218 +y = ( x /= '0' ) 0 0 +y = ( x %= '0' ) 10 10 +y = ( x *= '0' ) 224 224 +y = ( x &= '0' ) 0 0 +y = ( x |= '0' ) 58 58 +y = ( x ^= '0' ) 58 58 +y = ( x <<= 4 ) 160 160 +y = ( x >>= 4 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( '0' + '1' ) yes() ; else no() +yes if ( '0' - '1' ) yes() ; else no() +no if ( '0' / '1' ) yes() ; else no() +yes if ( '0' % '1' ) yes() ; else no() +yes if ( '0' * '1' ) yes() ; else no() +yes if ( '0' & '1' ) yes() ; else no() +yes if ( '0' | '1' ) yes() ; else no() +yes if ( '0' ^ '1' ) yes() ; else no() +yes if ( '0' || '1' ) yes() ; else no() +yes if ( '0' && '1' ) yes() ; else no() +yes if ( '0' << 4 ) yes() ; else no() +yes if ( '0' >> 4 ) yes() ; else no() +yes if ( -'0' ) yes() ; else no() +no if ( !'0' ) yes() ; else no() +yes if ( ~'0' ) yes() ; else no() +no if ( '0' == '1' ) yes() ; else no() +yes if ( '0' != '1' ) yes() ; else no() +yes if ( '0' <= '1' ) yes() ; else no() +no if ( '0' >= '1' ) yes() ; else no() +yes if ( '0' < '1' ) yes() ; else no() +no if ( '0' > '1' ) yes() ; else no() +yes if ( '0' ? '0' : '1' ) yes() ; else no() +yes if ( x = '0' ) yes() ; else no() 48 +yes if ( x += '0' ) yes() ; else no() 58 +yes if ( x -= '0' ) yes() ; else no() 218 +no if ( x /= '0' ) yes() ; else no() 0 +yes if ( x %= '0' ) yes() ; else no() 10 +yes if ( x *= '0' ) yes() ; else no() 224 +no if ( x &= '0' ) yes() ; else no() 0 +yes if ( x |= '0' ) yes() ; else no() 58 +yes if ( x ^= '0' ) yes() ; else no() 58 +yes if ( x <<= 4 ) yes() ; else no() 160 +no if ( x >>= 4 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/ec.sed b/lang/cem/ctest/ctgen/ec.sed new file mode 100644 index 00000000..b32beb51 --- /dev/null +++ b/lang/cem/ctest/ctgen/ec.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for local characters \ +*/ +/LSTART/d +s/FN/main/ +/ISTART/c\ + char x=10 , y= 0100 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/'0'/g +s/Y/'1'/g +s/S/4/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/ef.cem.g b/lang/cem/ctest/ctgen/ef.cem.g new file mode 100644 index 00000000..ccd8a157 --- /dev/null +++ b/lang/cem/ctest/ctgen/ef.cem.g @@ -0,0 +1,72 @@ +.4e-5 + .3e-5 +.4e-5 - .3e-5 +.4e-5 / .3e-5 +.4e-5 * .3e-5 +.4e-5 || .3e-5 +.4e-5 && .3e-5 +-.4e-5 +!.4e-5 +.4e-5 == .3e-5 +.4e-5 != .3e-5 +.4e-5 <= .3e-5 +.4e-5 >= .3e-5 +.4e-5 < .3e-5 +.4e-5 > .3e-5 +.4e-5 ? .4e-5 : .3e-5 +x = .4e-5 4.000000e-06 +x += .4e-5 3.141504e+00 +x -= .4e-5 3.141496e+00 +x /= .4e-5 7.853750e+05 +x *= .4e-5 1.256600e-05 +x ++ 4.141500e+00 +x -- 2.141500e+00 +-- x 2.141500e+00 +++ x 4.141500e+00 +y = ( .4e-5 + .3e-5 ) 7.000000e-06 +y = ( .4e-5 - .3e-5 ) 1.000000e-06 +y = ( .4e-5 / .3e-5 ) 1.333333e+00 +y = ( .4e-5 * .3e-5 ) 1.200000e-11 +y = ( .4e-5 || .3e-5 ) 1.000000e+00 +y = ( .4e-5 && .3e-5 ) 1.000000e+00 +y = ( -.4e-5 ) -4.000000e-06 +y = ( !.4e-5 ) 0.000000e+00 +y = ( .4e-5 == .3e-5 ) 0.000000e+00 +y = ( .4e-5 != .3e-5 ) 1.000000e+00 +y = ( .4e-5 <= .3e-5 ) 0.000000e+00 +y = ( .4e-5 >= .3e-5 ) 1.000000e+00 +y = ( .4e-5 < .3e-5 ) 0.000000e+00 +y = ( .4e-5 > .3e-5 ) 1.000000e+00 +y = ( .4e-5 ? .4e-5 : .3e-5 ) 4.000000e-06 +y = ( x = .4e-5 ) 4.000000e-06 4.000000e-06 +y = ( x += .4e-5 ) 3.141504e+00 3.141504e+00 +y = ( x -= .4e-5 ) 3.141496e+00 3.141496e+00 +y = ( x /= .4e-5 ) 7.853750e+05 7.853750e+05 +y = ( x *= .4e-5 ) 1.256600e-05 1.256600e-05 +y = ( x ++ ) 4.141500e+00 3.141500e+00 +y = ( x -- ) 2.141500e+00 3.141500e+00 +y = ( -- x ) 2.141500e+00 2.141500e+00 +y = ( ++ x ) 4.141500e+00 4.141500e+00 +yes if ( .4e-5 + .3e-5 ) yes() ; else no() +yes if ( .4e-5 - .3e-5 ) yes() ; else no() +yes if ( .4e-5 / .3e-5 ) yes() ; else no() +yes if ( .4e-5 * .3e-5 ) yes() ; else no() +yes if ( .4e-5 || .3e-5 ) yes() ; else no() +yes if ( .4e-5 && .3e-5 ) yes() ; else no() +yes if ( -.4e-5 ) yes() ; else no() +no if ( !.4e-5 ) yes() ; else no() +no if ( .4e-5 == .3e-5 ) yes() ; else no() +yes if ( .4e-5 != .3e-5 ) yes() ; else no() +no if ( .4e-5 <= .3e-5 ) yes() ; else no() +yes if ( .4e-5 >= .3e-5 ) yes() ; else no() +no if ( .4e-5 < .3e-5 ) yes() ; else no() +yes if ( .4e-5 > .3e-5 ) yes() ; else no() +yes if ( .4e-5 ? .4e-5 : .3e-5 ) yes() ; else no() +yes if ( x = .4e-5 ) yes() ; else no() 4.000000e-06 +yes if ( x += .4e-5 ) yes() ; else no() 3.141504e+00 +yes if ( x -= .4e-5 ) yes() ; else no() 3.141496e+00 +yes if ( x /= .4e-5 ) yes() ; else no() 7.853750e+05 +yes if ( x *= .4e-5 ) yes() ; else no() 1.256600e-05 +yes if ( x ++ ) yes() ; else no() 4.141500e+00 +yes if ( x -- ) yes() ; else no() 2.141500e+00 +yes if ( -- x ) yes() ; else no() 2.141500e+00 +yes if ( ++ x ) yes() ; else no() 4.141500e+00 diff --git a/lang/cem/ctest/ctgen/ef.sed b/lang/cem/ctest/ctgen/ef.sed new file mode 100644 index 00000000..063e44a1 --- /dev/null +++ b/lang/cem/ctest/ctgen/ef.sed @@ -0,0 +1,27 @@ +/LSTART/d +s/FN/main/ +/ISTART/c\ + float x=3.1415 , y= 1e-7 ; +/[^&]& /d +/[^|]| /d +/>>/d +/<> 15 +-4 +!4 +~4 +4 == 5 +4 != 5 +4 <= 5 +4 >= 5 +4 < 5 +4 > 5 +4 ? 4 : 5 +x = 4 4 +x += 4 259 +x -= 4 251 +x /= 4 63 +x %= 4 3 +x *= 4 1020 +x &= 4 4 +x |= 4 255 +x ^= 4 251 +x <<= 15 -32768 +x >>= 15 0 +x ++ 256 +x -- 254 +-- x 254 +++ x 256 +y = ( 4 + 5 ) 9 +y = ( 4 - 5 ) -1 +y = ( 4 / 5 ) 0 +y = ( 4 % 5 ) 4 +y = ( 4 * 5 ) 20 +y = ( 4 & 5 ) 4 +y = ( 4 | 5 ) 5 +y = ( 4 ^ 5 ) 1 +y = ( 4 || 5 ) 1 +y = ( 4 && 5 ) 1 +y = ( 4 << 15 ) 0 +y = ( 4 >> 15 ) 0 +y = ( -4 ) -4 +y = ( !4 ) 0 +y = ( ~4 ) -5 +y = ( 4 == 5 ) 0 +y = ( 4 != 5 ) 1 +y = ( 4 <= 5 ) 1 +y = ( 4 >= 5 ) 0 +y = ( 4 < 5 ) 1 +y = ( 4 > 5 ) 0 +y = ( 4 ? 4 : 5 ) 4 +y = ( x = 4 ) 4 4 +y = ( x += 4 ) 259 259 +y = ( x -= 4 ) 251 251 +y = ( x /= 4 ) 63 63 +y = ( x %= 4 ) 3 3 +y = ( x *= 4 ) 1020 1020 +y = ( x &= 4 ) 4 4 +y = ( x |= 4 ) 255 255 +y = ( x ^= 4 ) 251 251 +y = ( x <<= 15 ) -32768 -32768 +y = ( x >>= 15 ) 0 0 +y = ( x ++ ) 256 255 +y = ( x -- ) 254 255 +y = ( -- x ) 254 254 +y = ( ++ x ) 256 256 +yes if ( 4 + 5 ) yes() ; else no() +yes if ( 4 - 5 ) yes() ; else no() +no if ( 4 / 5 ) yes() ; else no() +yes if ( 4 % 5 ) yes() ; else no() +yes if ( 4 * 5 ) yes() ; else no() +yes if ( 4 & 5 ) yes() ; else no() +yes if ( 4 | 5 ) yes() ; else no() +yes if ( 4 ^ 5 ) yes() ; else no() +yes if ( 4 || 5 ) yes() ; else no() +yes if ( 4 && 5 ) yes() ; else no() +no if ( 4 << 15 ) yes() ; else no() +no if ( 4 >> 15 ) yes() ; else no() +yes if ( -4 ) yes() ; else no() +no if ( !4 ) yes() ; else no() +yes if ( ~4 ) yes() ; else no() +no if ( 4 == 5 ) yes() ; else no() +yes if ( 4 != 5 ) yes() ; else no() +yes if ( 4 <= 5 ) yes() ; else no() +no if ( 4 >= 5 ) yes() ; else no() +yes if ( 4 < 5 ) yes() ; else no() +no if ( 4 > 5 ) yes() ; else no() +yes if ( 4 ? 4 : 5 ) yes() ; else no() +yes if ( x = 4 ) yes() ; else no() 4 +yes if ( x += 4 ) yes() ; else no() 259 +yes if ( x -= 4 ) yes() ; else no() 251 +yes if ( x /= 4 ) yes() ; else no() 63 +yes if ( x %= 4 ) yes() ; else no() 3 +yes if ( x *= 4 ) yes() ; else no() 1020 +yes if ( x &= 4 ) yes() ; else no() 4 +yes if ( x |= 4 ) yes() ; else no() 255 +yes if ( x ^= 4 ) yes() ; else no() 251 +yes if ( x <<= 15 ) yes() ; else no() -32768 +no if ( x >>= 15 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 256 +yes if ( x -- ) yes() ; else no() 254 +yes if ( -- x ) yes() ; else no() 254 +yes if ( ++ x ) yes() ; else no() 256 diff --git a/lang/cem/ctest/ctgen/ei.sed b/lang/cem/ctest/ctgen/ei.sed new file mode 100644 index 00000000..2c8912e3 --- /dev/null +++ b/lang/cem/ctest/ctgen/ei.sed @@ -0,0 +1,23 @@ +1i\ +/* A sample sed script to show the use of the 'ops' file.\ + ops is converted into a test program for local integers \ +*/ +/LSTART/d +s/FN/main/ +/ISTART/c\ + int x=255 , y= -256 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 255 ; / +/Z2/s/^/Z2 = 255 ; / +/[XYZS]/s/^/ / +s/X/4/g +s/Y/5/g +s/S/15/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/el.cem.g b/lang/cem/ctest/ctgen/el.cem.g new file mode 100644 index 00000000..ef8422ef --- /dev/null +++ b/lang/cem/ctest/ctgen/el.cem.g @@ -0,0 +1,111 @@ +x + 16329 +x - 16329 +x / 16329 +x % 16329 +x * 16329 +x & 16329 +x | 16329 +x ^ 16329 +x || 16329 +x && 16329 +x << 9 +x >> 9 +-x +!x +~x +x == 16329 +x != 16329 +x <= 16329 +x >= 16329 +x < 16329 +x > 16329 +x ? x : 16329 +z = x 100234 +z += x 100244 +z -= x -100224 +z /= x 0 +z %= x 10 +z *= x 1002340 +z &= x 10 +z |= x 100234 +z ^= x 100224 +z <<= 9 5120 +z >>= 9 0 +z ++ 11 +z -- 9 +-- z 9 +++ z 11 +y = ( x + 16329 ) 116563 +y = ( x - 16329 ) 83905 +y = ( x / 16329 ) 6 +y = ( x % 16329 ) 2260 +y = ( x * 16329 ) 1636720986 +y = ( x & 16329 ) 1928 +y = ( x | 16329 ) 114635 +y = ( x ^ 16329 ) 112707 +y = ( x || 16329 ) 1 +y = ( x && 16329 ) 1 +y = ( x << 9 ) 51319808 +y = ( x >> 9 ) 195 +y = ( -x ) -100234 +y = ( !x ) 0 +y = ( ~x ) -100235 +y = ( x == 16329 ) 0 +y = ( x != 16329 ) 1 +y = ( x <= 16329 ) 0 +y = ( x >= 16329 ) 1 +y = ( x < 16329 ) 0 +y = ( x > 16329 ) 1 +y = ( x ? x : 16329 ) 100234 +y = ( z = x ) 100234 100234 +y = ( z += x ) 100244 100244 +y = ( z -= x ) -100224 -100224 +y = ( z /= x ) 0 0 +y = ( z %= x ) 10 10 +y = ( z *= x ) 1002340 1002340 +y = ( z &= x ) 10 10 +y = ( z |= x ) 100234 100234 +y = ( z ^= x ) 100224 100224 +y = ( z <<= 9 ) 5120 5120 +y = ( z >>= 9 ) 0 0 +y = ( z ++ ) 11 10 +y = ( z -- ) 9 10 +y = ( -- z ) 9 9 +y = ( ++ z ) 11 11 +yes if ( x + 16329 ) yes() ; else no() +yes if ( x - 16329 ) yes() ; else no() +yes if ( x / 16329 ) yes() ; else no() +yes if ( x % 16329 ) yes() ; else no() +yes if ( x * 16329 ) yes() ; else no() +yes if ( x & 16329 ) yes() ; else no() +yes if ( x | 16329 ) yes() ; else no() +yes if ( x ^ 16329 ) yes() ; else no() +yes if ( x || 16329 ) yes() ; else no() +yes if ( x && 16329 ) yes() ; else no() +yes if ( x << 9 ) yes() ; else no() +yes if ( x >> 9 ) yes() ; else no() +yes if ( -x ) yes() ; else no() +no if ( !x ) yes() ; else no() +yes if ( ~x ) yes() ; else no() +no if ( x == 16329 ) yes() ; else no() +yes if ( x != 16329 ) yes() ; else no() +no if ( x <= 16329 ) yes() ; else no() +yes if ( x >= 16329 ) yes() ; else no() +no if ( x < 16329 ) yes() ; else no() +yes if ( x > 16329 ) yes() ; else no() +yes if ( x ? x : 16329 ) yes() ; else no() +yes if ( z = x ) yes() ; else no() 100234 +yes if ( z += x ) yes() ; else no() 100244 +yes if ( z -= x ) yes() ; else no() -100224 +no if ( z /= x ) yes() ; else no() 0 +yes if ( z %= x ) yes() ; else no() 10 +yes if ( z *= x ) yes() ; else no() 1002340 +yes if ( z &= x ) yes() ; else no() 10 +yes if ( z |= x ) yes() ; else no() 100234 +yes if ( z ^= x ) yes() ; else no() 100224 +yes if ( z <<= 9 ) yes() ; else no() 5120 +no if ( z >>= 9 ) yes() ; else no() 0 +yes if ( z ++ ) yes() ; else no() 11 +yes if ( z -- ) yes() ; else no() 9 +yes if ( -- z ) yes() ; else no() 9 +yes if ( ++ z ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/el.sed b/lang/cem/ctest/ctgen/el.sed new file mode 100644 index 00000000..5faf4554 --- /dev/null +++ b/lang/cem/ctest/ctgen/el.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/LSTART/d +s/FN/main/ +/ISTART/c\ + long x=100234 , y= -301 , z= 0 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %D&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %D&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/x/g +s/Y/16329/g +s/S/9/g +s/Z1/z/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/eu.cem.g b/lang/cem/ctest/ctgen/eu.cem.g new file mode 100644 index 00000000..ed4e098a --- /dev/null +++ b/lang/cem/ctest/ctgen/eu.cem.g @@ -0,0 +1,111 @@ +40000 + 8012 +40000 - 8012 +40000 / 8012 +40000 % 8012 +40000 * 8012 +40000 & 8012 +40000 | 8012 +40000 ^ 8012 +40000 || 8012 +40000 && 8012 +40000 << 9 +40000 >> 9 +-40000 +!40000 +~40000 +40000 == 8012 +40000 != 8012 +40000 <= 8012 +40000 >= 8012 +40000 < 8012 +40000 > 8012 +40000 ? 40000 : 8012 +x = 40000 -25536 +x += 40000 -25526 +x -= 40000 25546 +x /= 40000 0 +x %= 40000 10 +x *= 40000 6784 +x &= 40000 0 +x |= 40000 -25526 +x ^= 40000 -25526 +x <<= 9 5120 +x >>= 9 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( 40000 + 8012 ) -17524 +y = ( 40000 - 8012 ) 31988 +y = ( 40000 / 8012 ) 4 +y = ( 40000 % 8012 ) 7952 +y = ( 40000 * 8012 ) 8960 +y = ( 40000 & 8012 ) 7232 +y = ( 40000 | 8012 ) -24756 +y = ( 40000 ^ 8012 ) -31988 +y = ( 40000 || 8012 ) 1 +y = ( 40000 && 8012 ) 1 +y = ( 40000 << 9 ) -32768 +y = ( 40000 >> 9 ) 78 +y = ( -40000 ) 25536 +y = ( !40000 ) 0 +y = ( ~40000 ) 25535 +y = ( 40000 == 8012 ) 0 +y = ( 40000 != 8012 ) 1 +y = ( 40000 <= 8012 ) 0 +y = ( 40000 >= 8012 ) 1 +y = ( 40000 < 8012 ) 0 +y = ( 40000 > 8012 ) 1 +y = ( 40000 ? 40000 : 8012 ) -25536 +y = ( x = 40000 ) -25536 -25536 +y = ( x += 40000 ) -25526 -25526 +y = ( x -= 40000 ) 25546 25546 +y = ( x /= 40000 ) 0 0 +y = ( x %= 40000 ) 10 10 +y = ( x *= 40000 ) 6784 6784 +y = ( x &= 40000 ) 0 0 +y = ( x |= 40000 ) -25526 -25526 +y = ( x ^= 40000 ) -25526 -25526 +y = ( x <<= 9 ) 5120 5120 +y = ( x >>= 9 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( 40000 + 8012 ) yes() ; else no() +yes if ( 40000 - 8012 ) yes() ; else no() +yes if ( 40000 / 8012 ) yes() ; else no() +yes if ( 40000 % 8012 ) yes() ; else no() +yes if ( 40000 * 8012 ) yes() ; else no() +yes if ( 40000 & 8012 ) yes() ; else no() +yes if ( 40000 | 8012 ) yes() ; else no() +yes if ( 40000 ^ 8012 ) yes() ; else no() +yes if ( 40000 || 8012 ) yes() ; else no() +yes if ( 40000 && 8012 ) yes() ; else no() +yes if ( 40000 << 9 ) yes() ; else no() +yes if ( 40000 >> 9 ) yes() ; else no() +yes if ( -40000 ) yes() ; else no() +no if ( !40000 ) yes() ; else no() +yes if ( ~40000 ) yes() ; else no() +no if ( 40000 == 8012 ) yes() ; else no() +yes if ( 40000 != 8012 ) yes() ; else no() +no if ( 40000 <= 8012 ) yes() ; else no() +yes if ( 40000 >= 8012 ) yes() ; else no() +no if ( 40000 < 8012 ) yes() ; else no() +yes if ( 40000 > 8012 ) yes() ; else no() +yes if ( 40000 ? 40000 : 8012 ) yes() ; else no() +yes if ( x = 40000 ) yes() ; else no() -25536 +yes if ( x += 40000 ) yes() ; else no() -25526 +yes if ( x -= 40000 ) yes() ; else no() 25546 +no if ( x /= 40000 ) yes() ; else no() 0 +yes if ( x %= 40000 ) yes() ; else no() 10 +yes if ( x *= 40000 ) yes() ; else no() 6784 +no if ( x &= 40000 ) yes() ; else no() 0 +yes if ( x |= 40000 ) yes() ; else no() -25526 +yes if ( x ^= 40000 ) yes() ; else no() -25526 +yes if ( x <<= 9 ) yes() ; else no() 5120 +no if ( x >>= 9 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/eu.sed b/lang/cem/ctest/ctgen/eu.sed new file mode 100644 index 00000000..2c13a340 --- /dev/null +++ b/lang/cem/ctest/ctgen/eu.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/LSTART/d +s/FN/main/ +/ISTART/c\ + unsigned x=40234 , y= 301 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/40000/g +s/Y/8012/g +s/S/9/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/lc.cem.g b/lang/cem/ctest/ctgen/lc.cem.g new file mode 100644 index 00000000..8972fadd --- /dev/null +++ b/lang/cem/ctest/ctgen/lc.cem.g @@ -0,0 +1,111 @@ +'0' + '1' +'0' - '1' +'0' / '1' +'0' % '1' +'0' * '1' +'0' & '1' +'0' | '1' +'0' ^ '1' +'0' || '1' +'0' && '1' +'0' << 4 +'0' >> 4 +-'0' +!'0' +~'0' +'0' == '1' +'0' != '1' +'0' <= '1' +'0' >= '1' +'0' < '1' +'0' > '1' +'0' ? '0' : '1' +x = '0' 48 +x += '0' 58 +x -= '0' 218 +x /= '0' 0 +x %= '0' 10 +x *= '0' 224 +x &= '0' 0 +x |= '0' 58 +x ^= '0' 58 +x <<= 4 160 +x >>= 4 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( '0' + '1' ) 97 +y = ( '0' - '1' ) 255 +y = ( '0' / '1' ) 0 +y = ( '0' % '1' ) 48 +y = ( '0' * '1' ) 48 +y = ( '0' & '1' ) 48 +y = ( '0' | '1' ) 49 +y = ( '0' ^ '1' ) 1 +y = ( '0' || '1' ) 1 +y = ( '0' && '1' ) 1 +y = ( '0' << 4 ) 0 +y = ( '0' >> 4 ) 3 +y = ( -'0' ) 208 +y = ( !'0' ) 0 +y = ( ~'0' ) 207 +y = ( '0' == '1' ) 0 +y = ( '0' != '1' ) 1 +y = ( '0' <= '1' ) 1 +y = ( '0' >= '1' ) 0 +y = ( '0' < '1' ) 1 +y = ( '0' > '1' ) 0 +y = ( '0' ? '0' : '1' ) 48 +y = ( x = '0' ) 48 48 +y = ( x += '0' ) 58 58 +y = ( x -= '0' ) 218 218 +y = ( x /= '0' ) 0 0 +y = ( x %= '0' ) 10 10 +y = ( x *= '0' ) 224 224 +y = ( x &= '0' ) 0 0 +y = ( x |= '0' ) 58 58 +y = ( x ^= '0' ) 58 58 +y = ( x <<= 4 ) 160 160 +y = ( x >>= 4 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( '0' + '1' ) yes() ; else no() +yes if ( '0' - '1' ) yes() ; else no() +no if ( '0' / '1' ) yes() ; else no() +yes if ( '0' % '1' ) yes() ; else no() +yes if ( '0' * '1' ) yes() ; else no() +yes if ( '0' & '1' ) yes() ; else no() +yes if ( '0' | '1' ) yes() ; else no() +yes if ( '0' ^ '1' ) yes() ; else no() +yes if ( '0' || '1' ) yes() ; else no() +yes if ( '0' && '1' ) yes() ; else no() +yes if ( '0' << 4 ) yes() ; else no() +yes if ( '0' >> 4 ) yes() ; else no() +yes if ( -'0' ) yes() ; else no() +no if ( !'0' ) yes() ; else no() +yes if ( ~'0' ) yes() ; else no() +no if ( '0' == '1' ) yes() ; else no() +yes if ( '0' != '1' ) yes() ; else no() +yes if ( '0' <= '1' ) yes() ; else no() +no if ( '0' >= '1' ) yes() ; else no() +yes if ( '0' < '1' ) yes() ; else no() +no if ( '0' > '1' ) yes() ; else no() +yes if ( '0' ? '0' : '1' ) yes() ; else no() +yes if ( x = '0' ) yes() ; else no() 48 +yes if ( x += '0' ) yes() ; else no() 58 +yes if ( x -= '0' ) yes() ; else no() 218 +no if ( x /= '0' ) yes() ; else no() 0 +yes if ( x %= '0' ) yes() ; else no() 10 +yes if ( x *= '0' ) yes() ; else no() 224 +no if ( x &= '0' ) yes() ; else no() 0 +yes if ( x |= '0' ) yes() ; else no() 58 +yes if ( x ^= '0' ) yes() ; else no() 58 +yes if ( x <<= 4 ) yes() ; else no() 160 +no if ( x >>= 4 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/lc.sed b/lang/cem/ctest/ctgen/lc.sed new file mode 100644 index 00000000..6948dd67 --- /dev/null +++ b/lang/cem/ctest/ctgen/lc.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for local characters \ +*/ +/ISTART/d +s/FN/main/ +/LSTART/c\ + char x=10 , y= 0100 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/'0'/g +s/Y/'1'/g +s/S/4/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/ld.cem.g b/lang/cem/ctest/ctgen/ld.cem.g new file mode 100644 index 00000000..ccd8a157 --- /dev/null +++ b/lang/cem/ctest/ctgen/ld.cem.g @@ -0,0 +1,72 @@ +.4e-5 + .3e-5 +.4e-5 - .3e-5 +.4e-5 / .3e-5 +.4e-5 * .3e-5 +.4e-5 || .3e-5 +.4e-5 && .3e-5 +-.4e-5 +!.4e-5 +.4e-5 == .3e-5 +.4e-5 != .3e-5 +.4e-5 <= .3e-5 +.4e-5 >= .3e-5 +.4e-5 < .3e-5 +.4e-5 > .3e-5 +.4e-5 ? .4e-5 : .3e-5 +x = .4e-5 4.000000e-06 +x += .4e-5 3.141504e+00 +x -= .4e-5 3.141496e+00 +x /= .4e-5 7.853750e+05 +x *= .4e-5 1.256600e-05 +x ++ 4.141500e+00 +x -- 2.141500e+00 +-- x 2.141500e+00 +++ x 4.141500e+00 +y = ( .4e-5 + .3e-5 ) 7.000000e-06 +y = ( .4e-5 - .3e-5 ) 1.000000e-06 +y = ( .4e-5 / .3e-5 ) 1.333333e+00 +y = ( .4e-5 * .3e-5 ) 1.200000e-11 +y = ( .4e-5 || .3e-5 ) 1.000000e+00 +y = ( .4e-5 && .3e-5 ) 1.000000e+00 +y = ( -.4e-5 ) -4.000000e-06 +y = ( !.4e-5 ) 0.000000e+00 +y = ( .4e-5 == .3e-5 ) 0.000000e+00 +y = ( .4e-5 != .3e-5 ) 1.000000e+00 +y = ( .4e-5 <= .3e-5 ) 0.000000e+00 +y = ( .4e-5 >= .3e-5 ) 1.000000e+00 +y = ( .4e-5 < .3e-5 ) 0.000000e+00 +y = ( .4e-5 > .3e-5 ) 1.000000e+00 +y = ( .4e-5 ? .4e-5 : .3e-5 ) 4.000000e-06 +y = ( x = .4e-5 ) 4.000000e-06 4.000000e-06 +y = ( x += .4e-5 ) 3.141504e+00 3.141504e+00 +y = ( x -= .4e-5 ) 3.141496e+00 3.141496e+00 +y = ( x /= .4e-5 ) 7.853750e+05 7.853750e+05 +y = ( x *= .4e-5 ) 1.256600e-05 1.256600e-05 +y = ( x ++ ) 4.141500e+00 3.141500e+00 +y = ( x -- ) 2.141500e+00 3.141500e+00 +y = ( -- x ) 2.141500e+00 2.141500e+00 +y = ( ++ x ) 4.141500e+00 4.141500e+00 +yes if ( .4e-5 + .3e-5 ) yes() ; else no() +yes if ( .4e-5 - .3e-5 ) yes() ; else no() +yes if ( .4e-5 / .3e-5 ) yes() ; else no() +yes if ( .4e-5 * .3e-5 ) yes() ; else no() +yes if ( .4e-5 || .3e-5 ) yes() ; else no() +yes if ( .4e-5 && .3e-5 ) yes() ; else no() +yes if ( -.4e-5 ) yes() ; else no() +no if ( !.4e-5 ) yes() ; else no() +no if ( .4e-5 == .3e-5 ) yes() ; else no() +yes if ( .4e-5 != .3e-5 ) yes() ; else no() +no if ( .4e-5 <= .3e-5 ) yes() ; else no() +yes if ( .4e-5 >= .3e-5 ) yes() ; else no() +no if ( .4e-5 < .3e-5 ) yes() ; else no() +yes if ( .4e-5 > .3e-5 ) yes() ; else no() +yes if ( .4e-5 ? .4e-5 : .3e-5 ) yes() ; else no() +yes if ( x = .4e-5 ) yes() ; else no() 4.000000e-06 +yes if ( x += .4e-5 ) yes() ; else no() 3.141504e+00 +yes if ( x -= .4e-5 ) yes() ; else no() 3.141496e+00 +yes if ( x /= .4e-5 ) yes() ; else no() 7.853750e+05 +yes if ( x *= .4e-5 ) yes() ; else no() 1.256600e-05 +yes if ( x ++ ) yes() ; else no() 4.141500e+00 +yes if ( x -- ) yes() ; else no() 2.141500e+00 +yes if ( -- x ) yes() ; else no() 2.141500e+00 +yes if ( ++ x ) yes() ; else no() 4.141500e+00 diff --git a/lang/cem/ctest/ctgen/ld.sed b/lang/cem/ctest/ctgen/ld.sed new file mode 100644 index 00000000..28cc4bb1 --- /dev/null +++ b/lang/cem/ctest/ctgen/ld.sed @@ -0,0 +1,27 @@ +/LSTART/d +s/FN/main/ +/ISTART/c\ + double x=3.1415 , y= 1e-7 ; +/[^&]& /d +/[^|]| /d +/>>/d +/<= .3e-5 +.4e-5 < .3e-5 +.4e-5 > .3e-5 +.4e-5 ? .4e-5 : .3e-5 +x = .4e-5 4.000000e-06 +x += .4e-5 3.141504e+00 +x -= .4e-5 3.141496e+00 +x /= .4e-5 7.853750e+05 +x *= .4e-5 1.256600e-05 +x ++ 4.141500e+00 +x -- 2.141500e+00 +-- x 2.141500e+00 +++ x 4.141500e+00 +y = ( .4e-5 + .3e-5 ) 7.000000e-06 +y = ( .4e-5 - .3e-5 ) 1.000000e-06 +y = ( .4e-5 / .3e-5 ) 1.333333e+00 +y = ( .4e-5 * .3e-5 ) 1.200000e-11 +y = ( .4e-5 || .3e-5 ) 1.000000e+00 +y = ( .4e-5 && .3e-5 ) 1.000000e+00 +y = ( -.4e-5 ) -4.000000e-06 +y = ( !.4e-5 ) 0.000000e+00 +y = ( .4e-5 == .3e-5 ) 0.000000e+00 +y = ( .4e-5 != .3e-5 ) 1.000000e+00 +y = ( .4e-5 <= .3e-5 ) 0.000000e+00 +y = ( .4e-5 >= .3e-5 ) 1.000000e+00 +y = ( .4e-5 < .3e-5 ) 0.000000e+00 +y = ( .4e-5 > .3e-5 ) 1.000000e+00 +y = ( .4e-5 ? .4e-5 : .3e-5 ) 4.000000e-06 +y = ( x = .4e-5 ) 4.000000e-06 4.000000e-06 +y = ( x += .4e-5 ) 3.141504e+00 3.141504e+00 +y = ( x -= .4e-5 ) 3.141496e+00 3.141496e+00 +y = ( x /= .4e-5 ) 7.853750e+05 7.853750e+05 +y = ( x *= .4e-5 ) 1.256600e-05 1.256600e-05 +y = ( x ++ ) 4.141500e+00 3.141500e+00 +y = ( x -- ) 2.141500e+00 3.141500e+00 +y = ( -- x ) 2.141500e+00 2.141500e+00 +y = ( ++ x ) 4.141500e+00 4.141500e+00 +yes if ( .4e-5 + .3e-5 ) yes() ; else no() +yes if ( .4e-5 - .3e-5 ) yes() ; else no() +yes if ( .4e-5 / .3e-5 ) yes() ; else no() +yes if ( .4e-5 * .3e-5 ) yes() ; else no() +yes if ( .4e-5 || .3e-5 ) yes() ; else no() +yes if ( .4e-5 && .3e-5 ) yes() ; else no() +yes if ( -.4e-5 ) yes() ; else no() +no if ( !.4e-5 ) yes() ; else no() +no if ( .4e-5 == .3e-5 ) yes() ; else no() +yes if ( .4e-5 != .3e-5 ) yes() ; else no() +no if ( .4e-5 <= .3e-5 ) yes() ; else no() +yes if ( .4e-5 >= .3e-5 ) yes() ; else no() +no if ( .4e-5 < .3e-5 ) yes() ; else no() +yes if ( .4e-5 > .3e-5 ) yes() ; else no() +yes if ( .4e-5 ? .4e-5 : .3e-5 ) yes() ; else no() +yes if ( x = .4e-5 ) yes() ; else no() 4.000000e-06 +yes if ( x += .4e-5 ) yes() ; else no() 3.141504e+00 +yes if ( x -= .4e-5 ) yes() ; else no() 3.141496e+00 +yes if ( x /= .4e-5 ) yes() ; else no() 7.853750e+05 +yes if ( x *= .4e-5 ) yes() ; else no() 1.256600e-05 +yes if ( x ++ ) yes() ; else no() 4.141500e+00 +yes if ( x -- ) yes() ; else no() 2.141500e+00 +yes if ( -- x ) yes() ; else no() 2.141500e+00 +yes if ( ++ x ) yes() ; else no() 4.141500e+00 diff --git a/lang/cem/ctest/ctgen/lf.sed b/lang/cem/ctest/ctgen/lf.sed new file mode 100644 index 00000000..5e2be188 --- /dev/null +++ b/lang/cem/ctest/ctgen/lf.sed @@ -0,0 +1,27 @@ +/ISTART/d +s/FN/main/ +/LSTART/c\ + float x=3.1415 , y= 1e-7 ; +/[^&]& /d +/[^|]| /d +/>>/d +/<> 15 +-4 +!4 +~4 +4 == 5 +4 != 5 +4 <= 5 +4 >= 5 +4 < 5 +4 > 5 +4 ? 4 : 5 +x = 4 4 +x += 4 259 +x -= 4 251 +x /= 4 63 +x %= 4 3 +x *= 4 1020 +x &= 4 4 +x |= 4 255 +x ^= 4 251 +x <<= 15 -32768 +x >>= 15 0 +x ++ 256 +x -- 254 +-- x 254 +++ x 256 +y = ( 4 + 5 ) 9 +y = ( 4 - 5 ) -1 +y = ( 4 / 5 ) 0 +y = ( 4 % 5 ) 4 +y = ( 4 * 5 ) 20 +y = ( 4 & 5 ) 4 +y = ( 4 | 5 ) 5 +y = ( 4 ^ 5 ) 1 +y = ( 4 || 5 ) 1 +y = ( 4 && 5 ) 1 +y = ( 4 << 15 ) 0 +y = ( 4 >> 15 ) 0 +y = ( -4 ) -4 +y = ( !4 ) 0 +y = ( ~4 ) -5 +y = ( 4 == 5 ) 0 +y = ( 4 != 5 ) 1 +y = ( 4 <= 5 ) 1 +y = ( 4 >= 5 ) 0 +y = ( 4 < 5 ) 1 +y = ( 4 > 5 ) 0 +y = ( 4 ? 4 : 5 ) 4 +y = ( x = 4 ) 4 4 +y = ( x += 4 ) 259 259 +y = ( x -= 4 ) 251 251 +y = ( x /= 4 ) 63 63 +y = ( x %= 4 ) 3 3 +y = ( x *= 4 ) 1020 1020 +y = ( x &= 4 ) 4 4 +y = ( x |= 4 ) 255 255 +y = ( x ^= 4 ) 251 251 +y = ( x <<= 15 ) -32768 -32768 +y = ( x >>= 15 ) 0 0 +y = ( x ++ ) 256 255 +y = ( x -- ) 254 255 +y = ( -- x ) 254 254 +y = ( ++ x ) 256 256 +yes if ( 4 + 5 ) yes() ; else no() +yes if ( 4 - 5 ) yes() ; else no() +no if ( 4 / 5 ) yes() ; else no() +yes if ( 4 % 5 ) yes() ; else no() +yes if ( 4 * 5 ) yes() ; else no() +yes if ( 4 & 5 ) yes() ; else no() +yes if ( 4 | 5 ) yes() ; else no() +yes if ( 4 ^ 5 ) yes() ; else no() +yes if ( 4 || 5 ) yes() ; else no() +yes if ( 4 && 5 ) yes() ; else no() +no if ( 4 << 15 ) yes() ; else no() +no if ( 4 >> 15 ) yes() ; else no() +yes if ( -4 ) yes() ; else no() +no if ( !4 ) yes() ; else no() +yes if ( ~4 ) yes() ; else no() +no if ( 4 == 5 ) yes() ; else no() +yes if ( 4 != 5 ) yes() ; else no() +yes if ( 4 <= 5 ) yes() ; else no() +no if ( 4 >= 5 ) yes() ; else no() +yes if ( 4 < 5 ) yes() ; else no() +no if ( 4 > 5 ) yes() ; else no() +yes if ( 4 ? 4 : 5 ) yes() ; else no() +yes if ( x = 4 ) yes() ; else no() 4 +yes if ( x += 4 ) yes() ; else no() 259 +yes if ( x -= 4 ) yes() ; else no() 251 +yes if ( x /= 4 ) yes() ; else no() 63 +yes if ( x %= 4 ) yes() ; else no() 3 +yes if ( x *= 4 ) yes() ; else no() 1020 +yes if ( x &= 4 ) yes() ; else no() 4 +yes if ( x |= 4 ) yes() ; else no() 255 +yes if ( x ^= 4 ) yes() ; else no() 251 +yes if ( x <<= 15 ) yes() ; else no() -32768 +no if ( x >>= 15 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 256 +yes if ( x -- ) yes() ; else no() 254 +yes if ( -- x ) yes() ; else no() 254 +yes if ( ++ x ) yes() ; else no() 256 diff --git a/lang/cem/ctest/ctgen/li.sed b/lang/cem/ctest/ctgen/li.sed new file mode 100644 index 00000000..cef6cbb2 --- /dev/null +++ b/lang/cem/ctest/ctgen/li.sed @@ -0,0 +1,23 @@ +1i\ +/* A sample sed script to show the use of the 'ops' file.\ + ops is converted into a test program for local integers \ +*/ +/ISTART/d +s/FN/main/ +/LSTART/c\ + int x=255 , y= -256 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 255 ; / +/Z2/s/^/Z2 = 255 ; / +/[XYZS]/s/^/ / +s/X/4/g +s/Y/5/g +s/S/15/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/ll.cem.g b/lang/cem/ctest/ctgen/ll.cem.g new file mode 100644 index 00000000..e0d209bd --- /dev/null +++ b/lang/cem/ctest/ctgen/ll.cem.g @@ -0,0 +1,111 @@ +40000 + 30000 +40000 - 30000 +40000 / 30000 +40000 % 30000 +40000 * 30000 +40000 & 30000 +40000 | 30000 +40000 ^ 30000 +40000 || 30000 +40000 && 30000 +40000 << 9 +40000 >> 9 +-40000 +!40000 +~40000 +40000 == 30000 +40000 != 30000 +40000 <= 30000 +40000 >= 30000 +40000 < 30000 +40000 > 30000 +40000 ? 40000 : 30000 +x = 40000 40000 +x += 40000 40010 +x -= 40000 -39990 +x /= 40000 0 +x %= 40000 10 +x *= 40000 400000 +x &= 40000 0 +x |= 40000 40010 +x ^= 40000 40010 +x <<= 9 5120 +x >>= 9 0 +x ++ 11 +x -- 9 +-- x 9 +++ x 11 +y = ( 40000 + 30000 ) 70000 +y = ( 40000 - 30000 ) 10000 +y = ( 40000 / 30000 ) 1 +y = ( 40000 % 30000 ) 10000 +y = ( 40000 * 30000 ) 1200000000 +y = ( 40000 & 30000 ) 5120 +y = ( 40000 | 30000 ) 64880 +y = ( 40000 ^ 30000 ) 59760 +y = ( 40000 || 30000 ) 1 +y = ( 40000 && 30000 ) 1 +y = ( 40000 << 9 ) 20480000 +y = ( 40000 >> 9 ) 78 +y = ( -40000 ) -40000 +y = ( !40000 ) 0 +y = ( ~40000 ) -40001 +y = ( 40000 == 30000 ) 0 +y = ( 40000 != 30000 ) 1 +y = ( 40000 <= 30000 ) 0 +y = ( 40000 >= 30000 ) 1 +y = ( 40000 < 30000 ) 0 +y = ( 40000 > 30000 ) 1 +y = ( 40000 ? 40000 : 30000 ) 40000 +y = ( x = 40000 ) 40000 40000 +y = ( x += 40000 ) 40010 40010 +y = ( x -= 40000 ) -39990 -39990 +y = ( x /= 40000 ) 0 0 +y = ( x %= 40000 ) 10 10 +y = ( x *= 40000 ) 400000 400000 +y = ( x &= 40000 ) 0 0 +y = ( x |= 40000 ) 40010 40010 +y = ( x ^= 40000 ) 40010 40010 +y = ( x <<= 9 ) 5120 5120 +y = ( x >>= 9 ) 0 0 +y = ( x ++ ) 11 10 +y = ( x -- ) 9 10 +y = ( -- x ) 9 9 +y = ( ++ x ) 11 11 +yes if ( 40000 + 30000 ) yes() ; else no() +yes if ( 40000 - 30000 ) yes() ; else no() +yes if ( 40000 / 30000 ) yes() ; else no() +yes if ( 40000 % 30000 ) yes() ; else no() +yes if ( 40000 * 30000 ) yes() ; else no() +yes if ( 40000 & 30000 ) yes() ; else no() +yes if ( 40000 | 30000 ) yes() ; else no() +yes if ( 40000 ^ 30000 ) yes() ; else no() +yes if ( 40000 || 30000 ) yes() ; else no() +yes if ( 40000 && 30000 ) yes() ; else no() +yes if ( 40000 << 9 ) yes() ; else no() +yes if ( 40000 >> 9 ) yes() ; else no() +yes if ( -40000 ) yes() ; else no() +no if ( !40000 ) yes() ; else no() +yes if ( ~40000 ) yes() ; else no() +no if ( 40000 == 30000 ) yes() ; else no() +yes if ( 40000 != 30000 ) yes() ; else no() +no if ( 40000 <= 30000 ) yes() ; else no() +yes if ( 40000 >= 30000 ) yes() ; else no() +no if ( 40000 < 30000 ) yes() ; else no() +yes if ( 40000 > 30000 ) yes() ; else no() +yes if ( 40000 ? 40000 : 30000 ) yes() ; else no() +yes if ( x = 40000 ) yes() ; else no() 40000 +yes if ( x += 40000 ) yes() ; else no() 40010 +yes if ( x -= 40000 ) yes() ; else no() -39990 +no if ( x /= 40000 ) yes() ; else no() 0 +yes if ( x %= 40000 ) yes() ; else no() 10 +yes if ( x *= 40000 ) yes() ; else no() 400000 +no if ( x &= 40000 ) yes() ; else no() 0 +yes if ( x |= 40000 ) yes() ; else no() 40010 +yes if ( x ^= 40000 ) yes() ; else no() 40010 +yes if ( x <<= 9 ) yes() ; else no() 5120 +no if ( x >>= 9 ) yes() ; else no() 0 +yes if ( x ++ ) yes() ; else no() 11 +yes if ( x -- ) yes() ; else no() 9 +yes if ( -- x ) yes() ; else no() 9 +yes if ( ++ x ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/ll.sed b/lang/cem/ctest/ctgen/ll.sed new file mode 100644 index 00000000..a20778fc --- /dev/null +++ b/lang/cem/ctest/ctgen/ll.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/ISTART/d +s/FN/main/ +/LSTART/c\ + long x=100234 , y= -301 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %D&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %D&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/40000/g +s/Y/30000/g +s/S/9/g +s/Z1/x/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/lu.cem.g b/lang/cem/ctest/ctgen/lu.cem.g new file mode 100644 index 00000000..7dd221ea --- /dev/null +++ b/lang/cem/ctest/ctgen/lu.cem.g @@ -0,0 +1,111 @@ +x + 8012 +x - 8012 +x / 8012 +x % 8012 +x * 8012 +x & 8012 +x | 8012 +x ^ 8012 +x || 8012 +x && 8012 +x << 9 +x >> 9 +-x +!x +~x +x == 8012 +x != 8012 +x <= 8012 +x >= 8012 +x < 8012 +x > 8012 +x ? x : 8012 +z = x -25302 +z += x -25292 +z -= x 25312 +z /= x 0 +z %= x 10 +z *= x 9124 +z &= x 10 +z |= x -25302 +z ^= x -25312 +z <<= 9 5120 +z >>= 9 0 +z ++ 11 +z -- 9 +-- z 9 +++ z 11 +y = ( x + 8012 ) -17290 +y = ( x - 8012 ) 32222 +y = ( x / 8012 ) 5 +y = ( x % 8012 ) 174 +y = ( x * 8012 ) -16776 +y = ( x & 8012 ) 7432 +y = ( x | 8012 ) -24722 +y = ( x ^ 8012 ) -32154 +y = ( x || 8012 ) 1 +y = ( x && 8012 ) 1 +y = ( x << 9 ) 21504 +y = ( x >> 9 ) 78 +y = ( -x ) 25302 +y = ( !x ) 0 +y = ( ~x ) 25301 +y = ( x == 8012 ) 0 +y = ( x != 8012 ) 1 +y = ( x <= 8012 ) 0 +y = ( x >= 8012 ) 1 +y = ( x < 8012 ) 0 +y = ( x > 8012 ) 1 +y = ( x ? x : 8012 ) -25302 +y = ( z = x ) -25302 -25302 +y = ( z += x ) -25292 -25292 +y = ( z -= x ) 25312 25312 +y = ( z /= x ) 0 0 +y = ( z %= x ) 10 10 +y = ( z *= x ) 9124 9124 +y = ( z &= x ) 10 10 +y = ( z |= x ) -25302 -25302 +y = ( z ^= x ) -25312 -25312 +y = ( z <<= 9 ) 5120 5120 +y = ( z >>= 9 ) 0 0 +y = ( z ++ ) 11 10 +y = ( z -- ) 9 10 +y = ( -- z ) 9 9 +y = ( ++ z ) 11 11 +yes if ( x + 8012 ) yes() ; else no() +yes if ( x - 8012 ) yes() ; else no() +yes if ( x / 8012 ) yes() ; else no() +yes if ( x % 8012 ) yes() ; else no() +yes if ( x * 8012 ) yes() ; else no() +yes if ( x & 8012 ) yes() ; else no() +yes if ( x | 8012 ) yes() ; else no() +yes if ( x ^ 8012 ) yes() ; else no() +yes if ( x || 8012 ) yes() ; else no() +yes if ( x && 8012 ) yes() ; else no() +yes if ( x << 9 ) yes() ; else no() +yes if ( x >> 9 ) yes() ; else no() +yes if ( -x ) yes() ; else no() +no if ( !x ) yes() ; else no() +yes if ( ~x ) yes() ; else no() +no if ( x == 8012 ) yes() ; else no() +yes if ( x != 8012 ) yes() ; else no() +no if ( x <= 8012 ) yes() ; else no() +yes if ( x >= 8012 ) yes() ; else no() +no if ( x < 8012 ) yes() ; else no() +yes if ( x > 8012 ) yes() ; else no() +yes if ( x ? x : 8012 ) yes() ; else no() +yes if ( z = x ) yes() ; else no() -25302 +yes if ( z += x ) yes() ; else no() -25292 +yes if ( z -= x ) yes() ; else no() 25312 +no if ( z /= x ) yes() ; else no() 0 +yes if ( z %= x ) yes() ; else no() 10 +yes if ( z *= x ) yes() ; else no() 9124 +yes if ( z &= x ) yes() ; else no() 10 +yes if ( z |= x ) yes() ; else no() -25302 +yes if ( z ^= x ) yes() ; else no() -25312 +yes if ( z <<= 9 ) yes() ; else no() 5120 +no if ( z >>= 9 ) yes() ; else no() 0 +yes if ( z ++ ) yes() ; else no() 11 +yes if ( z -- ) yes() ; else no() 9 +yes if ( -- z ) yes() ; else no() 9 +yes if ( ++ z ) yes() ; else no() 11 diff --git a/lang/cem/ctest/ctgen/lu.sed b/lang/cem/ctest/ctgen/lu.sed new file mode 100644 index 00000000..abc00393 --- /dev/null +++ b/lang/cem/ctest/ctgen/lu.sed @@ -0,0 +1,22 @@ +1i\ + /* ops is converted into a test program for longs \ +*/ +/ISTART/d +s/FN/main/ +/LSTART/c\ + unsigned x=40234 , y= 301 , z= 30 ; +/[XYZS]/s/.*/& ; printf("%s#","&"@) ;/ +/Z1/s/#/ %d&/ +/Z1/s/@/, Z1&/ +/Z2/s/#/ %d&/ +/Z2/s/@/, Z2&/ +/Z1/s/^/Z1 = 10 ; / +/Z2/s/^/Z2 = 0100 ; / +/[XYZS]/s/^/ / +s/X/x/g +s/Y/8012/g +s/S/9/g +s/Z1/z/g +s/Z2/y/g +s/#/\\n/ +s/@// diff --git a/lang/cem/ctest/ctgen/makefile b/lang/cem/ctest/ctgen/makefile new file mode 100644 index 00000000..d37a1700 --- /dev/null +++ b/lang/cem/ctest/ctgen/makefile @@ -0,0 +1,2 @@ +$(TS).c: OPS $(TS).sed + sed -f $(TS).sed $(TS).c diff --git a/lang/cem/ctest/ctgen/mkc b/lang/cem/ctest/ctgen/mkc new file mode 100755 index 00000000..3083ba96 --- /dev/null +++ b/lang/cem/ctest/ctgen/mkc @@ -0,0 +1 @@ +sed -f $1.sed $1.c diff --git a/lang/cem/ctest/ctgen/run b/lang/cem/ctest/ctgen/run new file mode 100755 index 00000000..e04e4e87 --- /dev/null +++ b/lang/cem/ctest/ctgen/run @@ -0,0 +1,4 @@ +for A in *.sed +do + run1 `basename $A .sed` ${1-gen} +done diff --git a/lang/cem/ctest/ctgen/run1 b/lang/cem/ctest/ctgen/run1 new file mode 100755 index 00000000..4e958763 --- /dev/null +++ b/lang/cem/ctest/ctgen/run1 @@ -0,0 +1,3 @@ +make "TS=$1" +make "P=$1" -fk ../makefile $2 +rm $1.[ckmos] diff --git a/lang/cem/ctest/ctill/noarg.c b/lang/cem/ctest/ctill/noarg.c new file mode 100644 index 00000000..7536b4fd --- /dev/null +++ b/lang/cem/ctest/ctill/noarg.c @@ -0,0 +1,10 @@ +char rcs_id[] = "$Header$" ; + +main() { + none() ; + printf("Undetected: declaration of argument not present in argument list\n") ; + return 1 ; +} + +int name ; +none() int name ; { } diff --git a/lang/cem/ctest/ctill/noarg.cem.g b/lang/cem/ctest/ctill/noarg.cem.g new file mode 100644 index 00000000..39921f47 --- /dev/null +++ b/lang/cem/ctest/ctill/noarg.cem.g @@ -0,0 +1,3 @@ +The program whose output you are comparing this file with should +not have compiled. +It declares a function, with an argument and without a body. diff --git a/lang/cem/ctest/ctill/run b/lang/cem/ctest/ctill/run new file mode 100755 index 00000000..27e35a65 --- /dev/null +++ b/lang/cem/ctest/ctill/run @@ -0,0 +1,2 @@ +echo "----- All program(s) in this directory should fail to compile." +make "P=noarg" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctinit/init.c b/lang/cem/ctest/ctinit/init.c new file mode 100644 index 00000000..48b3779f --- /dev/null +++ b/lang/cem/ctest/ctinit/init.c @@ -0,0 +1,264 @@ +/* + * (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 */ + +char rcs_id[] = "$Header$" ; + +/* Test initialisation of a V7 C-compiler */ +/* 1 sept 1980 */ +#include "../local.h" + +/* Integers and constant expressions */ + +int in1 = 4 ; +int in2 = MAXINT ; +int in3 = MININT ; +int in4 ; +int inzero ; + +int ice1 = (1-2+3*4/2)%3 ; +int ice2 = ((((1&3)|4)^014) >> 1) <<1 ; +int ice3 = ( (1==2) & (3<4) ) | (4>3) | (0<=0) | -2>=17 ; +int ice4 = (~-1) ; +int ice5 = (1==1 ? 3+4 : 5+6 ) ; +int ice6 = (1!=1 ? 7+8 : 9+10 ) ; +int ina[] = { 1, 3, 5 } ; + +pint() { + static int sint = -1 ; + int lint = in1+in3+sint ; + + printf("Integers:\n\n") ; + printf("in1\t%d\nin2\t%d\nin3\t%d\nin4\t%d\ninzero\t%d\n\n", + in1,in2,in3,in4,inzero ) ; + printf("ice1\t%d\nice2\t%d\nice3\t%d\nice4\t%d\nice5\t%d\nice6\t%d\n\n", + ice1,ice2,ice3,ice4,ice5,ice6 ) ; + printf("ina\t%d,%d,%d\n\n",ina[0],ina[1],ina[2]) ; + printf("sint\t%d\nlint\t%d\n\n",sint,lint) ; +} + +/* Characters */ + +char ch1 = 'a' ; +char ch2 ; +char cha1[] = "Mesg" ; +char cha2[] = "" ; +char cha3[] = "1" ; +char cha4[] = "12" ; +char cha5[] = "0123456789112345678921234567893123456789412345678951234567896123456789712345678981234567899123456789" ; + +char cha6[2][3] = { + { 1, 2, 3 }, + { 4, 5, 6 } +}; +char *pch1 = cha2 ; +char *pch2 = "pch2" ; +char *pch3 = "ppch3" ; +char *pch4 = 0 ; + +pch() { + static char stc[] = "123" ; + static char stc1[] = "1234" ; + static char *mult[] = { "ab" , "bc" , "de" } ; + + printf("Characters:\n\n") ; + + printf("ch1\t%c(%d)\n",ch1,ch1) ; + printf("ch2\t%d\n",ch2) ; + printf("cha1\t%s\ncha2\t%s\ncha3\t%s\ncha4\t%s\n", + cha1,cha2,cha3,cha4 ) ; + printf("cha5\t%s\n\n",cha5) ; + printf("cha6\t%d, %d, %d\n\t%d, %d, %d\n", + cha6[0][0],cha6[0][1],cha6[0][2],cha6[1][0],cha6[1][1],cha6[1][2]); + printf("pch1==cha2\t%s\n",(pch1 == cha2 ? "yes" : "no" ) ) ; + printf("pch2\t%s\npch3\t%s\n",pch2,pch3+1) ; + printf("pch4==0\t%s\n\n",(pch4 != 0 ? "no" : "yes" ) ) ; + printf("stc\t%s\nstc1\t%s\n",stc,stc1) ; + printf("mult[0],mult[1],mult[2] %s, %s, %s\n",mult[0],mult[1],mult[2]); +} + +#ifndef NOFLOAT +/* floats */ + +float fl1 = 0 ; +float fl2 = 2 ; +float fl3 = 2e-10 ; +float fl4 = 4.0 ; +float fl5 = EPSFLOAT ; +float fl6 = MAXFLOAT ; +float fl7 ; + +float fla1[4][3] = { + { 1, 3, 5 }, + { 2, 4, 6 }, + { 3, 5, 7 } +} ; +float fla2[4][3] = { + -1,-3,-5,-2,-4,-6,-3,-5,-7 +} ; +float fla3[4][3] = { + { 11 } , { 12 } , { 13 } , { 14 } +} ; + +pflt() { + register i,j ; + + printf("Floats:\n\n") ; + +printf("fl1\t%.20e\nfl2\t%.20e\nfl2\t%.20e\nfl4\t%.20e\nfl5\t%.20e\nfl6\t%.20e\nfl7\t%.20e\n", + fl1,fl2,fl2,fl4,fl5,fl6,fl7 ) ; + + printf(" fla1 fla2 fla3\n") ; + for ( i=0 ; i<4 ; i++ ) { + for ( j=0 ; j<3 ; j++ ) { + printf(" %20e %20e %20e\n", + fla1[i][j],fla2[i][j],fla3[i][j]) ; + } + } + + printf("\n") ; +} + +/* doubles */ + +double dbl1 = 0 ; +double dbl2 = 2 ; +double dbl3 = 2e-10 ; +double dbl4 = 4.0 ; +double dbl5 = EPSDOUBLE ; +double dbl6 = MAXDOUBLE ; +double dbl7 ; + +double dbla1[4][3] = { + { 1, 3, 5 }, + { 2, 4, 6 }, + { 3, 5, 7 } +} ; +double dbla2[4][3] = { + -1,-3,-5,-2,-4,-6,-3,-5,-7 +} ; +double dbla3[4][3] = { + { 11 } , { 12 } , { 13 } , { 14 } +} ; + +pdbl() { + register i,j ; + + printf("Doubles:\n\n") ; + +printf("dbl1\t%.20e\ndbl2\t%.20e\ndbl2\t%.20e\ndbl4\t%.20e\ndbl5\t%.20e\ndbl6\t%.20e\ndbl7\t%.20e\n", + dbl1,dbl2,dbl2,dbl4,dbl5,dbl6,dbl7 ) ; + + printf(" dbla1 dbla2 dbla3\n") ; + for ( i=0 ; i<4 ; i++ ) { + for ( j=0 ; j<3 ; j++ ) { + printf(" %20e %20e %20e\n", + dbla1[i][j],dbla2[i][j],dbla3[i][j]) ; + } + } + + printf("\n") ; +} +#endif + +/* long */ +long lo1 = 14L ; +long lo2 = -17 ; +long lo3 = MAXLONG ; +long lo4 = MINLONG ; +long lo5 ; +long lo6 = ( 0==1 ? -1L : 1L ) ; + +plong() { + printf("long\n\n") ; + + printf("lo1\t%D\nlo2\t%D\nlo3\t%D\nlo4\t%D\nlo5\t%D\nlo6\t%D\n\n", + lo1,lo2,lo3,lo4,lo5,lo6 ) ; +} + +/* structures and bit fields */ + +struct s1 { + int s_i ; + char s_ca[3] ; + long s_l ; +#ifndef NOFLOAT + double s_f ; +#endif + struct s1 *s_s1 ; +} ; +struct s1 st1 ; +struct s1 sta[3] = { +#ifndef NOFLOAT + 1 , { 'a' , 'b' , 'c' } , 10 , -10 , &sta[0] , +#else + 1 , { 'a' , 'b' , 'c' } , 10 , &sta[0] , +#endif + { 2 } , + 3 +} ; +struct s2 { + int s2_1 :1 ; + int s2_2 :2 ; + int s2_3 :4 ; + int s2_4 :7 ; + int s2_5 :2 ; + int s2_6 :11 ; + int s2_7 :6 ; +} stb = { + 1,2,3,4,3,6,7 +} ; + +pstruct() { + printf("structures\n\n") ; + + printf("\t st1 sta[0..2]\n") ; + + printf("s_i\t%15d%15d%15d%15d\n", + st1.s_i,sta[0].s_i,sta[1].s_i,sta[2].s_i) ; + printf("s_ca[0]\t%15d%15d%15d%15d\n", + st1.s_ca[0],sta[0].s_ca[0],sta[1].s_ca[0],sta[2].s_ca[0]) ; + printf("s_ca[1]\t%15d%15d%15d%15d\n", + st1.s_ca[1],sta[0].s_ca[1],sta[1].s_ca[1],sta[2].s_ca[1]) ; + printf("s_ca[2]\t%15d%15d%15d%15d\n", + st1.s_ca[2],sta[0].s_ca[2],sta[1].s_ca[2],sta[2].s_ca[2]) ; + printf("s_l\t%15D%15D%15D%15D\n", + st1.s_l,sta[0].s_l,sta[1].s_l,sta[2].s_l) ; +#ifndef NOFLOAT + printf("s_f\t %13e %13e %13e %13e\n\n", + st1.s_f,sta[0].s_f,sta[1].s_f,sta[2].s_f) ; +#endif + printf("(sta[0].s_s1)->s_i = %d\n",(sta[0].s_s1)->s_i) ; + + printf("\nbit fields:\n\n") ; + printf("sizeof stb %d\n",sizeof stb) ; + printf("stb\t%d %d %d %d %d %d %d\n\n", + stb.s2_1,stb.s2_2,stb.s2_3,stb.s2_4,stb.s2_5,stb.s2_6,stb.s2_7); +} + +main() { + pint() ; + pch() ; +#ifndef NOFLOAT + pflt() ; + pdbl() ; +#endif + plong() ; + pstruct() ; + return(0) ; +} diff --git a/lang/cem/ctest/ctinit/init.cem.g b/lang/cem/ctest/ctinit/init.cem.g new file mode 100644 index 00000000..6f1803cc --- /dev/null +++ b/lang/cem/ctest/ctinit/init.cem.g @@ -0,0 +1,112 @@ +Integers: + +in1 4 +in2 32767 +in3 -32768 +in4 0 +inzero 0 + +ice1 2 +ice2 8 +ice3 1 +ice4 0 +ice5 7 +ice6 19 + +ina 1,3,5 + +sint -1 +lint -32765 + +Characters: + +ch1 a(97) +ch2 0 +cha1 Mesg +cha2 +cha3 1 +cha4 12 +cha5 0123456789112345678921234567893123456789412345678951234567896123456789712345678981234567899123456789 + +cha6 1, 2, 3 + 4, 5, 6 +pch1==cha2 yes +pch2 pch2 +pch3 pch3 +pch4==0 yes + +stc 123 +stc1 1234 +mult[0],mult[1],mult[2] ab, bc, de +Floats: + +fl1 0.00000000000000000000e+00 +fl2 2.00000000000000000000e+00 +fl2 2.00000000000000000000e+00 +fl4 4.00000000000000000000e+00 +fl5 2.93873587705571892581e-39 +fl6 1.70141173319264427000e+38 +fl7 0.00000000000000000000e+00 + fla1 fla2 fla3 + 1.000000e+00 -1.000000e+00 1.100000e+01 + 3.000000e+00 -3.000000e+00 0.000000e+00 + 5.000000e+00 -5.000000e+00 0.000000e+00 + 2.000000e+00 -2.000000e+00 1.200000e+01 + 4.000000e+00 -4.000000e+00 0.000000e+00 + 6.000000e+00 -6.000000e+00 0.000000e+00 + 3.000000e+00 -3.000000e+00 1.300000e+01 + 5.000000e+00 -5.000000e+00 0.000000e+00 + 7.000000e+00 -7.000000e+00 0.000000e+00 + 0.000000e+00 0.000000e+00 1.400000e+01 + 0.000000e+00 0.000000e+00 0.000000e+00 + 0.000000e+00 0.000000e+00 0.000000e+00 + +Doubles: + +dbl1 0.00000000000000000000e+00 +dbl2 2.00000000000000000000e+00 +dbl2 2.00000000000000000000e+00 +dbl4 4.00000000000000000000e+00 +dbl5 2.93873600000000034793e-39 +dbl6 1.70141170000000000000e+38 +dbl7 0.00000000000000000000e+00 + dbla1 dbla2 dbla3 + 1.000000e+00 -1.000000e+00 1.100000e+01 + 3.000000e+00 -3.000000e+00 0.000000e+00 + 5.000000e+00 -5.000000e+00 0.000000e+00 + 2.000000e+00 -2.000000e+00 1.200000e+01 + 4.000000e+00 -4.000000e+00 0.000000e+00 + 6.000000e+00 -6.000000e+00 0.000000e+00 + 3.000000e+00 -3.000000e+00 1.300000e+01 + 5.000000e+00 -5.000000e+00 0.000000e+00 + 7.000000e+00 -7.000000e+00 0.000000e+00 + 0.000000e+00 0.000000e+00 1.400000e+01 + 0.000000e+00 0.000000e+00 0.000000e+00 + 0.000000e+00 0.000000e+00 0.000000e+00 + +long + +lo1 14 +lo2 -17 +lo3 2147483647 +lo4 -2147483648 +lo5 0 +lo6 1 + +structures + + st1 sta[0..2] +s_i 0 1 2 3 +s_ca[0] 0 97 0 0 +s_ca[1] 0 98 0 0 +s_ca[2] 0 99 0 0 +s_l 0 10 0 0 +s_f 0.000000e+00 -1.000000e+01 0.000000e+00 0.000000e+00 + +(sta[0].s_s1)->s_i = 1 + +bit fields: + +sizeof stb 6 +stb 1 2 3 4 3 6 7 + diff --git a/lang/cem/ctest/ctinit/run b/lang/cem/ctest/ctinit/run new file mode 100644 index 00000000..37fac6b2 --- /dev/null +++ b/lang/cem/ctest/ctinit/run @@ -0,0 +1 @@ +make "P=init" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctmargt/margt.c b/lang/cem/ctest/ctmargt/margt.c new file mode 100644 index 00000000..2c26296b --- /dev/null +++ b/lang/cem/ctest/ctmargt/margt.c @@ -0,0 +1,17 @@ +char rcs_id[] = "$Header$" ; + +main(argc,argv,envp) char **argv,**envp ; { + register int rargc ; + + rargc=argc ; + printf("main called with argc = %d\n",argc) ; + printf("Arguments:\n") ; + while ( rargc-- ) { + printf(" %s\n",*argv++) ; + } + printf("Environment:\n") ; + while ( *envp ) { + printf(" %s\n",*envp++) ; + } + return(argc-1) ; +} diff --git a/lang/cem/ctest/ctmargt/margt.cem.g b/lang/cem/ctest/ctmargt/margt.cem.g new file mode 100644 index 00000000..15bf3f30 --- /dev/null +++ b/lang/cem/ctest/ctmargt/margt.cem.g @@ -0,0 +1,7 @@ +main called with argc = 1 +Arguments: + margt.cem +Environment: + HOME=/other/keie + PATH=:/other/keie/bin:/bin:/usr/bin + TERM=MiniBee diff --git a/lang/cem/ctest/ctmargt/run b/lang/cem/ctest/ctmargt/run new file mode 100644 index 00000000..5003d2e6 --- /dev/null +++ b/lang/cem/ctest/ctmargt/run @@ -0,0 +1 @@ +make "P=margt" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctprof/makefile b/lang/cem/ctest/ctprof/makefile new file mode 100644 index 00000000..e910410c --- /dev/null +++ b/lang/cem/ctest/ctprof/makefile @@ -0,0 +1,35 @@ +.SILENT: +CEM=pdp +head: gen +diffs: + echo No diffs in ctprof +egen: tp.e + echo comparing tp.e + -if test -f tp.e.g ; then diff tp.cem.r tp.e.g ; else echo creating tp.e.g ; cp tp.cem.r tp.e.g ; fi + rm -f tp.e +tp.e: tp.c $(CEM) + $(CEM) -p -c.e tp.c +tp.cem.r: tp.cem + echo running tp + -tp.cem >tp.cem.r + rm -f tp.cem +procentry.k: procentry.c + $(CEM) -c.k procentry.c +tp.cem: tp.c procentry.k + echo $(CEM) tp.c procentry.k + $(CEM) -p -o tp.cem -O tp.c procentry.k + rm -f procentry.[kosm] tp.[kmos] +gen: tp.cem.r + echo comparing tp + -if test -f tp.cem.g ; then diff tp.cem.r tp.cem.g ; else echo creating tp.cem.g ; cp tp.cem.r tp.cem.g ; fi + +pr: + @pr `pwd`/*.c tp.cem.g + +opr: + make pr | opr + +cleanup: + -rm -f *.[kosme] *.old + +transI transM cmpI cmpM: diff --git a/lang/cem/ctest/ctprof/procentry.c b/lang/cem/ctest/ctprof/procentry.c new file mode 100644 index 00000000..01e85663 --- /dev/null +++ b/lang/cem/ctest/ctprof/procentry.c @@ -0,0 +1,38 @@ +/* + * (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 + * + */ + +char rcs_id[] = "$Header$" ; + +static int level = 0 ; +int procentry(name) char *name ; { + register int count ; + + count=level++ ; + while ( count-- ) { + printf(" ") ; + } + printf("Entering %s\n",name) ; +} +int procexit(name) char *name ; { + register int count ; + + count= --level ; + while ( count-- ) { + printf(" ") ; + } + printf("Leaving %s\n",name) ; +} diff --git a/lang/cem/ctest/ctprof/run b/lang/cem/ctest/ctprof/run new file mode 100644 index 00000000..35eaea14 --- /dev/null +++ b/lang/cem/ctest/ctprof/run @@ -0,0 +1,2 @@ +echo test profiling +make -k "`grep CEM= ../makefile`" ${1-gen} diff --git a/lang/cem/ctest/ctprof/tp.c b/lang/cem/ctest/ctprof/tp.c new file mode 100644 index 00000000..01b54358 --- /dev/null +++ b/lang/cem/ctest/ctprof/tp.c @@ -0,0 +1,29 @@ +/* + * (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 + * + */ + +char rcs_id2[] = "$Header$" ; + +/* Author: E.G. Keizer */ + +int fac(n) { return ( n==0 ? 1 : n*fac(n-1)) ; } + +main() { + { int dummy ; + if ( fac(6) != 720 ) printf("vernielt return waarde\n") ; + } + return 0 ; +} diff --git a/lang/cem/ctest/ctprof/tp.cem.g b/lang/cem/ctest/ctprof/tp.cem.g new file mode 100644 index 00000000..906787e5 --- /dev/null +++ b/lang/cem/ctest/ctprof/tp.cem.g @@ -0,0 +1,16 @@ +Entering main + Entering fac + Entering fac + Entering fac + Entering fac + Entering fac + Entering fac + Entering fac + Leaving fac + Leaving fac + Leaving fac + Leaving fac + Leaving fac + Leaving fac + Leaving fac +Leaving main diff --git a/lang/cem/ctest/ctstruct/run b/lang/cem/ctest/ctstruct/run new file mode 100644 index 00000000..94c96888 --- /dev/null +++ b/lang/cem/ctest/ctstruct/run @@ -0,0 +1 @@ +make "P=str" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctstruct/str.c b/lang/cem/ctest/ctstruct/str.c new file mode 100644 index 00000000..7ffb0147 --- /dev/null +++ b/lang/cem/ctest/ctstruct/str.c @@ -0,0 +1,179 @@ +/* + * (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 */ +static char rcs_id[]= "$Header$" ; + +/* test for structure parameters, assignment and return */ +# define ASIZE 26 + +struct w1 { + int w1_i ; +} ; +struct w2 { + int w2_i ; + long w2_l ; +} ; +struct w3 { + char w3_a[ASIZE] ; + unsigned w3_u ; +} ; + +struct w1 es1 ; +struct w1 es2[3] ; + +main() { + asst() ; + part() ; + callt() ; + return 0 ; + +} + +asst() { + /* test structure assignment */ + struct w1 st1, st2, *st3 ; + struct w2 s2t1, s2t2, *s2t3 ; + struct w3 s3t1, s3t2, *s3t3 ; + + + register int i ; + + printf("w1\n") ; + st1.w1_i = 506 ; + st2 = st1 ; + printf("\tst2.w1_i %d\n",st2.w1_i) ; + st3 = &st1 ; + printf("\t(*st3).w1_i %d\n",(*st3).w1_i) ; + es1.w1_i = 711 ; + st1 = st2 = es1 ; + printf("\tst1.w1_i %d\n",st1.w1_i) ; + printf("\tst2.w1_i %d\n",st2.w1_i) ; + es2[2] = st1 ; + printf("\tes2[2].w1_i %d\n",es2[2].w1_i) ; + + st1.w1_i = -577 ; + es1.w1_i = 577 ; + for ( i=0 ; i<2 ; i++ ) { + st2 = ( i ? st1 : es1 ) ; + printf("\tst2.w1_i %d\n",st2.w1_i) ; + } + + st1 = ( i , es1 ) ; + printf("\tst1.w1_i %d\n",st1.w1_i) ; + + printf("w2\n") ; + s2t1.w2_i = 18000 ; + s2t1.w2_l = 31415 ; + s2t2 = s2t1 ; + printf("\ts2t2: .w2_i %d .w2_l %ld\n",s2t2.w2_i,s2t2.w2_l) ; + s2t3 = &s2t2 ; + printf("\ts2t3->w2_l %ld\n",s2t3->w2_l) ; + + printf("w3\n") ; + for ( i = 0 ; iw2_l 31415 +w3 +s3t2.w3_a[ 0] a +s3t2.w3_a[ 1] b +s3t2.w3_a[ 2] c +s3t2.w3_a[ 3] d +s3t2.w3_a[ 4] e +s3t2.w3_a[ 5] f +s3t2.w3_a[ 6] g +s3t2.w3_a[ 7] h +s3t2.w3_a[ 8] i +s3t2.w3_a[ 9] j +s3t2.w3_a[10] k +s3t2.w3_a[11] l +s3t2.w3_a[12] m +s3t2.w3_a[13] n +s3t2.w3_a[14] o +s3t2.w3_a[15] p +s3t2.w3_a[16] q +s3t2.w3_a[17] r +s3t2.w3_a[18] s +s3t2.w3_a[19] t +s3t2.w3_a[20] u +s3t2.w3_a[21] v +s3t2.w3_a[22] w +s3t2.w3_a[23] x +s3t2.w3_a[24] y +s3t2.w3_a[25] z +s3t2.w3_u 8000 +s3t1.w3_a[ 0] A +s3t1.w3_a[ 1] B +s3t1.w3_a[ 2] C +s3t1.w3_a[ 3] D +s3t1.w3_a[ 4] E +s3t1.w3_a[ 5] F +s3t1.w3_a[ 6] G +s3t1.w3_a[ 7] H +s3t1.w3_a[ 8] I +s3t1.w3_a[ 9] J +s3t1.w3_a[10] K +s3t1.w3_a[11] L +s3t1.w3_a[12] M +s3t1.w3_a[13] N +s3t1.w3_a[14] O +s3t1.w3_a[15] P +s3t1.w3_a[16] Q +s3t1.w3_a[17] R +s3t1.w3_a[18] S +s3t1.w3_a[19] T +s3t1.w3_a[20] U +s3t1.w3_a[21] V +s3t1.w3_a[22] W +s3t1.w3_a[23] X +s3t1.w3_a[24] Y +s3t1.w3_a[25] Z +s3t1.w3_u 587 +structure parameters +before -1 +str.w3_a[ 0] 1 +str.w3_a[ 1] 2 +str.w3_a[ 2] 3 +str.w3_a[ 3] 4 +str.w3_a[ 4] 5 +str.w3_a[ 5] 6 +str.w3_a[ 6] 7 +str.w3_a[ 7] 8 +str.w3_a[ 8] 9 +str.w3_a[ 9] 10 +str.w3_a[10] 11 +str.w3_a[11] 12 +str.w3_a[12] 13 +str.w3_a[13] 14 +str.w3_a[14] 15 +str.w3_a[15] 16 +str.w3_a[16] 17 +str.w3_a[17] 18 +str.w3_a[18] 19 +str.w3_a[19] 20 +str.w3_a[20] 21 +str.w3_a[21] 22 +str.w3_a[22] 23 +str.w3_a[23] 24 +str.w3_a[24] 25 +str.w3_a[25] 26 +str.w3_u 119 +after 1000 + +Stucture valued functions +myp.w3_a: + 0 97 + 1 96 + 2 95 + 3 94 + 4 93 + 5 92 + 6 91 + 7 90 + 8 89 + 9 88 + 10 87 + 11 86 + 12 85 + 13 84 + 14 83 + 15 82 + 16 81 + 17 80 + 18 79 + 19 78 + 20 77 + 21 76 + 22 75 + 23 74 + 24 73 + 25 72 + 0 99 + 1 100 + 2 101 + 3 102 + 4 103 + 5 104 + 6 105 + 7 106 + 8 107 + 9 108 + 10 109 + 11 110 + 12 111 + 13 112 + 14 113 + 15 114 + 16 115 + 17 116 + 18 117 + 19 118 + 20 119 + 21 120 + 22 121 + 23 122 + 24 123 + 25 124 diff --git a/lang/cem/ctest/ctstruct/str.pcc.r b/lang/cem/ctest/ctstruct/str.pcc.r new file mode 100644 index 00000000..a6b5ad35 --- /dev/null +++ b/lang/cem/ctest/ctstruct/str.pcc.r @@ -0,0 +1,152 @@ +w1 + st2.w1_i 506 + (*st3).w1_i 506 + st1.w1_i 711 + st2.w1_i 711 + es2[2].w1_i 711 + st2.w1_i 577 + st2.w1_i -577 + st1.w1_i 577 +w2 + s2t2: .w2_i 18000 .w2_d 3.141500 + s2t3->w2_d 3.141500 +w3 +s3t2.w3_a[ 0] a +s3t2.w3_a[ 1] b +s3t2.w3_a[ 2] c +s3t2.w3_a[ 3] d +s3t2.w3_a[ 4] e +s3t2.w3_a[ 5] f +s3t2.w3_a[ 6] g +s3t2.w3_a[ 7] h +s3t2.w3_a[ 8] i +s3t2.w3_a[ 9] j +s3t2.w3_a[10] k +s3t2.w3_a[11] l +s3t2.w3_a[12] m +s3t2.w3_a[13] n +s3t2.w3_a[14] o +s3t2.w3_a[15] p +s3t2.w3_a[16] q +s3t2.w3_a[17] r +s3t2.w3_a[18] s +s3t2.w3_a[19] t +s3t2.w3_a[20] u +s3t2.w3_a[21] v +s3t2.w3_a[22] w +s3t2.w3_a[23] x +s3t2.w3_a[24] y +s3t2.w3_a[25] z +s3t2.w3_x 1.000000 +s3t1.w3_a[ 0] A +s3t1.w3_a[ 1] B +s3t1.w3_a[ 2] C +s3t1.w3_a[ 3] D +s3t1.w3_a[ 4] E +s3t1.w3_a[ 5] F +s3t1.w3_a[ 6] G +s3t1.w3_a[ 7] H +s3t1.w3_a[ 8] I +s3t1.w3_a[ 9] J +s3t1.w3_a[10] K +s3t1.w3_a[11] L +s3t1.w3_a[12] M +s3t1.w3_a[13] N +s3t1.w3_a[14] O +s3t1.w3_a[15] P +s3t1.w3_a[16] Q +s3t1.w3_a[17] R +s3t1.w3_a[18] S +s3t1.w3_a[19] T +s3t1.w3_a[20] U +s3t1.w3_a[21] V +s3t1.w3_a[22] W +s3t1.w3_a[23] X +s3t1.w3_a[24] Y +s3t1.w3_a[25] Z +s3t1.w3_x 0.318319 +structure parameters +before -1 +str.w3_a[ 0] 1 +str.w3_a[ 1] 2 +str.w3_a[ 2] 3 +str.w3_a[ 3] 4 +str.w3_a[ 4] 5 +str.w3_a[ 5] 6 +str.w3_a[ 6] 7 +str.w3_a[ 7] 8 +str.w3_a[ 8] 9 +str.w3_a[ 9] 10 +str.w3_a[10] 11 +str.w3_a[11] 12 +str.w3_a[12] 13 +str.w3_a[13] 14 +str.w3_a[14] 15 +str.w3_a[15] 16 +str.w3_a[16] 17 +str.w3_a[17] 18 +str.w3_a[18] 19 +str.w3_a[19] 20 +str.w3_a[20] 21 +str.w3_a[21] 22 +str.w3_a[22] 23 +str.w3_a[23] 24 +str.w3_a[24] 25 +str.w3_a[25] 26 +str.w3_x 2.810000 +after 1000 + +Stucture valued functions +myp.w3_a: + 0 97 + 1 96 + 2 95 + 3 94 + 4 93 + 5 92 + 6 91 + 7 90 + 8 89 + 9 88 + 10 87 + 11 86 + 12 85 + 13 84 + 14 83 + 15 82 + 16 81 + 17 80 + 18 79 + 19 78 + 20 77 + 21 76 + 22 75 + 23 74 + 24 73 + 25 72 + 0 99 + 1 100 + 2 101 + 3 102 + 4 103 + 5 104 + 6 105 + 7 106 + 8 107 + 9 108 + 10 109 + 11 110 + 12 111 + 13 112 + 14 113 + 15 114 + 16 115 + 17 116 + 18 117 + 19 118 + 20 119 + 21 120 + 22 121 + 23 122 + 24 123 + 25 124 diff --git a/lang/cem/ctest/ctsys/run b/lang/cem/ctest/ctsys/run new file mode 100644 index 00000000..f33183db --- /dev/null +++ b/lang/cem/ctest/ctsys/run @@ -0,0 +1 @@ +make "P=tfork" -fsk ../makefile ${1-gen} diff --git a/lang/cem/ctest/ctsys/signal.c b/lang/cem/ctest/ctsys/signal.c new file mode 100644 index 00000000..63e387bf --- /dev/null +++ b/lang/cem/ctest/ctsys/signal.c @@ -0,0 +1,14 @@ +#include + +char rcs_id[] = "$Header$" ; + +foo() +{ + printf("signal received\n"); +} + +main() +{ + signal(SIGINT,foo); + while(1); +} diff --git a/lang/cem/ctest/ctsys/tfork.c b/lang/cem/ctest/ctsys/tfork.c new file mode 100644 index 00000000..d635cadc --- /dev/null +++ b/lang/cem/ctest/ctsys/tfork.c @@ -0,0 +1,33 @@ +char rcs_id[] = "$Header$" ; + +main(argc,argv) char **argv ; { + int child, waitchild ; + int status ; + child=fork() ; + if ( child== -1 ) { + printf("fork returned -1\n") ; + return 1 ; + } + if ( child ) { + /* The parent */ + printf("childno %d\n",child ) ; + do { + waitchild= wait(&status ) ; + printf("Child %d, status 0x%x\n",waitchild,status) ; + if ( waitchild== -1 ) { + printf("No children\n") ; + return 1 ; + } + } while ( waitchild!=child ) ; + if ( argc<=1 && status != (8<<8) ) { + printf("incorrect status return\n") ; + return 2 ; + } + } else { + /* The child */ + if ( argc>1 ) pause() ; + return 8 ; + } + printf("fork/wait ok\n") ; + return 0 ; +} diff --git a/lang/cem/ctest/ctsys/tfork.cem.g b/lang/cem/ctest/ctsys/tfork.cem.g new file mode 100644 index 00000000..8021a812 --- /dev/null +++ b/lang/cem/ctest/ctsys/tfork.cem.g @@ -0,0 +1,3 @@ +childno N +Child N, status 0x800 +fork/wait ok diff --git a/lang/cem/ctest/local.h b/lang/cem/ctest/local.h new file mode 100644 index 00000000..17c18fe8 --- /dev/null +++ b/lang/cem/ctest/local.h @@ -0,0 +1,9 @@ +# define MAXINT 32767 +# define MININT -32768 +# define MAXLONG 2147483647 +# define MINLONG -2147483648 +# define EPSFLOAT 2.938736e-39 +# define MAXFLOAT 1.7014117e38 +# define EPSDOUBLE 2.938736e-39 +/* for 64-bit double 1.701411834604692293e38 */ +# define MAXDOUBLE 1.7014117e38 diff --git a/lang/cem/ctest/makefile b/lang/cem/ctest/makefile new file mode 100644 index 00000000..f3fe6bde --- /dev/null +++ b/lang/cem/ctest/makefile @@ -0,0 +1,49 @@ +.SILENT: +CEM=acc +head: + echo use run + +diffs: $P.pcc.r $P.cc.r $P.cem.r + echo three compiler diff + -diff3 $P.*.r | tee diffs +egen: $P.e + echo comparing $P.e + -if test -f $P.e.g ; then diff -h $P.e $P.e.g ; else echo creating $P.e.g ; cp $P.e $P.e.g ; fi + rm -f $P.e +$P.e: $P.c $(CEM) + $(CEM) -c.e $P.c +$P.pcc.r: $P.pcc + echo running $P.pcc + -$P.pcc >$P.pcc.r + rm -f $P.pcc +$P.cc.r: $P.cc + echo running $P.cc + -$P.cc >$P.cc.r + rm -f $P.cc +$P.cem.r: $P.cem + echo running $P.cem + -$P.cem >$P.cem.r + rm -f $P.cem +$P.pcc: /tmp + echo pcc $P.c + pcc -o $P.pcc $P.c +$P.cc: /tmp + echo cc $P.c + cc -o $P.cc $P.c +$P.cem: /tmp + echo $(CEM) $P.c + $(CEM) -o $P.cem $P.c +gen: $P.cem.r + echo comparing $P + -if test -f $P.cem.g ; then diff -h $P.cem.r $P.cem.g ; else echo creating $P.cem.g ; cp $P.cem.r $P.cem.g ; fi + +install cmp: + +pr: + @pr `pwd`/$P.c `pwd`/$P.cem.g + +opr: + make pr | opr + +clean: + -rm -f $P.[kmsoe] core a.out *.old diff --git a/lang/cem/ctest/makefile.i86 b/lang/cem/ctest/makefile.i86 new file mode 100644 index 00000000..aa5adf49 --- /dev/null +++ b/lang/cem/ctest/makefile.i86 @@ -0,0 +1,50 @@ +.SILENT: +CEM=i86 -DNOFLOAT +head: + echo use run + +diffs: $P.pcc.r $P.cc.r $P.cem.r + echo three compiler diff + -diff3 $P.*.r | tee diffs +egen: $P.e + echo comparing $P.e + -if test -f $P.e.g ; then diff -h $P.e $P.e.g ; else echo creating $P.e.g ; cp $P.e $P.e.g ; fi + rm -f $P.e +$P.e: $P.c $(CEM) + $(CEM) -c.e $P.c +$P.pcc.r: $P.pcc + echo running $P.pcc + -$P.pcc >$P.pcc.r + rm -f $P.pcc +$P.cc.r: $P.cc + echo running $P.cc + -$P.cc >$P.cc.r + rm -f $P.cc +$P.cem.r: $P.cem + echo running $P.cem + idl I7 $P.cem + -talk I7 >$P.cem.r + rm -f $P.cem +$P.pcc: $P.c /usr/lib/ccom + echo pcc $P.c + pcc -o $P.pcc $P.c +$P.cc: $P.c /lib/c0 /lib/c1 + echo cc $P.c + cc -o $P.cc $P.c +$P.cem: $P.c + echo $(CEM) $P.c + $(CEM) -o $P.cem $P.c +gen: $P.cem.r + echo comparing $P + -if test -f $P.cem.g ; then diff -h $P.cem.r $P.cem.g ; else echo creating $P.cem.g ; cp $P.cem.r $P.cem.g ; fi + +install cmp: + +pr: + @pr `pwd`/$P.c `pwd`/$P.cem.g + +opr: + make pr | opr + +clean: + -rm -f $P.[kmsoe] core a.out *.old diff --git a/lang/cem/ctest/makefile.int b/lang/cem/ctest/makefile.int new file mode 100644 index 00000000..37d9fde5 --- /dev/null +++ b/lang/cem/ctest/makefile.int @@ -0,0 +1,49 @@ +.SILENT: +CEM=int -O +head: + echo use run + +diffs: $P.pcc.r $P.cc.r $P.cem.r + echo three compiler diff + -diff3 $P.*.r | tee diffs +egen: $P.e + echo comparing $P.e + -if test -f $P.e.g ; then diff -h $P.e $P.e.g ; else echo creating $P.e.g ; cp $P.e $P.e.g ; fi + rm -f $P.e +$P.e: $P.c $(CEM) + $(CEM) -c.e $P.c +$P.pcc.r: $P.pcc + echo running $P.pcc + -$P.pcc >$P.pcc.r + rm -f $P.pcc +$P.cc.r: $P.cc + echo running $P.cc + -$P.cc >$P.cc.r + rm -f $P.cc +$P.cem.r: $P.cem + echo running $P.cem + -/usr/evert/compile/a.out $P.cem >$P.cem.r + rm -f $P.cem +$P.pcc: $P.c /usr/lib/ccom + echo pcc $P.c + pcc -o $P.pcc $P.c +$P.cc: $P.c /lib/c0 /lib/c1 + echo cc $P.c + cc -o $P.cc $P.c +$P.cem: $P.c + echo $(CEM) $P.c + $(CEM) -o $P.cem $P.c +gen: $P.cem.r + echo comparing $P + -if test -f $P.cem.g ; then diff -h $P.cem.r $P.cem.g ; else echo creating $P.cem.g ; cp $P.cem.r $P.cem.g ; fi + +install cmp: + +pr: + @pr `pwd`/$P.c `pwd`/$P.cem.g + +opr: + make pr | opr + +clean: + -rm -f $P.[kmsoe] core a.out *.old diff --git a/lang/cem/ctest/makefile.std b/lang/cem/ctest/makefile.std new file mode 100644 index 00000000..f3fe6bde --- /dev/null +++ b/lang/cem/ctest/makefile.std @@ -0,0 +1,49 @@ +.SILENT: +CEM=acc +head: + echo use run + +diffs: $P.pcc.r $P.cc.r $P.cem.r + echo three compiler diff + -diff3 $P.*.r | tee diffs +egen: $P.e + echo comparing $P.e + -if test -f $P.e.g ; then diff -h $P.e $P.e.g ; else echo creating $P.e.g ; cp $P.e $P.e.g ; fi + rm -f $P.e +$P.e: $P.c $(CEM) + $(CEM) -c.e $P.c +$P.pcc.r: $P.pcc + echo running $P.pcc + -$P.pcc >$P.pcc.r + rm -f $P.pcc +$P.cc.r: $P.cc + echo running $P.cc + -$P.cc >$P.cc.r + rm -f $P.cc +$P.cem.r: $P.cem + echo running $P.cem + -$P.cem >$P.cem.r + rm -f $P.cem +$P.pcc: /tmp + echo pcc $P.c + pcc -o $P.pcc $P.c +$P.cc: /tmp + echo cc $P.c + cc -o $P.cc $P.c +$P.cem: /tmp + echo $(CEM) $P.c + $(CEM) -o $P.cem $P.c +gen: $P.cem.r + echo comparing $P + -if test -f $P.cem.g ; then diff -h $P.cem.r $P.cem.g ; else echo creating $P.cem.g ; cp $P.cem.r $P.cem.g ; fi + +install cmp: + +pr: + @pr `pwd`/$P.c `pwd`/$P.cem.g + +opr: + make pr | opr + +clean: + -rm -f $P.[kmsoe] core a.out *.old diff --git a/lang/cem/ctest/out.std b/lang/cem/ctest/out.std new file mode 100644 index 00000000..ee1b594a --- /dev/null +++ b/lang/cem/ctest/out.std @@ -0,0 +1,174 @@ +Tue May 22 15:12:22 MDT 1984 +***** ctconv +acc conv.c +conv.c +"conv.c", line 41: warning: Overflow in constant expression +running conv.cem +comparing conv +***** ctdecl +acc decl.c +decl.c +running decl.cem +comparing decl +***** ctdivers +acc ops.c +ops.c +running ops.cem +comparing ops +***** cterr +acc bugs.c +bugs.c +"bugs.c", line 92: warning: Overflow in constant expression +running bugs.cem +comparing bugs +9,$c9,$ +< compl_ind +< END +--- +> END +***** ctest1 +acc test.c +test.c +running test.cem +comparing test +***** ctest2 +acc t7.c +t7.c +"t7.c", line 161: warning: statement not reached +"t7.c", line 178: warning: statement not reached +"t7.c", line 182: warning: statement not reached +"t7.c", line 186: warning: statement not reached +"t7.c", line 190: warning: statement not reached +"t7.c", line 194: warning: statement not reached +"t7.c", line 198: warning: statement not reached +"t7.c", line 205: warning: statement not reached +"t7.c", line 207: warning: statement not reached +"t7.c", line 211: warning: statement not reached +"t7.c", line 213: warning: statement not reached +"t7.c", line 287: warning: statement not reached +"t7.c", line 294: warning: statement not reached +"t7.c", line 300: warning: statement not reached +"t7.c", line 307: warning: statement not reached +"t7.c", line 343: warning: statement not reached +"t7.c", line 344: warning: statement not reached +"t7.c", line 345: warning: statement not reached +"t7.c", line 346: warning: statement not reached +"t7.c", line 348: warning: statement not reached +"t7.c", line 452: warning: statement not reached +"t7.c", line 561: warning: statement not reached +"t7.c", line 589: warning: statement not reached +running t7.cem +comparing t7 +***** ctest3 +acc test2.c +test2.c +running test2.cem +comparing test2 +***** ctest5 +acc test1.c +test1.c +"test1.c", line 101: warning: Illegal shift count in constant expression +"test1.c", line 370: warning: illegal pointer combination +"test1.c", line 371: warning: illegal pointer combination +"test1.c", line 372: warning: illegal pointer combination +"test1.c", line 384: warning: illegal pointer combination +"test1.c", line 407: warning: illegal pointer combination +"test1.c", line 408: warning: illegal pointer combination +"test1.c", line 409: warning: illegal pointer combination +"test1.c", line 421: warning: illegal pointer combination +running test1.cem +comparing test1 +***** ctgen +`bf.c' is up to date. +acc bf.c +bf.c +running bf.cem +comparing bf +`cel.c' is up to date. +acc cel.c +cel.c +running cel.cem +comparing cel +`clu.c' is up to date. +acc clu.c +clu.c +"clu.c", line 60: warning: Overflow in constant expression +"clu.c", line 66: warning: Overflow in constant expression +running clu.cem +comparing clu +28c28 +< x *= 40000 0 +--- +> x *= 40000 6784 +65c65 +< y = ( x *= 40000 ) 0 0 +--- +> y = ( x *= 40000 ) 6784 6784 +102c102 +< no if ( x *= 40000 ) yes() ; else no() 0 +--- +> yes if ( x *= 40000 ) yes() ; else no() 6784 +`ec.c' is up to date. +acc ec.c +ec.c +"ec.c", line 58: warning: Overflow in constant expression +"ec.c", line 64: warning: Overflow in constant expression +running ec.cem +comparing ec +`ef.c' is up to date. +acc ef.c +ef.c +running ef.cem +comparing ef +`ei.c' is up to date. +acc ei.c +ei.c +"ei.c", line 22: warning: Overflow in constant expression +"ei.c", line 65: warning: Overflow in constant expression +"ei.c", line 108: warning: Overflow in constant expression +running ei.cem +comparing ei +`el.c' is up to date. +acc el.c +el.c +running el.cem +comparing el +`eu.c' is up to date. +acc eu.c +eu.c +"eu.c", line 58: warning: Overflow in constant expression +"eu.c", line 64: warning: Overflow in constant expression +running eu.cem +comparing eu +28c28 +< x *= 40000 0 +--- +> x *= 40000 6784 +65c65 +< y = ( x *= 40000 ) 0 0 +--- +> y = ( x *= 40000 ) 6784 6784 +102c102 +< no if ( x *= 40000 ) yes() ; else no() 0 +--- +> yes if ( x *= 40000 ) yes() ; else no() 6784 +`id.c' is up to date. +acc id.c +id.c +running id.cem +comparing id +`lc.c' is up to date. +acc lc.c +lc.c +"lc.c", line 60: warning: Overflow in constant expression +"lc.c", line 66: warning: Overflow in constant expression +running lc.cem +comparing lc +`ld.c' is up to date. +acc ld.c +ld.c +running ld.cem +comparing ld +`lf.c' is up to date. +acc lf.c +lf.c diff --git a/lang/cem/ctest/run b/lang/cem/ctest/run new file mode 100755 index 00000000..df2e4617 --- /dev/null +++ b/lang/cem/ctest/run @@ -0,0 +1,13 @@ +date +for A in ct* +do ( + echo "***** $A" + cd "$A" + if test -r run ; then + sh run "${1-gen}" + else + echo "No run file present" + fi + ) +done +date diff --git a/lang/cem/libcc/gen/head_cc.e b/lang/cem/libcc/gen/head_cc.e new file mode 100644 index 00000000..c7d66c7c --- /dev/null +++ b/lang/cem/libcc/gen/head_cc.e @@ -0,0 +1,56 @@ +# +/* + * (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 */ + + mes 2,EM_WSIZE,EM_PSIZE + + exa environ + exa _penvp +environ + bss EM_PSIZE,0,0 +_penvp + bss EM_PSIZE,0,0 + + exp $m_a_i_n + pro $m_a_i_n,0 +#if EM_WSIZE==1 + ldc 256 +#else + loc 256 +#endif + sim ; EIUND is ignored + lal EM_WSIZE+EM_PSIZE + loi EM_PSIZE + lae environ + sti EM_PSIZE + lae environ + loi EM_PSIZE + lae _penvp + sti EM_PSIZE + lal EM_WSIZE+EM_PSIZE + loi EM_PSIZE + lal EM_WSIZE + loi EM_PSIZE + lal 0 + loi EM_WSIZE + cal $main + asp EM_WSIZE+EM_PSIZE+EM_PSIZE + lfr EM_WSIZE + cal $exit + end diff --git a/lang/cem/libcc/mon/LIST b/lang/cem/libcc/mon/LIST new file mode 100644 index 00000000..635b74b6 --- /dev/null +++ b/lang/cem/libcc/mon/LIST @@ -0,0 +1,64 @@ +tail_mon.a +exit.c +gtty.c +signal.c +stty.c +tell.c +time.c +cleanup.c +access.e +acct.e +alarm.e +brk.e +chdir.e +chmod.e +chown.e +chroot.e +close.e +creat.e +dup.e +dup2.e +execl.e +execle.e +execv.e +execve.e +_exit.e +fork.e +fstat.e +ftime.e +getegid.e +geteuid.e +getgid.e +getpid.e +getuid.e +ioctl.e +kill.e +link.e +lock.e +lseek.e +mknod.e +mount.e +mpxcall.e +nice.e +open.e +pause.e +pipe.e +prof.e +ptrace.e +read.e +sbrk.e +setgid.e +setuid.e +setsig.e +sigtrp.e +stat.e +stime.e +sync.e +times.e +umask.e +umount.e +unlink.e +utime.e +wait.e +write.e +errno.e diff --git a/lang/cem/libcc/mon/_exit.e b/lang/cem/libcc/mon/_exit.e new file mode 100644 index 00000000..a88f9b5f --- /dev/null +++ b/lang/cem/libcc/mon/_exit.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $_exit + pro $_exit,0 + lol 0 + loc 1 + mon + end diff --git a/lang/cem/libcc/mon/access.e b/lang/cem/libcc/mon/access.e new file mode 100644 index 00000000..681f5978 --- /dev/null +++ b/lang/cem/libcc/mon/access.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $access + pro $access,0 + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 33 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/acct.e b/lang/cem/libcc/mon/acct.e new file mode 100644 index 00000000..8ac3415a --- /dev/null +++ b/lang/cem/libcc/mon/acct.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $acct + pro $acct,0 + lal 0 + loi EM_PSIZE + loc 51 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/alarm.e b/lang/cem/libcc/mon/alarm.e new file mode 100644 index 00000000..228147ef --- /dev/null +++ b/lang/cem/libcc/mon/alarm.e @@ -0,0 +1,9 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $alarm + pro $alarm,0 + lol 0 + loc 27 + mon + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/brk.e b/lang/cem/libcc/mon/brk.e new file mode 100644 index 00000000..1c2b1303 --- /dev/null +++ b/lang/cem/libcc/mon/brk.e @@ -0,0 +1,10 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $brk + pro $brk,0 + lal 0 + loi EM_PSIZE + str 2 ; The - possibly - occurring traps should be caught + loc 0 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/chdir.e b/lang/cem/libcc/mon/chdir.e new file mode 100644 index 00000000..089da818 --- /dev/null +++ b/lang/cem/libcc/mon/chdir.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $chdir + pro $chdir,0 + lal 0 + loi EM_PSIZE + loc 12 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/chmod.e b/lang/cem/libcc/mon/chmod.e new file mode 100644 index 00000000..fa278b7b --- /dev/null +++ b/lang/cem/libcc/mon/chmod.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $chmod + pro $chmod,0 + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 15 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/chown.e b/lang/cem/libcc/mon/chown.e new file mode 100644 index 00000000..f6f0ffbb --- /dev/null +++ b/lang/cem/libcc/mon/chown.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $chown + pro $chown,0 + lal 0 + loi EM_PSIZE+2*EM_WSIZE + loc 16 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/chroot.e b/lang/cem/libcc/mon/chroot.e new file mode 100644 index 00000000..f448be0f --- /dev/null +++ b/lang/cem/libcc/mon/chroot.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $chroot + pro $chroot,0 + lal 0 + loi EM_PSIZE + loc 61 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/cleanup.c b/lang/cem/libcc/mon/cleanup.c new file mode 100644 index 00000000..88849f14 --- /dev/null +++ b/lang/cem/libcc/mon/cleanup.c @@ -0,0 +1 @@ +_cleanup(){} diff --git a/lang/cem/libcc/mon/close.e b/lang/cem/libcc/mon/close.e new file mode 100644 index 00000000..77c3dd5c --- /dev/null +++ b/lang/cem/libcc/mon/close.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $close + pro $close,0 + lol 0 + loc 6 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/creat.e b/lang/cem/libcc/mon/creat.e new file mode 100644 index 00000000..6832be08 --- /dev/null +++ b/lang/cem/libcc/mon/creat.e @@ -0,0 +1,14 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $creat + pro $creat,0 + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 8 + mon + zeq *1 + ste errno ; since e==r0 + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/dup.e b/lang/cem/libcc/mon/dup.e new file mode 100644 index 00000000..e9c77d8b --- /dev/null +++ b/lang/cem/libcc/mon/dup.e @@ -0,0 +1,14 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $dup + pro $dup,0 + lol 0 + dup EM_WSIZE + loc 41 + mon + zeq *1 + ste errno + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/dup2.e b/lang/cem/libcc/mon/dup2.e new file mode 100644 index 00000000..67bda6fe --- /dev/null +++ b/lang/cem/libcc/mon/dup2.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $dup2 + pro $dup2,0 + lal 0 + loi 2*EM_WSIZE + loc 64 + ior EM_WSIZE + loc 41 + mon + zeq *1 + ste errno + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/errno.e b/lang/cem/libcc/mon/errno.e new file mode 100644 index 00000000..18df9017 --- /dev/null +++ b/lang/cem/libcc/mon/errno.e @@ -0,0 +1,6 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + + exa errno +errno + bss EM_WSIZE,0,0 diff --git a/lang/cem/libcc/mon/execl.e b/lang/cem/libcc/mon/execl.e new file mode 100644 index 00000000..e958d65a --- /dev/null +++ b/lang/cem/libcc/mon/execl.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $execl + pro $execl,0 + lae _penvp + loi EM_PSIZE + lal EM_PSIZE + lal 0 + loi EM_PSIZE + loc 59 + mon + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/execle.e b/lang/cem/libcc/mon/execle.e new file mode 100644 index 00000000..3f529ea1 --- /dev/null +++ b/lang/cem/libcc/mon/execle.e @@ -0,0 +1,25 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $execle + pro $execle,0 + lal EM_PSIZE +1 + dup EM_PSIZE + loi EM_PSIZE + zer EM_PSIZE + cmp + zeq *2 + adp EM_PSIZE + bra *1 +2 + adp EM_PSIZE + loi EM_PSIZE + lal EM_PSIZE + lal 0 + loi EM_PSIZE + loc 59 + mon + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/execv.e b/lang/cem/libcc/mon/execv.e new file mode 100644 index 00000000..5cbaa344 --- /dev/null +++ b/lang/cem/libcc/mon/execv.e @@ -0,0 +1,14 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $execv + pro $execv,0 + lae _penvp + loi EM_PSIZE + lal 0 + loi 2*EM_PSIZE + loc 59 + mon + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/execve.e b/lang/cem/libcc/mon/execve.e new file mode 100644 index 00000000..33769b4d --- /dev/null +++ b/lang/cem/libcc/mon/execve.e @@ -0,0 +1,12 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $execve + pro $execve,0 + lal 0 + loi 3*EM_PSIZE + loc 59 + mon + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/exit.c b/lang/cem/libcc/mon/exit.c new file mode 100644 index 00000000..f57bd3a0 --- /dev/null +++ b/lang/cem/libcc/mon/exit.c @@ -0,0 +1,24 @@ +/* + * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. + * + * This product is part of the Amsterdam Compiler Kit + * developed by Andrew S. Tanenbaum, Johan W. Stevenson, + * Ed Keizer and Hans van Staveren of the Vrije Universiteit. + * + * 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 + * + */ + +exit(code) +{ + _cleanup() ; + _exit(code) ; +} diff --git a/lang/cem/libcc/mon/fork.e b/lang/cem/libcc/mon/fork.e new file mode 100644 index 00000000..e2c27b9f --- /dev/null +++ b/lang/cem/libcc/mon/fork.e @@ -0,0 +1,21 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exa par_uid +par_uid + bss EM_WSIZE,0,0 + + exp $fork + pro $fork,0 + loc 2 + mon + zeq *1 + ste errno + loc -1 + ret EM_WSIZE +1 + zeq *2 + ste par_uid + loc 0 +2 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/fstat.e b/lang/cem/libcc/mon/fstat.e new file mode 100644 index 00000000..97b84105 --- /dev/null +++ b/lang/cem/libcc/mon/fstat.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $fstat + pro $fstat,0 + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 28 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/ftime.e b/lang/cem/libcc/mon/ftime.e new file mode 100644 index 00000000..614533ab --- /dev/null +++ b/lang/cem/libcc/mon/ftime.e @@ -0,0 +1,10 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $ftime + pro $ftime,0 + lal 0 + loi EM_PSIZE + loc 35 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/getegid.e b/lang/cem/libcc/mon/getegid.e new file mode 100644 index 00000000..3e0c4dd2 --- /dev/null +++ b/lang/cem/libcc/mon/getegid.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $getegid + pro $getegid,0 + loc 47 + mon + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/geteuid.e b/lang/cem/libcc/mon/geteuid.e new file mode 100644 index 00000000..78b04607 --- /dev/null +++ b/lang/cem/libcc/mon/geteuid.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $geteuid + pro $geteuid,0 + loc 24 + mon + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/getgid.e b/lang/cem/libcc/mon/getgid.e new file mode 100644 index 00000000..c52a8c76 --- /dev/null +++ b/lang/cem/libcc/mon/getgid.e @@ -0,0 +1,9 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $getgid + pro $getgid,0 + loc 47 + mon + asp EM_WSIZE + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/getpid.e b/lang/cem/libcc/mon/getpid.e new file mode 100644 index 00000000..f98e7202 --- /dev/null +++ b/lang/cem/libcc/mon/getpid.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $getpid + pro $getpid,0 + loc 20 + mon + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/getuid.e b/lang/cem/libcc/mon/getuid.e new file mode 100644 index 00000000..7367cd2a --- /dev/null +++ b/lang/cem/libcc/mon/getuid.e @@ -0,0 +1,9 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $getuid + pro $getuid,0 + loc 24 + mon + asp EM_WSIZE + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/gtty.c b/lang/cem/libcc/mon/gtty.c new file mode 100644 index 00000000..cf2c769b --- /dev/null +++ b/lang/cem/libcc/mon/gtty.c @@ -0,0 +1,4 @@ +#include +int gtty(fildes,argp) int fildes ; struct sgttyb *argp ; { + return ioctl(fildes,TIOCGETP,argp) ; +} diff --git a/lang/cem/libcc/mon/ioctl.e b/lang/cem/libcc/mon/ioctl.e new file mode 100644 index 00000000..337aab95 --- /dev/null +++ b/lang/cem/libcc/mon/ioctl.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $ioctl + pro $ioctl,0 + lal 0 + loi EM_PSIZE+2*EM_WSIZE + loc 54 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/kill.e b/lang/cem/libcc/mon/kill.e new file mode 100644 index 00000000..49df6c03 --- /dev/null +++ b/lang/cem/libcc/mon/kill.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $kill + pro $kill,0 + ldl 0 + loc 37 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/link.e b/lang/cem/libcc/mon/link.e new file mode 100644 index 00000000..50a1e87a --- /dev/null +++ b/lang/cem/libcc/mon/link.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $link + pro $link,0 + lal 0 + loi 2*EM_PSIZE + loc 9 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/lock.e b/lang/cem/libcc/mon/lock.e new file mode 100644 index 00000000..09faeed6 --- /dev/null +++ b/lang/cem/libcc/mon/lock.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $lock + pro $lock,0 + lol 0 + loc 53 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/lseek.e b/lang/cem/libcc/mon/lseek.e new file mode 100644 index 00000000..282a959b --- /dev/null +++ b/lang/cem/libcc/mon/lseek.e @@ -0,0 +1,25 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $lseek + pro $lseek,0 + lal 0 + loi 4*EM_WSIZE + loc 19 + mon + zeq *1 + ste errno +#if EM_WSIZE==1 + ldc -1 + loc 2 + loc 4 + cii +#endif +#if EM_WSIZE==2 + ldc -1 +#endif +#if EM_WSIZE==4 + loc -1 +#endif +1 + ret 2*EM_WSIZE + end diff --git a/lang/cem/libcc/mon/mknod.e b/lang/cem/libcc/mon/mknod.e new file mode 100644 index 00000000..07329838 --- /dev/null +++ b/lang/cem/libcc/mon/mknod.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $mknod + pro $mknod,0 + lal 0 + loi EM_PSIZE+2*EM_WSIZE + loc 14 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/mount.e b/lang/cem/libcc/mon/mount.e new file mode 100644 index 00000000..8bdfddfd --- /dev/null +++ b/lang/cem/libcc/mon/mount.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $mount + pro $mount,0 + lal 0 + loi EM_WSIZE+2*EM_PSIZE + loc 21 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/mpxcall.e b/lang/cem/libcc/mon/mpxcall.e new file mode 100644 index 00000000..8782b11d --- /dev/null +++ b/lang/cem/libcc/mon/mpxcall.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $mpxcall + pro $mpxcall,0 + lal 0 + loi EM_PSIZE+EM_WSIZE + loc 56 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/nice.e b/lang/cem/libcc/mon/nice.e new file mode 100644 index 00000000..60bda54a --- /dev/null +++ b/lang/cem/libcc/mon/nice.e @@ -0,0 +1,9 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $nice + pro $nice,0 + lol 0 + loc 34 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/open.e b/lang/cem/libcc/mon/open.e new file mode 100644 index 00000000..e6da95e9 --- /dev/null +++ b/lang/cem/libcc/mon/open.e @@ -0,0 +1,14 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $open + pro $open,0 + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 5 + mon + zeq *1 + ste errno + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/pause.e b/lang/cem/libcc/mon/pause.e new file mode 100644 index 00000000..43927720 --- /dev/null +++ b/lang/cem/libcc/mon/pause.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $pause + pro $pause,0 + loc 29 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/pipe.e b/lang/cem/libcc/mon/pipe.e new file mode 100644 index 00000000..133ada6f --- /dev/null +++ b/lang/cem/libcc/mon/pipe.e @@ -0,0 +1,18 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $pipe + pro $pipe,0 + loc 42 + mon + zeq *1 + ste errno + loc -1 + ret EM_WSIZE +1 + lal 0 + loi EM_PSIZE + stf EM_WSIZE + sil 0 + loc 0 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/prof.e b/lang/cem/libcc/mon/prof.e new file mode 100644 index 00000000..53617e4a --- /dev/null +++ b/lang/cem/libcc/mon/prof.e @@ -0,0 +1,10 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $profil + pro $profil,0 + lal 0 + loi 4*EM_PSIZE + loc 44 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/ptrace.e b/lang/cem/libcc/mon/ptrace.e new file mode 100644 index 00000000..2fd4b97e --- /dev/null +++ b/lang/cem/libcc/mon/ptrace.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $ptrace + pro $ptrace,0 + zre errno + lal 0 + loi EM_PSIZE+3*EM_WSIZE + loc 26 + mon + zeq *1 + ste errno + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/read.e b/lang/cem/libcc/mon/read.e new file mode 100644 index 00000000..82e0dd31 --- /dev/null +++ b/lang/cem/libcc/mon/read.e @@ -0,0 +1,23 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $read + pro $read,0 + lol EM_WSIZE+EM_PSIZE + loc EM_WSIZE + loc EM_PSIZE + ciu + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 3 + mon + zne *1 + loc EM_PSIZE + loc EM_WSIZE + cui + bra *2 +1 + ste errno + loc -1 +2 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/sbrk.e b/lang/cem/libcc/mon/sbrk.e new file mode 100644 index 00000000..bed01383 --- /dev/null +++ b/lang/cem/libcc/mon/sbrk.e @@ -0,0 +1,11 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $sbrk + pro $sbrk,0 + lor 2 + lor 2 + lol 0 + ads EM_WSIZE + str 2 ; The - possibly - occurring traps should be caught + ret EM_PSIZE + end diff --git a/lang/cem/libcc/mon/setgid.e b/lang/cem/libcc/mon/setgid.e new file mode 100644 index 00000000..1e9093af --- /dev/null +++ b/lang/cem/libcc/mon/setgid.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $setgid + pro $setgid,0 + lol 0 + loc 46 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/setsig.e b/lang/cem/libcc/mon/setsig.e new file mode 100644 index 00000000..d0a41810 --- /dev/null +++ b/lang/cem/libcc/mon/setsig.e @@ -0,0 +1,45 @@ +# + mes 2,EM_WSIZE,EM_PSIZE +save + bss EM_PSIZE,0,0 +trf + bss EM_PSIZE,0,0 + + exp $_setsig + pro $_setsig,0 + lal 0 + loi EM_PSIZE + lae trf + sti EM_PSIZE + inp $catchit + lpi $catchit ; trap to catchit + sig + lae save ; remember higher level trap + sti EM_PSIZE + ret 0 + end + + pro $catchit,0 + lpi $catchit + sig + asp EM_PSIZE + lol 0 ; fetch trapno + lae trf + loi EM_PSIZE ; fetch procedure identifier + cai + lfr EM_WSIZE + zne *1 + ; trap not handled by trf function, trap through; trapno still on stack + lae save + loi EM_PSIZE + sig + asp EM_PSIZE + trp + lpi $catchit ; trap ignored, further traps to catchit + sig + asp EM_PSIZE + lae save ; remember higher level trap + sti EM_PSIZE +1 + rtt + end diff --git a/lang/cem/libcc/mon/setuid.e b/lang/cem/libcc/mon/setuid.e new file mode 100644 index 00000000..656f5b89 --- /dev/null +++ b/lang/cem/libcc/mon/setuid.e @@ -0,0 +1,15 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $setuid + pro $setuid,0 + lol 0 + loc 23 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/signal.c b/lang/cem/libcc/mon/signal.c new file mode 100644 index 00000000..92884796 --- /dev/null +++ b/lang/cem/libcc/mon/signal.c @@ -0,0 +1,99 @@ +#include + +typedef int (*callvec)() ; + +static callvec vector[16] = { + SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, + SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL, SIG_DFL +} ; + +static char mapvec[] = { + 0, /* EARRAY */ + 0, /* ERANGE */ + 0, /* ESET */ + 0, /* EIOVFL */ + SIGFPE, /* EFOVFL */ + SIGFPE, /* EFUNDFL */ + 0, /* EIDIVZ */ + SIGFPE, /* EFDIVZ */ + 0, /* EIUND, already ignored */ + SIGFPE, /* EFUND */ + 0, /* ECONV */ + 0, /* 11 */ + 0, /* 12 */ + 0, /* 13 */ + 0, /* 14 */ + 0, /* 15 */ + SIGSEGV, /* ESTACK */ + SIGSEGV, /* EHEAP */ + 0, /* EILLINS */ + 0, /* EODDZ */ + 0, /* ECASE */ + SIGSEGV, /* EBADMEM */ + SIGBUS, /* EBADPTR */ + 0, /* EBADPC */ + 0, /* EBADLAE */ + SIGSYS, /* EBADMON */ + 0, /* EBADLIN */ + 0, /* EBADGTO */ +} ; + +#define VECBASE 128 + +static firsttime = 1 ; +static int catchtrp() ; +static int procesig() ; + +callvec signal(sig,func) int sig ; callvec func ; { + register index, i ; + callvec prev ; + + index= sig-1 ; + if ( index<0 || index>=(sizeof vector/sizeof vector[0]) ) { + return (callvec) -1 ; + } + if ( firsttime ) { + firsttime= 0 ; + _setsig(catchtrp) ; + } + prev= vector[index] ; + if ( prev!=func ) { + register int mapval ; + vector[index]= func ; + if ( func==SIG_IGN ) { + mapval= -3; + } else if ( func==SIG_DFL ) { + mapval= -2; + } else { + mapval=VECBASE+sig; + } + if ( sigtrp(mapval,sig)== -1 ) return (callvec) -1; + + } + return prev ; +} + +static int catchtrp(trapno) int trapno ; { + if ( trapno>VECBASE && + trapno<=VECBASE + (sizeof vector/sizeof vector[0]) ) { + return procesig(trapno-VECBASE) ; + } + if ( trapno>=0 && trapno< (sizeof mapvec/sizeof mapvec[0]) && + mapvec[trapno] ) { + return procesig(mapvec[trapno]) ; + } + return 0 ; /* Failed to handle the trap */ +} + +static int procesig(sig) int sig ; { + register index ; + callvec trf ; + + index= sig-1 ; + trf= vector[index] ; + if ( trf==SIG_IGN ) return 1 ; + if ( sig!=SIGILL && sig!=SIGTRAP ) vector[index]= SIG_IGN ; + if ( trf==SIG_DFL ) return 0 ; + (*trf)(sig) ; + return 1 ; +} diff --git a/lang/cem/libcc/mon/sigtrp.e b/lang/cem/libcc/mon/sigtrp.e new file mode 100644 index 00000000..ffaa2318 --- /dev/null +++ b/lang/cem/libcc/mon/sigtrp.e @@ -0,0 +1,13 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $sigtrp + pro $sigtrp,0 + ldl 0 + loc 48 + mon + zeq *1 + ste errno + loc -1 +1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/stat.e b/lang/cem/libcc/mon/stat.e new file mode 100644 index 00000000..d5be7a37 --- /dev/null +++ b/lang/cem/libcc/mon/stat.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $stat + pro $stat,0 + lal 0 + loi 2*EM_PSIZE + loc 18 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/stime.e b/lang/cem/libcc/mon/stime.e new file mode 100644 index 00000000..79a8946e --- /dev/null +++ b/lang/cem/libcc/mon/stime.e @@ -0,0 +1,20 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $stime + pro $stime,0 +#if EM_WSIZE<4 + lol 0 + loi 4 +#else + lil 0 +#endif + loc 25 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/stty.c b/lang/cem/libcc/mon/stty.c new file mode 100644 index 00000000..778b9aec --- /dev/null +++ b/lang/cem/libcc/mon/stty.c @@ -0,0 +1,4 @@ +#include +int stty(fildes,argp) int fildes ; struct sgttyb *argp ; { + return ioctl(fildes,TIOCSETP,argp) ; +} diff --git a/lang/cem/libcc/mon/sync.e b/lang/cem/libcc/mon/sync.e new file mode 100644 index 00000000..476b45de --- /dev/null +++ b/lang/cem/libcc/mon/sync.e @@ -0,0 +1,8 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $sync + pro $sync,0 + loc 36 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/tell.c b/lang/cem/libcc/mon/tell.c new file mode 100644 index 00000000..12e6bf23 --- /dev/null +++ b/lang/cem/libcc/mon/tell.c @@ -0,0 +1,10 @@ +/* + * return offset in file. + */ + +long lseek(); + +long tell(f) +{ + return(lseek(f, 0L, 1)); +} diff --git a/lang/cem/libcc/mon/time.c b/lang/cem/libcc/mon/time.c new file mode 100644 index 00000000..29979d0c --- /dev/null +++ b/lang/cem/libcc/mon/time.c @@ -0,0 +1,9 @@ +#include +#include +time_t time(timpt) time_t *timpt ; { + struct timeb buf ; + + ftime(&buf) ; + if ( timpt ) *timpt= buf.time ; + return buf.time ; +} diff --git a/lang/cem/libcc/mon/times.e b/lang/cem/libcc/mon/times.e new file mode 100644 index 00000000..d347ffcb --- /dev/null +++ b/lang/cem/libcc/mon/times.e @@ -0,0 +1,10 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $times + pro $times,0 + lal 0 + loi EM_PSIZE + loc 43 + mon + ret 0 + end diff --git a/lang/cem/libcc/mon/types b/lang/cem/libcc/mon/types new file mode 100644 index 00000000..868ab0ce --- /dev/null +++ b/lang/cem/libcc/mon/types @@ -0,0 +1,65 @@ +void exit(status) int status ; +int gtty(fildes,argp) int fildes; struct sgttyb *argp ; +int pkon(fd,size) int fd, size ; +int pkoff(fd) int fd ; +char *sbrk(incr) p_int incr ; +void (*signal(sig,func))() int sig ; void (*func)(); +int stty(fildes,argp) int fildes; struct sgttyb *argp ; +long tell(fildes) int fildes ; +time_t time(ptr) time_t *ptr ; +void cleanup() ; +int access(name,mode) char *name ; int mode ; +int acct(file) char *file ; +unsigned alarm(seconds) unsigned seconds ; +int brk(addr) char *addr ; +int chdir(dir) char *dir ; +int chmod(name,mode) char *name ; int mode ; +int chown(name,owner,group) char *name ; int owner, group ; +int chroot(dir) char *dir ; +int close(fildes) int fildes ; +int creat(name) char *name ; +int dup(fildes) int fildes ; +int dup2(fildes,fildes2) int fildes, fildes2 ; +int execl(name,arg0,...,argn,(char*)0) char *name,*arg0,...,*argn ; +int execl(name,arg0,...,argn,(char*)0,envp) char*name,*arg0,...,*argn,*envp[]; +int execv(name,argv) char *name,*argv[] ; +int execve(name,argv,envp) char *name,*argv[],*envp[] ; +void _exit(status) int status ; +int fork() ; +int fstat(fildes,buf) int fildes ; struct stat *buf ; +void ftime(tp) struct timeb *tp ; +int getegid() ; +int geteuid() ; +int getgid() ; +int getpid() ; +int getuid() ; +int ioctl(fildes,request,argp) int fildes, request ; struct sgttyb *buf ; +int kill(pid,sig) int pid, sig ; +int link(name1,name2) char *name1, *name2 ; +int lock(flag) int flag ; +long lseek(fildes,offset,whence) int fildes, whence ; long offset ; +int mknod(name,mode,addr) char *name ; int mode, addr ; +int mount(special,name,rwflag) char *special, *name ; int rwflag ; +int mpxcall(cmd,vec) int cmd, *vec ; +void nice(incr) int incr ; +int open(name,mode) char *name ; int mode ; +void pause() ; +int pipe(files) int files[2] ; +void profil(buff,bufsiz,offset,scale) char *buf; p_int bufsiz,offset,scale; +int ptrace(request,pid,addr,data) int request, pid, *addr, data ; +unsigned read(fildes,buff,nbytes) int fildes ; char *buff ; unsigned nbytes ; +int setgid(gid) int gid ; +int setuid(uid) int uid ; +void _setsig(functionid) char *functionid ; +int sigtrp(trapno,signo) int trapno,signo ; +int stat(name,buf) char *name ; struct stat *buf ; +int stime(tp) long *tp ; +void sync() ; +void times(buffer) struct tbuffer *buffer ; +int umask(complmode) int complmode ; +int umount(special) char *special ; +int unlink(name) char *name ; +int utime(file,timep) char *file ; time_t *timep ; +int wait(status) char status[2] ; +unsigned write(fildes,buff,nbytes) int fildes ; char *buff ; unsigned nbytes ; +int errno ; diff --git a/lang/cem/libcc/mon/umask.e b/lang/cem/libcc/mon/umask.e new file mode 100644 index 00000000..8bcf4fea --- /dev/null +++ b/lang/cem/libcc/mon/umask.e @@ -0,0 +1,9 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $umask + pro $umask,0 + lol 0 + loc 60 + mon + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/umount.e b/lang/cem/libcc/mon/umount.e new file mode 100644 index 00000000..f92b87e8 --- /dev/null +++ b/lang/cem/libcc/mon/umount.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $umount + pro $umount,0 + lal 0 + loi EM_PSIZE + loc 22 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/unlink.e b/lang/cem/libcc/mon/unlink.e new file mode 100644 index 00000000..3313d8ad --- /dev/null +++ b/lang/cem/libcc/mon/unlink.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $unlink + pro $unlink,0 + lal 0 + loi EM_PSIZE + loc 10 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/utime.e b/lang/cem/libcc/mon/utime.e new file mode 100644 index 00000000..50df2364 --- /dev/null +++ b/lang/cem/libcc/mon/utime.e @@ -0,0 +1,16 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $utime + pro $utime,0 + lal 0 + loi 2*EM_PSIZE + loc 30 + mon + zne *1 + loc 0 + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/wait.e b/lang/cem/libcc/mon/wait.e new file mode 100644 index 00000000..a000ce8c --- /dev/null +++ b/lang/cem/libcc/mon/wait.e @@ -0,0 +1,33 @@ +# + mes 2,EM_WSIZE,EM_PSIZE +#if EM_WSIZE<4 +#define STATUS_SIZE 2 +#else +#define STATUS_SIZE EM_WSIZE +#endif + exp $wait + pro $wait,0 + loc 7 + mon + zne *1 + lal 0 + loi EM_PSIZE + zer EM_PSIZE + cms EM_PSIZE + zeq *2 +#if EM_WSIZE==1 + lal 0 + loi EM_PSIZE + sti 2 ; 2 bytes, not one int! +#else + sil 0 +#endif + ret EM_WSIZE +2 + asp STATUS_SIZE + ret EM_WSIZE +1 + ste errno + loc -1 + ret EM_WSIZE + end diff --git a/lang/cem/libcc/mon/write.e b/lang/cem/libcc/mon/write.e new file mode 100644 index 00000000..2e91b5aa --- /dev/null +++ b/lang/cem/libcc/mon/write.e @@ -0,0 +1,23 @@ +# + mes 2,EM_WSIZE,EM_PSIZE + exp $write + pro $write,0 + lol EM_WSIZE+EM_PSIZE + loc EM_WSIZE + loc EM_PSIZE + ciu + lal 0 + loi EM_WSIZE+EM_PSIZE + loc 4 + mon + zne *1 + loc EM_PSIZE + loc EM_WSIZE + cui + bra *2 +1 + ste errno + loc -1 +2 + ret EM_WSIZE + end diff --git a/lang/pc/Makefile b/lang/pc/Makefile new file mode 100644 index 00000000..45a520ac --- /dev/null +++ b/lang/pc/Makefile @@ -0,0 +1,19 @@ +d=../.. +h=$d/h + +cmp: + (cd pem ; make cmp) + +install: + (cd pem ; make install) + +clean: + -rm -f *.o *.old + (cd pem ; make clean) + +opr: + make pr ^ opr + +pr: + @(cd pem ; make pr) + @(cd libpc ; make pr) diff --git a/lang/pc/libpc/LIST b/lang/pc/libpc/LIST new file mode 100644 index 00000000..cccee86a --- /dev/null +++ b/lang/pc/libpc/LIST @@ -0,0 +1,71 @@ +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 diff --git a/lang/pc/libpc/Makefile b/lang/pc/libpc/Makefile new file mode 100644 index 00000000..d4aede6b --- /dev/null +++ b/lang/pc/libpc/Makefile @@ -0,0 +1,13 @@ +# $Header$ + +head: + echo This Makefile needs arguments + +clean: + rm -f *.old + +opr: + make pr | opr + +pr: + @pr Makefile *.[ec] diff --git a/lang/pc/libpc/READ_ME b/lang/pc/libpc/READ_ME new file mode 100644 index 00000000..90712d07 --- /dev/null +++ b/lang/pc/libpc/READ_ME @@ -0,0 +1,11 @@ +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. diff --git a/lang/pc/libpc/abi.c b/lang/pc/libpc/abi.c new file mode 100644 index 00000000..abfe4e9b --- /dev/null +++ b/lang/pc/libpc/abi.c @@ -0,0 +1,23 @@ +/* $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); +} diff --git a/lang/pc/libpc/abl.c b/lang/pc/libpc/abl.c new file mode 100644 index 00000000..9ffbfbe9 --- /dev/null +++ b/lang/pc/libpc/abl.c @@ -0,0 +1,23 @@ +/* $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); +} diff --git a/lang/pc/libpc/abr.c b/lang/pc/libpc/abr.c new file mode 100644 index 00000000..9a8c0bdf --- /dev/null +++ b/lang/pc/libpc/abr.c @@ -0,0 +1,23 @@ +/* $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); +} diff --git a/lang/pc/libpc/arg.c b/lang/pc/libpc/arg.c new file mode 100644 index 00000000..91d01579 --- /dev/null +++ b/lang/pc/libpc/arg.c @@ -0,0 +1,56 @@ +/* $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); +} diff --git a/lang/pc/libpc/ass.c b/lang/pc/libpc/ass.c new file mode 100644 index 00000000..8522d942 --- /dev/null +++ b/lang/pc/libpc/ass.c @@ -0,0 +1,33 @@ +/* $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 +#include + +extern char *_hol0(); +extern _trp(); + +_ass(line,bool) int line,bool; { + + if (bool==0) { + LINO = line; + _trp(EASS); + } +} diff --git a/lang/pc/libpc/asz.c b/lang/pc/libpc/asz.c new file mode 100644 index 00000000..271b882d --- /dev/null +++ b/lang/pc/libpc/asz.c @@ -0,0 +1,29 @@ +/* $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)); +} diff --git a/lang/pc/libpc/atn.c b/lang/pc/libpc/atn.c new file mode 100644 index 00000000..2f88b978 --- /dev/null +++ b/lang/pc/libpc/atn.c @@ -0,0 +1,74 @@ +/* $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)); +} diff --git a/lang/pc/libpc/bcp.c b/lang/pc/libpc/bcp.c new file mode 100644 index 00000000..219c0b15 --- /dev/null +++ b/lang/pc/libpc/bcp.c @@ -0,0 +1,30 @@ +/* $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); +} diff --git a/lang/pc/libpc/bts.e b/lang/pc/libpc/bts.e new file mode 100644 index 00000000..74ed0d4e --- /dev/null +++ b/lang/pc/libpc/bts.e @@ -0,0 +1,56 @@ +# +; $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 ? diff --git a/lang/pc/libpc/buff.c b/lang/pc/libpc/buff.c new file mode 100644 index 00000000..80f54a6e --- /dev/null +++ b/lang/pc/libpc/buff.c @@ -0,0 +1,35 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/catch.c b/lang/pc/libpc/catch.c new file mode 100644 index 00000000..cf72a312 --- /dev/null +++ b/lang/pc/libpc/catch.c @@ -0,0 +1,102 @@ +/* $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 +#include +#include + +#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 +#include + +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; +} diff --git a/lang/pc/libpc/cvt.c b/lang/pc/libpc/cvt.c new file mode 100644 index 00000000..07aff23a --- /dev/null +++ b/lang/pc/libpc/cvt.c @@ -0,0 +1,122 @@ +/* $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)); +} diff --git a/lang/pc/libpc/diag.c b/lang/pc/libpc/diag.c new file mode 100644 index 00000000..ea16c0b7 --- /dev/null +++ b/lang/pc/libpc/diag.c @@ -0,0 +1,34 @@ +/* $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 + +/* 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; +} diff --git a/lang/pc/libpc/dis.c b/lang/pc/libpc/dis.c new file mode 100644 index 00000000..7d8c738e --- /dev/null +++ b/lang/pc/libpc/dis.c @@ -0,0 +1,87 @@ +/* $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 + +#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; +} diff --git a/lang/pc/libpc/efl.c b/lang/pc/libpc/efl.c new file mode 100644 index 00000000..888de603 --- /dev/null +++ b/lang/pc/libpc/efl.c @@ -0,0 +1,36 @@ +/* $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 +#include + +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); +} diff --git a/lang/pc/libpc/eln.c b/lang/pc/libpc/eln.c new file mode 100644 index 00000000..08be0a54 --- /dev/null +++ b/lang/pc/libpc/eln.c @@ -0,0 +1,33 @@ +/* $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 +#include + +extern _trp(); +extern _rf(); + +int _eln(f) struct file *f; { + + _rf(f); + if (f->flags & EOFBIT) + _trp(EEOF); + return((f->flags & ELNBIT) != 0); +} diff --git a/lang/pc/libpc/encaps.e b/lang/pc/libpc/encaps.e new file mode 100644 index 00000000..371c2d4e --- /dev/null +++ b/lang/pc/libpc/encaps.e @@ -0,0 +1,144 @@ +# + + +; $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 ? diff --git a/lang/pc/libpc/exp.c b/lang/pc/libpc/exp.c new file mode 100644 index 00000000..8181f1a1 --- /dev/null +++ b/lang/pc/libpc/exp.c @@ -0,0 +1,106 @@ +/* $Header$ */ + +#include + +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< 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)); +} diff --git a/lang/pc/libpc/fef.e b/lang/pc/libpc/fef.e new file mode 100644 index 00000000..cb797034 --- /dev/null +++ b/lang/pc/libpc/fef.e @@ -0,0 +1,39 @@ +# +; $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 ? diff --git a/lang/pc/libpc/fif.e b/lang/pc/libpc/fif.e new file mode 100644 index 00000000..15b9f821 --- /dev/null +++ b/lang/pc/libpc/fif.e @@ -0,0 +1,41 @@ +# +; $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 ? diff --git a/lang/pc/libpc/get.c b/lang/pc/libpc/get.c new file mode 100644 index 00000000..ec842077 --- /dev/null +++ b/lang/pc/libpc/get.c @@ -0,0 +1,31 @@ +/* $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 +#include + +extern _rf(); +extern _trp(); + +_get(f) struct file *f; { + + _rf(f); + if (f->flags&EOFBIT) + _trp(EEOF); + f->flags &= ~WINDOW; +} diff --git a/lang/pc/libpc/gto.e b/lang/pc/libpc/gto.e new file mode 100644 index 00000000..9ef40d80 --- /dev/null +++ b/lang/pc/libpc/gto.e @@ -0,0 +1,85 @@ +# +; $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 ? diff --git a/lang/pc/libpc/head_pc.e b/lang/pc/libpc/head_pc.e new file mode 100644 index 00000000..ffe9989f --- /dev/null +++ b/lang/pc/libpc/head_pc.e @@ -0,0 +1,3 @@ +# +; $Header$ + mes 2,EM_WSIZE,EM_PSIZE diff --git a/lang/pc/libpc/hlt.c b/lang/pc/libpc/hlt.c new file mode 100644 index 00000000..3cf73072 --- /dev/null +++ b/lang/pc/libpc/hlt.c @@ -0,0 +1,35 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/hol0.e b/lang/pc/libpc/hol0.e new file mode 100644 index 00000000..8db66cf7 --- /dev/null +++ b/lang/pc/libpc/hol0.e @@ -0,0 +1,29 @@ +# + +; $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 ? diff --git a/lang/pc/libpc/incpt.c b/lang/pc/libpc/incpt.c new file mode 100644 index 00000000..9ba7495b --- /dev/null +++ b/lang/pc/libpc/incpt.c @@ -0,0 +1,75 @@ +/* $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 +#include + +#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 + } +} diff --git a/lang/pc/libpc/ini.c b/lang/pc/libpc/ini.c new file mode 100644 index 00000000..bf995862 --- /dev/null +++ b/lang/pc/libpc/ini.c @@ -0,0 +1,73 @@ +/* $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 +#include + +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; + } +} diff --git a/lang/pc/libpc/log.c b/lang/pc/libpc/log.c new file mode 100644 index 00000000..71aa2e6f --- /dev/null +++ b/lang/pc/libpc/log.c @@ -0,0 +1,59 @@ +/* $Header$ */ + +#include + +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 + +extern _trp(); + +int _mdi(j,i) int j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} diff --git a/lang/pc/libpc/mdl.c b/lang/pc/libpc/mdl.c new file mode 100644 index 00000000..8c8272f4 --- /dev/null +++ b/lang/pc/libpc/mdl.c @@ -0,0 +1,33 @@ +/* $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 + +extern _trp(); + +long _mdl(j,i) long j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} diff --git a/lang/pc/libpc/new.c b/lang/pc/libpc/new.c new file mode 100644 index 00000000..10f1685b --- /dev/null +++ b/lang/pc/libpc/new.c @@ -0,0 +1,67 @@ +/* $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; +} diff --git a/lang/pc/libpc/nobuff.c b/lang/pc/libpc/nobuff.c new file mode 100644 index 00000000..10f80cb4 --- /dev/null +++ b/lang/pc/libpc/nobuff.c @@ -0,0 +1,33 @@ +/* $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 + +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; +} diff --git a/lang/pc/libpc/notext.c b/lang/pc/libpc/notext.c new file mode 100644 index 00000000..8a46e5f3 --- /dev/null +++ b/lang/pc/libpc/notext.c @@ -0,0 +1,23 @@ +/* $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 + +notext(f) struct file *f; { + f->flags &= ~TXTBIT; +} diff --git a/lang/pc/libpc/opn.c b/lang/pc/libpc/opn.c new file mode 100644 index 00000000..54966296 --- /dev/null +++ b/lang/pc/libpc/opn.c @@ -0,0 +1,117 @@ +/* $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 +#include + +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; +} diff --git a/lang/pc/libpc/outcpt.c b/lang/pc/libpc/outcpt.c new file mode 100644 index 00000000..8717317b --- /dev/null +++ b/lang/pc/libpc/outcpt.c @@ -0,0 +1,50 @@ +/* $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 +#include + +#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); +} diff --git a/lang/pc/libpc/pac.c b/lang/pc/libpc/pac.c new file mode 100644 index 00000000..8cea845b --- /dev/null +++ b/lang/pc/libpc/pac.c @@ -0,0 +1,50 @@ +/* $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 + +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++; + } +} diff --git a/lang/pc/libpc/pclose.c b/lang/pc/libpc/pclose.c new file mode 100644 index 00000000..88ba88ae --- /dev/null +++ b/lang/pc/libpc/pclose.c @@ -0,0 +1,27 @@ +/* $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 + +extern _cls(); + +/* procedure pclose(var f:file of ??); */ + +pclose(f) struct file *f; { + _cls(f); +} diff --git a/lang/pc/libpc/pcreat.c b/lang/pc/libpc/pcreat.c new file mode 100644 index 00000000..d389ca87 --- /dev/null +++ b/lang/pc/libpc/pcreat.c @@ -0,0 +1,41 @@ +/* $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 +#include + +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); +} diff --git a/lang/pc/libpc/pentry.c b/lang/pc/libpc/pentry.c new file mode 100644 index 00000000..59190fbb --- /dev/null +++ b/lang/pc/libpc/pentry.c @@ -0,0 +1,35 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/perrno.c b/lang/pc/libpc/perrno.c new file mode 100644 index 00000000..3cc6a1b6 --- /dev/null +++ b/lang/pc/libpc/perrno.c @@ -0,0 +1,25 @@ +/* $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); +} diff --git a/lang/pc/libpc/pexit.c b/lang/pc/libpc/pexit.c new file mode 100644 index 00000000..3a472c2d --- /dev/null +++ b/lang/pc/libpc/pexit.c @@ -0,0 +1,33 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/popen.c b/lang/pc/libpc/popen.c new file mode 100644 index 00000000..6533fcaa --- /dev/null +++ b/lang/pc/libpc/popen.c @@ -0,0 +1,41 @@ +/* $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 +#include + +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); +} diff --git a/lang/pc/libpc/put.c b/lang/pc/libpc/put.c new file mode 100644 index 00000000..dcc86e19 --- /dev/null +++ b/lang/pc/libpc/put.c @@ -0,0 +1,27 @@ +/* $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 + +extern _wf(); +extern _outcpt(); + +_put(f) struct file *f; { + _wf(f); + _outcpt(f); +} diff --git a/lang/pc/libpc/rdc.c b/lang/pc/libpc/rdc.c new file mode 100644 index 00000000..17f0708a --- /dev/null +++ b/lang/pc/libpc/rdc.c @@ -0,0 +1,31 @@ +/* $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 + +extern _rf(); +extern _incpt(); + +int _rdc(f) struct file *f; { + int c; + + _rf(f); + c = *f->ptr; + _incpt(f); + return(c); +} diff --git a/lang/pc/libpc/rdi.c b/lang/pc/libpc/rdi.c new file mode 100644 index 00000000..f6b40846 --- /dev/null +++ b/lang/pc/libpc/rdi.c @@ -0,0 +1,78 @@ +/* $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 +#include + +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)); +} diff --git a/lang/pc/libpc/rdl.c b/lang/pc/libpc/rdl.c new file mode 100644 index 00000000..6a3670ce --- /dev/null +++ b/lang/pc/libpc/rdl.c @@ -0,0 +1,41 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/rdr.c b/lang/pc/libpc/rdr.c new file mode 100644 index 00000000..475c4c79 --- /dev/null +++ b/lang/pc/libpc/rdr.c @@ -0,0 +1,78 @@ +/* $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 + +#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); +} diff --git a/lang/pc/libpc/rf.c b/lang/pc/libpc/rf.c new file mode 100644 index 00000000..dee96683 --- /dev/null +++ b/lang/pc/libpc/rf.c @@ -0,0 +1,35 @@ +/* $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 +#include + +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); +} diff --git a/lang/pc/libpc/rln.c b/lang/pc/libpc/rln.c new file mode 100644 index 00000000..16e93c0c --- /dev/null +++ b/lang/pc/libpc/rln.c @@ -0,0 +1,30 @@ +/* $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 + +extern _rf(); +extern _incpt(); + +_rln(f) struct file *f; { + + _rf(f); + while ((f->flags & ELNBIT) == 0) + _incpt(f); + f->flags &= ~WINDOW; +} diff --git a/lang/pc/libpc/rnd.c b/lang/pc/libpc/rnd.c new file mode 100644 index 00000000..0345caa8 --- /dev/null +++ b/lang/pc/libpc/rnd.c @@ -0,0 +1,21 @@ +/* $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)); +} diff --git a/lang/pc/libpc/sav.e b/lang/pc/libpc/sav.e new file mode 100644 index 00000000..4937ddee --- /dev/null +++ b/lang/pc/libpc/sav.e @@ -0,0 +1,49 @@ +# +; $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 ? diff --git a/lang/pc/libpc/sig.e b/lang/pc/libpc/sig.e new file mode 100644 index 00000000..d2c2dcff --- /dev/null +++ b/lang/pc/libpc/sig.e @@ -0,0 +1,34 @@ +#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 ? diff --git a/lang/pc/libpc/sin.c b/lang/pc/libpc/sin.c new file mode 100644 index 00000000..d9817a71 --- /dev/null +++ b/lang/pc/libpc/sin.c @@ -0,0 +1,75 @@ +/* $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)); +} diff --git a/lang/pc/libpc/sqt.c b/lang/pc/libpc/sqt.c new file mode 100644 index 00000000..49803aa2 --- /dev/null +++ b/lang/pc/libpc/sqt.c @@ -0,0 +1,60 @@ +/* $Header$ */ + +#include + +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); +} diff --git a/lang/pc/libpc/string.c b/lang/pc/libpc/string.c new file mode 100644 index 00000000..a36f608a --- /dev/null +++ b/lang/pc/libpc/string.c @@ -0,0 +1,60 @@ +/* $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; +} diff --git a/lang/pc/libpc/trap.e b/lang/pc/libpc/trap.e new file mode 100644 index 00000000..ca6d3c57 --- /dev/null +++ b/lang/pc/libpc/trap.e @@ -0,0 +1,33 @@ +# + +; $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 ? diff --git a/lang/pc/libpc/trp.e b/lang/pc/libpc/trp.e new file mode 100644 index 00000000..9feb9d87 --- /dev/null +++ b/lang/pc/libpc/trp.e @@ -0,0 +1,38 @@ +# + +; $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 ? diff --git a/lang/pc/libpc/unp.c b/lang/pc/libpc/unp.c new file mode 100644 index 00000000..d6673023 --- /dev/null +++ b/lang/pc/libpc/unp.c @@ -0,0 +1,50 @@ +/* $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 + +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++; + } +} diff --git a/lang/pc/libpc/uread.c b/lang/pc/libpc/uread.c new file mode 100644 index 00000000..5e504eb2 --- /dev/null +++ b/lang/pc/libpc/uread.c @@ -0,0 +1,25 @@ +/* $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)); +} diff --git a/lang/pc/libpc/uwrite.c b/lang/pc/libpc/uwrite.c new file mode 100644 index 00000000..7cf7d557 --- /dev/null +++ b/lang/pc/libpc/uwrite.c @@ -0,0 +1,25 @@ +/* $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)); +} diff --git a/lang/pc/libpc/wdw.c b/lang/pc/libpc/wdw.c new file mode 100644 index 00000000..33ac2f77 --- /dev/null +++ b/lang/pc/libpc/wdw.c @@ -0,0 +1,30 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wf.c b/lang/pc/libpc/wf.c new file mode 100644 index 00000000..cd0f2b9f --- /dev/null +++ b/lang/pc/libpc/wf.c @@ -0,0 +1,32 @@ +/* $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 +#include + +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); +} diff --git a/lang/pc/libpc/wrc.c b/lang/pc/libpc/wrc.c new file mode 100644 index 00000000..95b6ea25 --- /dev/null +++ b/lang/pc/libpc/wrc.c @@ -0,0 +1,41 @@ +/* $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 + +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; +} diff --git a/lang/pc/libpc/wrf.c b/lang/pc/libpc/wrf.c new file mode 100644 index 00000000..37531fa4 --- /dev/null +++ b/lang/pc/libpc/wrf.c @@ -0,0 +1,61 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wri.c b/lang/pc/libpc/wri.c new file mode 100644 index 00000000..37bac5aa --- /dev/null +++ b/lang/pc/libpc/wri.c @@ -0,0 +1,44 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wrl.c b/lang/pc/libpc/wrl.c new file mode 100644 index 00000000..e3b8a2ed --- /dev/null +++ b/lang/pc/libpc/wrl.c @@ -0,0 +1,49 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wrr.c b/lang/pc/libpc/wrr.c new file mode 100644 index 00000000..704f8f7c --- /dev/null +++ b/lang/pc/libpc/wrr.c @@ -0,0 +1,56 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wrs.c b/lang/pc/libpc/wrs.c new file mode 100644 index 00000000..b59e0739 --- /dev/null +++ b/lang/pc/libpc/wrs.c @@ -0,0 +1,62 @@ +/* $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 + +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); +} diff --git a/lang/pc/libpc/wrz.c b/lang/pc/libpc/wrz.c new file mode 100644 index 00000000..3fd34138 --- /dev/null +++ b/lang/pc/libpc/wrz.c @@ -0,0 +1,36 @@ +/* $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 + +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); +} diff --git a/lang/pc/pem/Makefile b/lang/pc/pem/Makefile new file mode 100644 index 00000000..ce465ab0 --- /dev/null +++ b/lang/pc/pem/Makefile @@ -0,0 +1,46 @@ +# $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: + rm -f pem22.p ; ln pem.p pem22.p + apc -mpdp -c.m -I$h pem22.p ; rm -f pem22.p + rm -f pem24.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 diff --git a/lang/pc/pem/em_pem.6 b/lang/pc/pem/em_pem.6 new file mode 100644 index 00000000..f9e81729 --- /dev/null +++ b/lang/pc/pem/em_pem.6 @@ -0,0 +1,51 @@ +.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. diff --git a/lang/pc/pem/move.c b/lang/pc/pem/move.c new file mode 100644 index 00000000..b2c32ce1 --- /dev/null +++ b/lang/pc/pem/move.c @@ -0,0 +1,20 @@ +/* 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) ; +} diff --git a/lang/pc/pem/pem.p b/lang/pc/pem/pem.p new file mode 100644 index 00000000..9c4472fd --- /dev/null +++ b/lang/pc/pem/pem.p @@ -0,0 +1,3140 @@ +#include +#include +#include +#include +#include +#include + +{ + (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 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 isp_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 isource; 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 kdigit; + {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 (min2max1) 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 (lvalmax) 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>>>>>>>>>>>} + 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 inil 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 argcmaxargc 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 ixoff 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} diff --git a/lang/pc/test/Makefile b/lang/pc/test/Makefile new file mode 100644 index 00000000..23dedb7c --- /dev/null +++ b/lang/pc/test/Makefile @@ -0,0 +1,36 @@ +# $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 + int -.p callc.p cmod.c ; em + rm -f e.out f? *.k + +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 + apc -.p callc.p cmod.c ; a.out + rm -f a.out f? *.[os] + +install cmp: + +clean: + -rm -f [ea].out f? + +opr: + make pr | opr + +pr: + @pr t[12345].p tstenc.p tstgto.p callc.p cmod.c diff --git a/lang/pc/test/callc.p b/lang/pc/test/callc.p new file mode 100644 index 00000000..003b008d --- /dev/null +++ b/lang/pc/test/callc.p @@ -0,0 +1,50 @@ +program callc(input,output) ; +var success: integer ; +procedure rcsid ; begin writeln('$Header$') end ; +function kwad(val:integer) : integer ; extern ; +procedure cmain ; extern ; +procedure incs ; begin success:=success+1 end ; +procedure pptr( function ptwice(val:integer):integer ) ; extern ; +function ceval( function pinside(val:integer):real ): boolean ; extern ; +function outside(val:integer):real ; +begin + outside:= 1.411 +end ; +procedure envellop ; +var testval: integer ; +function inside(val:integer):real ; +begin + if testval<>1234 then writeln('The static link is incorrect') + else success:=success+1 ; + inside:=sqrt(val) +end ; +begin + testval:=1234 ; + if ceval(inside) then success:=success+1 + else writeln('Calling inside through C doesn''t work'); + if ceval(outside) then success:=success+1 + else writeln('Calling outside through C doesn''t work') +end; +procedure cptr( function pkwad(val:integer):integer ) ; +begin + if ( pkwad(-2)<>4 ) and (pkwad(-8)<>64) then + writeln('Using C function pointers in Pascal doesn''t work') + else + success:=success+1 +end ; +function twice(val:integer) : integer ; +begin + twice:= 2*val +end ; +begin + success:=0 ; + if (kwad(2)<>4) and (kwad(8)<>64) then + writeln('C cals don''t work') + else + success:=success+1 ; + cmain; + pptr(twice) ; + envellop ; + if success <>7 then writeln('Only ',success,' tests passed') + else writeln('All tests passed') +end. diff --git a/lang/pc/test/cmod.c b/lang/pc/test/cmod.c new file mode 100644 index 00000000..060634a7 --- /dev/null +++ b/lang/pc/test/cmod.c @@ -0,0 +1,58 @@ +#include +char rcs_id[] = "$Header$" ; + +typedef struct { + int (*p_func)() ; + char *p_slink ; +} p_fiptr ; + +typedef struct { + double (*p_func)() ; + char *p_slink ; +} p_ffptr ; + +int kwad(val) int val ; { return val*val ; } +cmain() { + p_fiptr p_kwad ; + + /* Test calling pascal procedures */ + if ( twice(7)!=14 || twice(-9)!=-18 ) { + printf("Calling pascal from C doesn't work\n") ; + fflush(stdout) ; + } + else + incs() ; + /* Test passing C function pointers */ + p_kwad.p_slink= (char *)0 ; p_kwad.p_func= kwad ; + cptr(p_kwad) ; +} +pptr(p_twice) p_fiptr p_twice ; { + if ( p_twice.p_slink!=(char *)0 ) { + printf("Pascal outer procedure static link unequal to zero\n") ; + fflush(stdout) ; + } + + if ( p_twice.p_func(-7)!=-14 || p_twice.p_func(9)!=18 ) { + printf("Passing pascal functions to C doesn't work\n") ; + fflush(stdout) ; + } + else incs() ; +} + +double callpas(pasfunc,par) p_ffptr pasfunc ; int par ; { + /* Call a Pascal function, both inner block and outer block */ + /* Function must return a double, (In pascal terms: real) */ + /* and have one integer parameter */ + /* The static link - if present - must be the first parameter */ + if ( pasfunc.p_slink ) { + return (*pasfunc.p_func)(pasfunc.p_slink,par) ; + } else { + return (*pasfunc.p_func)(par) ; + } +} + +int ceval(p_inside) p_ffptr p_inside ; { + double resval ; + resval= callpas(p_inside,2) ; + return resval>1.41 && resval<1.42 ; +} diff --git a/lang/pc/test/machar.p b/lang/pc/test/machar.p new file mode 100644 index 00000000..dd67d3c7 --- /dev/null +++ b/lang/pc/test/machar.p @@ -0,0 +1,226 @@ +{ $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; diff --git a/lang/pc/test/t1.p b/lang/pc/test/t1.p new file mode 100644 index 00000000..2a911615 --- /dev/null +++ b/lang/pc/test/t1.p @@ -0,0 +1,677 @@ +# +{ + (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 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(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 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(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. diff --git a/lang/pc/test/t2.p b/lang/pc/test/t2.p new file mode 100644 index 00000000..f2024b75 --- /dev/null +++ b/lang/pc/test/t2.p @@ -0,0 +1,739 @@ +# +{ + (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 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(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. diff --git a/lang/pc/test/t3.p b/lang/pc/test/t3.p new file mode 100644 index 00000000..dc5134a2 --- /dev/null +++ b/lang/pc/test/t3.p @@ -0,0 +1,333 @@ +{ + (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. diff --git a/lang/pc/test/t4.p b/lang/pc/test/t4.p new file mode 100644 index 00000000..8a3cf1ff --- /dev/null +++ b/lang/pc/test/t4.p @@ -0,0 +1,411 @@ +# +{ + (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. diff --git a/lang/pc/test/t5.p b/lang/pc/test/t5.p new file mode 100644 index 00000000..249ebf73 --- /dev/null +++ b/lang/pc/test/t5.p @@ -0,0 +1,13 @@ +{$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. diff --git a/lang/pc/test/tstenc.p b/lang/pc/test/tstenc.p new file mode 100644 index 00000000..f1841b3f --- /dev/null +++ b/lang/pc/test/tstenc.p @@ -0,0 +1,66 @@ +{ + (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. diff --git a/lang/pc/test/tstgto.p b/lang/pc/test/tstgto.p new file mode 100644 index 00000000..84c5cd4e --- /dev/null +++ b/lang/pc/test/tstgto.p @@ -0,0 +1,75 @@ +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. diff --git a/lib/6500/descr b/lib/6500/descr new file mode 100644 index 00000000..8c5da8c6 --- /dev/null +++ b/lib/6500/descr @@ -0,0 +1,36 @@ +# $Revision$ +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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em {EM}/{LIB}em.vend) + linker +end diff --git a/lib/6800/descr b/lib/6800/descr new file mode 100644 index 00000000..51150184 --- /dev/null +++ b/lib/6800/descr @@ -0,0 +1,29 @@ +# $Revision$ +var w=2 +var i=2 +var p=2 +var s=2 +var l=4 +var f=4 +var d=8 +var NAME=m6800 +var M=6800 +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .s.a + to .out + outfile a.out + program {EM}/lib/{M}/as + mapflag -l* LNAME={EM}/{LIB}* + mapflag -d* ASFL={ASFL?} -d* + args {ASFL?} (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/6805/descr b/lib/6805/descr new file mode 100644 index 00000000..9690b222 --- /dev/null +++ b/lib/6805/descr @@ -0,0 +1,29 @@ +# $Revision$ +var w=2 +var i=2 +var p=2 +var s=2 +var l=4 +var f=4 +var d=8 +var NAME=m6805 +var M=6805 +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .s.a + to .out + outfile a.out + program {EM}/lib/{M}/as + mapflag -l* LNAME={EM}/{LIB}* + mapflag -d* ASFL={ASFL?} -d* + args {ASFL?} (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/6809/descr b/lib/6809/descr new file mode 100644 index 00000000..f08a013c --- /dev/null +++ b/lib/6809/descr @@ -0,0 +1,37 @@ +# $Revision$ +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=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}/be + 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 -d* ASFL={ASFL?} -d* + args {ASFL?} (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/descr/cpm b/lib/descr/cpm new file mode 100644 index 00000000..9575b322 --- /dev/null +++ b/lib/descr/cpm @@ -0,0 +1,29 @@ +# $Revision$ +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=lib/z80/int/tail_ +var RT=lib/z80/int/head_ +var SIZE_F=-sm +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .k.m.a.g + to .out + outfile 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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) + linker +end diff --git a/lib/descr/fe.src b/lib/descr/fe.src new file mode 100644 index 00000000..d1d0a1cc --- /dev/null +++ b/lib/descr/fe.src @@ -0,0 +1,90 @@ +# (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 diff --git a/lib/descr/ibm.nosid b/lib/descr/ibm.nosid new file mode 100644 index 00000000..d334f57b --- /dev/null +++ b/lib/descr/ibm.nosid @@ -0,0 +1,40 @@ +# $Revision$ +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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.e:{TAIL}={EM}/{LIBIBM}em) \ + (.b.c.p:{TAIL}={EM}/{LIBIBM}mon) \ + (.e:{TAIL}={EM}/{LIBIBM}em.vend) + linker +end diff --git a/lib/descr/int b/lib/descr/int new file mode 100644 index 00000000..32be1b44 --- /dev/null +++ b/lib/descr/int @@ -0,0 +1,31 @@ +# $Revision$ +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=lib/int22/tail_ +var RT=lib/int22/head_ +var SIZE_FLAG=-sm +var CPP_F=-Dunix +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .k.m.a.g + to .out + outfile 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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) + linker +end diff --git a/lib/descr/m68k2.macs b/lib/descr/m68k2.macs new file mode 100644 index 00000000..203e7e31 --- /dev/null +++ b/lib/descr/m68k2.macs @@ -0,0 +1,39 @@ +# $Revision$ +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=/lib/{M} +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}* + args (.e:{HEAD}={EM}/{RT}em) \ +({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ +(.p.c.b:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \ +(.c:{TAIL}={EM}/{LIBDIR}/write.s) \ +(.p:{TAIL}={EM}/{LIB}pc) \ +(.b:{TAIL}={EM}/{LIB}bc) \ +(.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ +(.b.c:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \ +(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend) + prep cond + linker +end diff --git a/lib/descr/nascom b/lib/descr/nascom new file mode 100644 index 00000000..db67d200 --- /dev/null +++ b/lib/descr/nascom @@ -0,0 +1,30 @@ +# $Revision$ +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=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}/be + args < + stdout + need .e +end +name asld + from .s.a + to .out + outfile a.out + program {EM}/lib/z80/as + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) ({RTS}:.b.c={EM}/{RT}cc) -o > \ +(.e:{TAIL}={EM}/{LIB}em.1 {EM}/{LIB}em.2) + linker +end diff --git a/lib/descr/net86 b/lib/descr/net86 new file mode 100644 index 00000000..27097aed --- /dev/null +++ b/lib/descr/net86 @@ -0,0 +1,32 @@ +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 diff --git a/lib/descr/sat86 b/lib/descr/sat86 new file mode 100644 index 00000000..ecfa18d8 --- /dev/null +++ b/lib/descr/sat86 @@ -0,0 +1,34 @@ +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 diff --git a/lib/em22/descr b/lib/em22/descr new file mode 100644 index 00000000..32be1b44 --- /dev/null +++ b/lib/em22/descr @@ -0,0 +1,31 @@ +# $Revision$ +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=lib/int22/tail_ +var RT=lib/int22/head_ +var SIZE_FLAG=-sm +var CPP_F=-Dunix +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .k.m.a.g + to .out + outfile 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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) + linker +end diff --git a/lib/em24/descr b/lib/em24/descr new file mode 100644 index 00000000..8570c8c0 --- /dev/null +++ b/lib/em24/descr @@ -0,0 +1,31 @@ +# $Revision$ +var w=2 +var p=4 +var s=2 +var l=4 +var f=4 +var d=8 +var M=int24 +var NAME=int24 +var LIB=lib/int24/tail_ +var RT=lib/int24/head_ +var SIZE_FLAG=-sm +var CPP_F=-Dunix +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .k.m.a.g + to .out + outfile 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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) + linker +end diff --git a/lib/em44/descr b/lib/em44/descr new file mode 100644 index 00000000..215bf854 --- /dev/null +++ b/lib/em44/descr @@ -0,0 +1,31 @@ +# $Revision$ +var w=4 +var p=4 +var s=2 +var l=4 +var f=4 +var d=8 +var M=int44 +var NAME=int44 +var LIB=lib/int44/tail_ +var RT=lib/int44/head_ +var SIZE_FLAG=-sm +var CPP_F=-Dunix +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .k.m.a.g + to .out + outfile 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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) + linker +end diff --git a/lib/i80/descr b/lib/i80/descr new file mode 100644 index 00000000..77cc1ab6 --- /dev/null +++ b/lib/i80/descr @@ -0,0 +1,36 @@ +# $Revision$ +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=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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/i86/descr b/lib/i86/descr new file mode 100644 index 00000000..598aaaec --- /dev/null +++ b/lib/i86/descr @@ -0,0 +1,36 @@ +# $Revision$ +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/{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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p.e:{TAIL}={EM}/{LIB}alo) (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/m68k2/descr b/lib/m68k2/descr new file mode 100644 index 00000000..ca444863 --- /dev/null +++ b/lib/m68k2/descr @@ -0,0 +1,36 @@ +# $Revision$ +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=lib/{M}/tail_ +var RT=lib/{M}/head_ +var CPP_F=-Dunix +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}* + args (.e:{HEAD}={EM}/{RT}em) \ +({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}mon {EM}/lib/{M}/end_em.s) + prep cond + linker +end diff --git a/lib/m68k4/descr b/lib/m68k4/descr new file mode 100644 index 00000000..b02f522c --- /dev/null +++ b/lib/m68k4/descr @@ -0,0 +1,38 @@ +# $Revision$ +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=/lib/{M} +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var CPP_F=-Dunix +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/m68k2/as + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) \ +({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ +(.p.c.b:{TAIL}={EM}/{LIBDIR}/sys1.s) (.p:{TAIL}={EM}/{LIBDIR}/sys2.s) \ +(.c.b:{TAIL}={EM}/{LIBDIR}/write.s) \ +(.p:{TAIL}={EM}/{LIB}pc) (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ +(.c.b:{TAIL}={EM}/{LIB}mon {EM}/{LIB}fake) \ +(.e:{TAIL}={EM}/{LIB}em.rt {EM}/{LIB}em.vend) + prep cond + linker +end diff --git a/lib/ns/descr b/lib/ns/descr new file mode 100644 index 00000000..a0933e4f --- /dev/null +++ b/lib/ns/descr @@ -0,0 +1,27 @@ +# $Revision$ +var w=4 +var p=4 +var s=2 +var l=4 +var f=4 +var d=8 +var NAME=ns +var M=ns +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .s.a + to .out + outfile a.out + program {EM}/lib/{M}/as + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em {EM}/{LIB}em.vend) + linker +end diff --git a/lib/pdp/descr b/lib/pdp/descr new file mode 100644 index 00000000..a79dfaf5 --- /dev/null +++ b/lib/pdp/descr @@ -0,0 +1,42 @@ +# $Revision$ +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=lib/{M}/tail_ +var RT=lib/{M}/head_ +var CPP_F=-Dunix +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 as + from .s + to .o + program /bin/as + args - -o > < + prep cond +end +name ld + from .o.a + to .out + outfile a.out + program /bin/ld + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.e:{TAIL}={EM}/{LIB}em) (.c.p:{TAIL}=/lib/libc.a) + linker +end diff --git a/lib/pmds/descr b/lib/pmds/descr new file mode 100644 index 00000000..957a9fdd --- /dev/null +++ b/lib/pmds/descr @@ -0,0 +1,52 @@ +# $Revision$ +# Script for use of ACK as cross C-compiler on VAX for PMDS machine +# The output has its int's in the pmds order. +# Conversion from VU-a.out to PMDS-a.out should still be done on the pmds. +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 PMDS=pmds +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var PMDSLIB=lib/{PMDS}/tail_ +var PMDSRT=lib/{PMDS}/head_ +var INCLUDES=-I{EM}/include +var CPP_F=-Dunix +name be + from .m.g + to .o + program {EM}/lib/{M}/cg + args < + stdout + need .e +end +name asld + from .s.a.o + to .out + program {EM}/lib/{M}/as + mapflag -l + mapflag -d* + mapflag -s* + mapflag -n* + mapflag -i* + args {LFLAG?} (.e:{HEAD}={EM}/{PMDSRT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.e:{TAIL}={EM}/{LIB}em.rt {EM}/{PMDSLIB}mon {EM}/{LIB}em.vend) + prep cond + linker +end +name cv + from .out + to .cv + program {EM}/lib/{PMDS}/pmcv + args < > + outfile a.out +end diff --git a/lib/s2650/descr b/lib/s2650/descr new file mode 100644 index 00000000..ac6dfbaa --- /dev/null +++ b/lib/s2650/descr @@ -0,0 +1,27 @@ +# $Revision$ +var w=2 +var p=2 +var s=2 +var l=4 +var f=4 +var d=8 +var NAME=s2650 +var M=s2650 +var LIB=lib/{M}/tail_ +var RT=lib/{M}/head_ +var INCLUDES=-I{EM}/include -I/usr/include +name asld + from .s.a + to .out + outfile a.out + program {EM}/lib/{M}/as + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/vax4/descr.src b/lib/vax4/descr.src new file mode 100644 index 00000000..87194ec3 --- /dev/null +++ b/lib/vax4/descr.src @@ -0,0 +1,52 @@ +# $Revision$ +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=lib/{M}/tail_ +var RT=lib/{M}/head_ +var CPP_F=-Dunix +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 asopt + from .s + to .so + program /bin/sed + args -f {EM}/lib/{M}/sedf + optimizer + stdin + stdout +end +name as + from .s.so + to .o + program /bin/as + args - -o > < + prep cond +end +name ld + from .o.a + to .out + outfile a.out + program /bin/ld + mapflag -l* LNAME={EM}/{LIB}* + args (.e:{HEAD}={EM}/{RT}em) \ + ({RTS}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/vax4/sedf b/lib/vax4/sedf new file mode 100644 index 00000000..b26db01c --- /dev/null +++ b/lib/vax4/sedf @@ -0,0 +1,104 @@ +# $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 +} diff --git a/lib/z80/descr b/lib/z80/descr new file mode 100644 index 00000000..7510f834 --- /dev/null +++ b/lib/z80/descr @@ -0,0 +1,36 @@ +# $Revision$ +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=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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/lib/z8000/descr b/lib/z8000/descr new file mode 100644 index 00000000..cc603ad2 --- /dev/null +++ b/lib/z8000/descr @@ -0,0 +1,36 @@ +# $Revision$ +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=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}:.b.c={EM}/{RT}cc) ({RTS}:.p={EM}/{RT}pc) -o > < \ + (.p:{TAIL}={EM}/{LIB}pc) \ + (.b:{TAIL}={EM}/{LIB}bc) \ + (.b.c:{TAIL}={EM}/{LIB}cc.1s {EM}/{LIB}cc.2g) \ + (.b.c.p:{TAIL}={EM}/{LIB}mon) \ + (.e:{TAIL}={EM}/{LIB}em) + linker +end diff --git a/mach/6500/Action b/mach/6500/Action new file mode 100644 index 00000000..f44879f1 --- /dev/null +++ b/mach/6500/Action @@ -0,0 +1,21 @@ +name "MSC6500 assembler" +dir as +end +name "MSC6500 backend" +dir cg +end +name "MSC6500 download program(s)" +dir dl +end +name "MSC6500 C libraries" +dir libcc +end +name "MSC6500 EM library" +dir libem +end +name "MSC6500 Pascal library" +dir libpc +end +name "MSC6500 Basic library" +dir libbc +end diff --git a/mach/6500/cg/Makefile b/mach/6500/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/6500/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/6500/cg/mach.c b/mach/6500/cg/mach.c new file mode 100644 index 00000000..3fe8e7e5 --- /dev/null +++ b/mach/6500/cg/mach.c @@ -0,0 +1,83 @@ +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 */ +}; diff --git a/mach/6500/cg/mach.h b/mach/6500/cg/mach.h new file mode 100644 index 00000000..ddc79113 --- /dev/null +++ b/mach/6500/cg/mach.h @@ -0,0 +1,26 @@ +/* $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 diff --git a/mach/6500/cg/table b/mach/6500/cg/table new file mode 100644 index 00000000..fa3f8cbb --- /dev/null +++ b/mach/6500/cg/table @@ -0,0 +1,2294 @@ +"$Header$" +#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 = ("",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") diff --git a/mach/6500/dl/Makefile b/mach/6500/dl/Makefile new file mode 100644 index 00000000..198cae5d --- /dev/null +++ b/mach/6500/dl/Makefile @@ -0,0 +1,19 @@ +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 diff --git a/mach/6500/dl/dl.c b/mach/6500/dl/dl.c new file mode 100644 index 00000000..0ee9eb2e --- /dev/null +++ b/mach/6500/dl/dl.c @@ -0,0 +1,164 @@ +/* + * (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 +#include +#include + +struct sgttyb tty; + +#define DATTYPE 0 +#define EOFTYPE 1 +#define SEGTYPE 2 +#define PCTYPE 3 + +#define MAXBYTE 0x18 + +int check; +int records; +int echo; +int bytecount; +int ttyfd; + +char *progname; + +char hex[] = "0123456789ABCDEF"; + +main(argc,argv) char **argv; { + register nd,pc,sg,osg,first; + register char *s; + + 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); + ttyfd = 1; + first = 1; osg = 0; + for (;;) { + pc = get2c(stdin); + if (feof(stdin)) + break; + sg = get2c(stdin); + nd = get2c(stdin); + if (first) { + first = 0; + } + assert(sg == osg); + while (nd > MAXBYTE) { + data(MAXBYTE,pc); + nd -= MAXBYTE; + pc += MAXBYTE; + } + if (nd > 0) + data(nd,pc); + assert(feof(stdin) == 0); + } + if (first == 0) + eof(); + if (echo) + for (;;) + reply(); +} + +data(nd,pc) { + + newline(nd,pc,DATTYPE); + do + byte(getc(stdin)); + while (--nd); + endline(); +} + +eof() { + + newline(0,records,EOFTYPE); + endline(); +} + +newline(n,pc,typ) { + + records++; + put(';'); + byte(n); + check = 0; + bytecount = n+4; + word(pc); +} + +endline() { + + word(check); + put('\r'); + put('\n'); + assert(bytecount == 0); +put(0); +put(0); +put(0); +put(0); +put(0); +put(0); +} + +word(w) { + + byte(w>>8); + byte(w); +} + +byte(b) { + +b &= 0377; + check += b; + --bytecount; + put(hex[(b>>4) & 017]); + put(hex[b & 017]); +} + +put(c) { + + write(ttyfd,&c,1); +} + +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); +} diff --git a/mach/6500/libbc/Makefile b/mach/6500/libbc/Makefile new file mode 100644 index 00000000..2be55a0a --- /dev/null +++ b/mach/6500/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=6500" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/6500/libbc/compmodule b/mach/6500/libbc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/6500/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/6500/libcc/Makefile b/mach/6500/libcc/Makefile new file mode 100644 index 00000000..7b71f656 --- /dev/null +++ b/mach/6500/libcc/Makefile @@ -0,0 +1,37 @@ +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 diff --git a/mach/6500/libcc/compmodule b/mach/6500/libcc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/6500/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/6500/libem/LIST b/mach/6500/libem/LIST new file mode 100644 index 00000000..e6a56ca4 --- /dev/null +++ b/mach/6500/libem/LIST @@ -0,0 +1,94 @@ +tail_em.s.a +adi.s +adi4.s +and.s +asp.s +cii.s +cmi.s +cmi4.s +cms.s +cmu.s +cmu4.s +com.s +csa.s +csb.s +dup.s +dvi.s +dvi4.s +dvu.s +dvu4.s +exg.s +exg2.s +gto.s +indir.s +inn.s +ior.s +lar.s +lcs.s +loi.s +loi1.s +loil.s +lol.s +los.s +lxa1.s +lxa2.s +lxl.s +mli4.s +mlu.s +mlu4.s +mon.s +mul4.s +ngi4.s +printstack.s +printhex.s +pro.s +read.s +ret.s +rmi.s +rmi4.s +div4.s +rmu.s +rmu4.s +duv4.s +rol.s +rol4.s +ror.s +ror4.s +rtt.s +sar.s +mli.s +ngi.s +sbi4.s +addsub.s +sdl.s +set.s +sli.s +sli4.s +sri.s +sri4.s +sti.s +sti1.s +stil.s +blm.s +stl.s +sts.s +teq.s +test2.s +testFFh.s +tge.s +tgt.s +tle.s +tlt.s +tne.s +dum_float.s +trap.s +ldi.s +print.s +write.s +xor.s +zer.s +zri.s +locaddr.s +data.s +aar.s +sbi.s diff --git a/mach/6500/libem/Makefile b/mach/6500/libem/Makefile new file mode 100644 index 00000000..55dc6ee7 --- /dev/null +++ b/mach/6500/libem/Makefile @@ -0,0 +1,23 @@ +install: tail_em.s.a tail_em.ve.s.a + ../../install head_em.s head_em + ../../install tail_em.s.a tail_em + ../../install tail_em.ve.s.a tail_em.vend + +cmp: tail_em.s.a tail_em.ve.s.a + -../../compare head_em.s head_em + -../../compare tail_em.s.a tail_em + -../../compare tail_em.ve.s.a tail_em.vend + +distr: tail_em.ve.s.a + +tail_em.s.a: + arch cr `cat LIST` + +tail_em.ve.s.a: + arch cr tail_em.ve.s.a end.s + +opr: + make pr | opr +pr: + @pr `pwd`/Makefile `pwd`/head_em.s + @pr -l33 `tail +1 LIST|sort` `pwd`/end.s diff --git a/mach/6500/libem/aar.s b/mach/6500/libem/aar.s new file mode 100644 index 00000000..4f65ca87 --- /dev/null +++ b/mach/6500/libem/aar.s @@ -0,0 +1,31 @@ +.define Aar + +! This subroutine gets the address of the array element + + +Aar: + stx ADDR ! address of descriptor (lowbyte) + sta ADDR+1 ! address of descriptor (highbyte) + ldy #0 + lda (ADDR),y ! lowerbound (lowbyte) + tax + iny + lda (ADDR),y ! lowerbound (highbyte) + jsr Sbi2 ! index - lowerbound + jsr Push + 2: ldy #4 + lda (ADDR),y ! objectsize (lowbyte) + sta NBYTES + tax + iny + lda (ADDR),y ! objectsize (highbyte) + sta NBYTES+1 + bne 5f + cpx #1 ! objectsize = 1 then return + bne 5f ! arrayaddress + index + jsr Pop + jmp Adi2 + 5: jsr Mli2 ! objectsize > 1 then return + jmp Adi2 ! arrayaddress + index * objectsize + + diff --git a/mach/6500/libem/addsub.s b/mach/6500/libem/addsub.s new file mode 100644 index 00000000..07ad393e --- /dev/null +++ b/mach/6500/libem/addsub.s @@ -0,0 +1,27 @@ +.define Addsub + +! This subroutine is used by the fourbyte addition and subtraction +! routines. +! It puts the address of the second operand into +! the zeropage locations ADDR and ADDR+1 +! The address of the first operand is put into +! zeropage locations ADDR+2 and ADDR+3. + + +Addsub: + clc + lda SP+2 + sta ADDR ! address of second operand (lowbyte) + adc #4 + sta SP+2 + sta ADDR+2 ! address of first operand (lowbyte) + lda SP+1 + sta ADDR+1 ! address of second operand (highbyte) + adc #0 + sta ADDR+3 ! address of first operand (highbyte) + sta SP+1 + ldy #0 + ldx #0FCh ! do it 4 times + rts + + diff --git a/mach/6500/libem/adi.s b/mach/6500/libem/adi.s new file mode 100644 index 00000000..7dc95651 --- /dev/null +++ b/mach/6500/libem/adi.s @@ -0,0 +1,22 @@ +.define Adi2 + +! This subroutine adds two twobyte integers. +! The first operand is on the top of the stack, the second operand +! is in the AX registerpair. +! The result is returned in registerpair AX. + + +Adi2: + sta ARTH+1 ! second operand (highbyte) + stx ARTH ! second operand (lowbyte) + jsr Pop ! get first operand + pha ! save A + clc + txa + adc ARTH ! add lowbytes + tax + pla ! get A + adc ARTH+1 ! add the highbytes + rts + + diff --git a/mach/6500/libem/adi4.s b/mach/6500/libem/adi4.s new file mode 100644 index 00000000..80f58f30 --- /dev/null +++ b/mach/6500/libem/adi4.s @@ -0,0 +1,20 @@ +.define Adi4 + +! This subroutine adds two fourbyte integers, which are on the stack. +! The addresses are initiated by the subroutine Addsub. +! Also the loopvariable (register X) is initiated by that routine. +! The result is pushed back onto the stack + + +Adi4: + jsr Addsub ! initiate addresses + clc + 1: lda (ADDR+2),y ! get byte first operand + adc (ADDR),y ! add to byte second operand + sta (ADDR+2),y ! push on real stack + iny + inx + bne 1b ! do it 4 times + rts + + diff --git a/mach/6500/libem/and.s b/mach/6500/libem/and.s new file mode 100644 index 00000000..c626f0eb --- /dev/null +++ b/mach/6500/libem/and.s @@ -0,0 +1,34 @@ +.define And + +! This subroutine performs the logical and on two groups of +! atmost 254 bytes. The number of bytes is in register Y. +! The two groups are on the stack. +! First the value of the stackpointer is saved in zeropage +! locations ADDR, ADDR+1. Then an offset of Y is added +! and stored in ADDR+2, ADDR+3. +! The result is pushed back on the stack. + + +And: + lda SP+1 + sta ADDR+1 ! address of first group (lowbyte) + lda SP+2 + sta ADDR ! address of first group (highbyte) + clc + tya + adc SP+2 + sta SP+2 ! new stackpointer (lowbyte) + sta ADDR+2 ! stackpointer + Y (lowbyte) + lda #0 + adc SP+1 + sta SP+1 ! new stackpointer (highbyte) + sta ADDR+3 ! stackpointer + Y (highbyte) + 1: dey + lda (ADDR),y ! get byte first group + and (ADDR+2),y ! perform logical and with second group + sta (ADDR+2),y ! push result on real_stack + tya + bne 1b ! do it n times + rts + + diff --git a/mach/6500/libem/asp.s b/mach/6500/libem/asp.s new file mode 100644 index 00000000..1581942c --- /dev/null +++ b/mach/6500/libem/asp.s @@ -0,0 +1,20 @@ +.define Asp + +! This subroutine adds an offset to the stackpointer, +! e.g. after the return from a procedurecall. +! The offset is in registerpair AX, and is added to the +! stackpointer. + + +Asp: + tay ! save A + txa ! get X + clc + adc SP+2 ! add adjustment (lowbyte) + sta SP+2 ! new stackpointer (lowbyte) + tya ! get A + adc SP+1 ! add adjustment (highbyte) + sta SP+1 ! get stackpointer (highbyte) + rts + + diff --git a/mach/6500/libem/blm.s b/mach/6500/libem/blm.s new file mode 100644 index 00000000..df8cb061 --- /dev/null +++ b/mach/6500/libem/blm.s @@ -0,0 +1,33 @@ +.define Blm, Blmnp + +! This subroutine copies bytes from one place in memory to +! another. The source address is in registerpair AX and is stored +! in zeropage locations ADDR and ADDR+1. +! The destination address is popped from the stack and stored in +! zeropage locations ADDR+2 and ADDR+3. +! The number of bytes to be copied is in register Y (lowbyte) and +! zeropage location NBYTES+1 (highbyte). +! The subroutine Blmnp is used when the source and destination +! addresses are already in zeropage. + + +Blm: + stx ADDR+2 ! source address (lowbyte) + sta ADDR+3 ! source address (highbyte) + jsr Pop + stx ADDR ! destination address (lowbyte) + sta ADDR+1 ! destination address (highbyte) +Blmnp: ldx NBYTES+1 + 1: dey + lda (ADDR),y ! get source byte + sta (ADDR+2),y ! copy to destination + tya + bne 1b + dec ADDR+1 ! 256 bytes copied + dec ADDR+3 ! decrement source and destination address + ldy #0 + dex + bne 1b ! do it n times + rts + + diff --git a/mach/6500/libem/cii.s b/mach/6500/libem/cii.s new file mode 100644 index 00000000..1eff4214 --- /dev/null +++ b/mach/6500/libem/cii.s @@ -0,0 +1,50 @@ +.define Cii + +! This subroutine converts integers to integers. +! Convertions of integers with the same source size as destination +! size aren't done, there just return the source. +! A convertion from 4 bytes to 2 bytes just strips the two +! most significant bytes. +! A convertion from 2 bytes to 4 bytes tests the sign of the +! source so that sign extentension takes place if neccesairy. + + +Cii: + cpx #2 + beq Cii_2 ! a conversion from ? to 2 + jsr Pop ! a conversion from 4 to ? + cpx #4 + beq 8f ! a conversion 4 to 4 (skip) + jsr Pop + tay ! save A for sign test + pha ! save A + txa + pha ! save X + tya ! test on negative + bmi 1f ! negative means sign extension + lda #0 ! no sign extension here + tax + beq 2f + 1: lda #0FFh ! sign extension here + tax + 2: jsr Push ! push twobyte integer + pla + tax ! get X + pla ! get A + jmp Push +Cii_2: ! a conversion from 2 to ? + jsr Pop + cpx #2 + beq 8f ! a conversion from 2 to 2 (skip) + jsr Pop ! a conversion from 4 to 2 + pha ! save A + txa + pha ! save X + jsr Pop ! strip most significant bytes + pla ! get X + tax + pla ! get A + jmp Push ! push result + 8: rts + + diff --git a/mach/6500/libem/cmi.s b/mach/6500/libem/cmi.s new file mode 100644 index 00000000..ada74148 --- /dev/null +++ b/mach/6500/libem/cmi.s @@ -0,0 +1,26 @@ +.define Cmi + +! This subroutine compares on two integers. +! If T is pushed first and than S, the routine will return: +! -1 if S < T, +! 0 if S = T, +! 1 if S > T. + + +Cmi: + jsr Sbi2 ! subtract operands (T - S) + bpl 1f ! S >= T + lda #0FFh ! S < T + tax ! AX becomes -1 + rts + 1: beq 2f + 3: lda #0 ! S > T + ldx #1 ! AX becomes 1 + rts + 2: txa + bne 3b + lda #0 ! S = T + tax ! AX becomes 0 + rts + + diff --git a/mach/6500/libem/cmi4.s b/mach/6500/libem/cmi4.s new file mode 100644 index 00000000..53416360 --- /dev/null +++ b/mach/6500/libem/cmi4.s @@ -0,0 +1,37 @@ +.define Cmi4 + +! This subroutine compares on fourbyte integers. +! If T is pushed first and than S, the routine will return: +! -1 if S < T, +! 0 if S = T, +! 1 if S > T. + + +Cmi4: + jsr Sbi4 ! subtract operands (T - S) + jsr Pop ! get result (lowbyte, lowbyte+1) + stx ARTH ! store lowbyte + sta ARTH+1 ! store lowbyte+1 + jsr Pop ! get result (lowbyte+2, lowbyte+3) + tay ! test lowbyte+3 + bpl 1f ! S >= T + lda #0FFh ! S < T + tax ! AX becomes -1 + rts + 1: cmp #0 ! test lowbyte+3 on zero + bne 2f + cpx #0 ! test lowbyte+2 on zero + bne 2f + lda #0 + cmp ARTH+1 ! test lowbyte+1 on zero + bne 2f + cmp ARTH ! test lowbyte on zero + bne 2f + lda #0 ! S = T + tax ! AX becomes 0 + rts + 2: lda #0 ! S > T + ldx #1 ! AX becomes 1 + rts + + diff --git a/mach/6500/libem/cms.s b/mach/6500/libem/cms.s new file mode 100644 index 00000000..1105b16e --- /dev/null +++ b/mach/6500/libem/cms.s @@ -0,0 +1,46 @@ +.define Cms + +! This subroutine compares two groups of bytes, bit for bit. +! The groups can consist of 2 or 4 bytes. This number is in +! register Y. +! The address of the first group is stored in zeropage locations +! ADDR and ADDR+1, the address of the second group in ADDR+2 and ADDR+3 +! The routine returns a 0 on equality, a 1 otherwise. + + + +Cms: + lda SP+2 + ldx SP+1 + sta ADDR ! address of first group (lowbyte) + stx ADDR+1 ! address of second group (highbyte) + clc + tya + adc SP+2 + sta SP+2 + sta ADDR+2 ! address of second group (lowbyte) + txa + adc #0 + sta ADDR+3 ! address of second group (highbyte) + tax + clc + tya + adc SP+2 + sta SP+2 ! new stackpointer (lowbyte) + txa + adc #0 + sta SP+1 ! new stackpointer (highbyte) + 1: dey + lda (ADDR),y ! get byte first group + cmp (ADDR+2),y ! compare bit for bit with byte second group + bne 2f + tya + bne 1b + lda #0 ! both groups are equal + tax + rts + 2: lda #0 ! there is a difference between the groups + ldx #1 + rts + + diff --git a/mach/6500/libem/cmu.s b/mach/6500/libem/cmu.s new file mode 100644 index 00000000..5c55ff5f --- /dev/null +++ b/mach/6500/libem/cmu.s @@ -0,0 +1,30 @@ +.define Cmu2 + +! This subroutine compares two unsigned twobyte integers. +! If T is the first pushed and than S, the routine will return: +! -1 if S < T, +! 0 if S = T, +! 1 if S > T. + +Cmu2: + stx EXG ! S (lowbyte) + sta EXG+1 ! S (highbyte) + jsr Pop ! get T + cmp EXG+1 + beq 2f ! S (highbyte) = T (highbyte) + bcc 1f + 4: lda #0 ! S > T + ldx #1 + rts + 1: lda #0FFh ! S < T + tax + rts + 2: cpx EXG + bne 3f + lda #0 ! S = T + tax + rts + 3: bcc 1b + bcs 4b + + diff --git a/mach/6500/libem/cmu4.s b/mach/6500/libem/cmu4.s new file mode 100644 index 00000000..2275e9f9 --- /dev/null +++ b/mach/6500/libem/cmu4.s @@ -0,0 +1,45 @@ +.define Cmu4 + +! This subroutine compares two unsigned fourbyte integers. +! If T is first pushed and than S the routine will return: +! -1 if S < T, +! 0 if S = T, +! 1 if S > T. + + +Cmu4: + lda #ARTH + sta ADDR + lda #0 + sta ADDR+1 + jsr Sdo ! store S in zeropage ARTH - ARTH+3 + lda #ARTH+4 + sta ADDR + jsr Sdo ! store T in zeropage ARTH+4 - ARTH+7 + lda ARTH+7 + cmp ARTH+3 + bcc 3f ! S (lowbyte+3) < T (lowbyte+3) + bne 2f ! S (lowbyte+3) < T (lowbyte+3) + lda ARTH+6 + cmp ARTH+2 + bcc 3f ! S (lowbyte+2) < T (lowbyte+2) + bne 2f ! S (lowbyte+2) < T (lowbyte+2) + lda ARTH+5 + cmp ARTH+1 + bcc 3f ! S (lowbyte+1) < T (lowbyte+1) + bne 2f ! S (lowbyte+1) < T (lowbyte+1) + lda ARTH+4 + cmp ARTH + bcc 3f ! S (lowbyte+0) < T (lowbyte+0) + bne 2f ! S (lowbyte+0) < T (lowbyte+0) + lda #0 + tax ! S = T + rts + 2: lda #0 ! S > T + ldx #1 + rts + 3: lda #0FFh ! S < T + tax + rts + + diff --git a/mach/6500/libem/com.s b/mach/6500/libem/com.s new file mode 100644 index 00000000..300794f1 --- /dev/null +++ b/mach/6500/libem/com.s @@ -0,0 +1,21 @@ +.define Com + +! This subroutine performs a one complement on +! a group of atmost 254 bytes (number in register Y). +! This group is on the top of the stack. + + +Com: + lda SP+1 + sta ADDR+1 ! address (highbyte) of first byte + lda SP+2 + sta ADDR ! address (lowbyte) of first byte + 1: dey + lda (ADDR),y + eor #0FFh ! one complement + sta (ADDR),y + tya + bne 1b ! do it n times + rts + + diff --git a/mach/6500/libem/csa.s b/mach/6500/libem/csa.s new file mode 100644 index 00000000..61a88b5f --- /dev/null +++ b/mach/6500/libem/csa.s @@ -0,0 +1,71 @@ +.define Csa + +! This subroutine performs the case jump by indexing. +! The zeropage locations ADDR, ADDR+1 contain the address of +! the case descriptor which also is the address of the +! default pointer. +! The zeropage locations ADDR+2, ADDR+3 contain the address of the +! indextable which is the casedescriptor + 6. + +Csa: + stx ADDR ! address of descriptor (lowbyte) + sta ADDR+1 ! address of descriptor (highbyte) + tay + txa + clc + adc #6 + sta ADDR+2 ! address of index table (lowbyte) + tya + adc #0 + sta ADDR+3 ! address of index table (highbyte) + jsr Pop ! fetch index + pha ! subtract lowerbound + txa + ldy #2 + sec + sbc (ADDR),y + sta ARTH ! lowerbound (lowbyte) + pla + iny + sbc (ADDR),y + sta ARTH+1 ! lowerbound (highbyte) + bmi 1f ! index < lowerbound + ldy #5 + lda (ADDR),y + cmp ARTH+1 + bcc 1f ! index (highbyte) > upperbound - lowerbound + bne 2f ! index (highbyte) <= upperbound - lowerbound + dey + lda (ADDR),y + cmp ARTH + bcc 1f ! index (lowbyte) > upperbound - lowerbound + 2: asl ARTH + rol ARTH+1 ! index * 2 + clc + lda ADDR+2 + adc ARTH + sta ADDR+2 ! address of pointer (lowbyte) + lda ADDR+3 + adc ARTH+1 + sta ADDR+3 ! address of pointer (highbyte) + ldy #0 + lda (ADDR+2),y ! jump address (lowbyte) + tax + iny + lda (ADDR+2),y ! jump address (highbyte) + bne 3f + cpx #0 + beq 1f + 3: stx ADDR ! pointer <> 0 + sta ADDR+1 + jmp (ADDR) ! jump to address + 1: ldy #0 ! pointer = 0 + lda (ADDR),y ! get default pointer (lowbyte) + tax + iny + lda (ADDR),y ! get default pointer (highbyte) + bne 3b + cpx #0 + bne 3b ! default pointer <> 0 + + diff --git a/mach/6500/libem/csb.s b/mach/6500/libem/csb.s new file mode 100644 index 00000000..37185097 --- /dev/null +++ b/mach/6500/libem/csb.s @@ -0,0 +1,62 @@ +.define Csb + +! This subroutine performs the case jump by searching the table. +! The zeropage locations ADDR, ADDR+1 contain the address of the +! case descriptor, which also is the address of the default pointer. +! The zeropage locations ADDR+2, ADDR+3 are used to address the jump +! pointers. + + +Csb: + stx ADDR ! address of descriptor (lowbyte) + sta ADDR+1 ! address of descriptor (highbyte) + stx ADDR+2 + sta ADDR+3 + ldy #2 + lda (ADDR),y ! number of entries (lowbyte) + pha + jsr Pop + stx ARTH ! index (lowbyte) + sta ARTH+1 ! index (highbyte) + pla + tax + inx + 2: clc + lda #4 + adc ADDR+2 + sta ADDR+2 ! pointer (lowbyte) + bcc 1f + lda #0 + adc ADDR+3 + sta ADDR+3 ! pointer (highbyte) + 1: ldy #0 + lda (ADDR+2),y + cmp ARTH + bne 3f ! pointer (lowbyte) <> index (lowbyte) + iny + lda (ADDR+2),y + cmp ARTH+1 + bne 3f ! pointer (highbyte) <> index (highbyte) + iny + lda (ADDR+2),y ! jump address (lowbyte) + tax + iny + lda (ADDR+2),y ! jump address (highbyte) + jmp 4f + 3: dex + bne 2b + 5: ldy #0 + lda (ADDR),y ! default pointer (lowbyte) + tax + iny + lda (ADDR),y ! default pointer (highbyte) + beq 1f + 4: bne 1f ! pointer (lowbyte) <> 0 + cpx #0 + bne 1f ! pointer (highbyte) <> 0 + beq 5b ! get default pointer + 1: stx ADDR + sta ADDR+1 + jmp (ADDR) ! jump + + diff --git a/mach/6500/libem/data.s b/mach/6500/libem/data.s new file mode 100644 index 00000000..61da1b98 --- /dev/null +++ b/mach/6500/libem/data.s @@ -0,0 +1,36 @@ +.define EARRAY,ERANGE,ESET,EIOVFL +.define ECONV,ESTACK +.define EHEAP,EODDZ,ECASE +.define EBADMON,EBADLIN,EBADGTO + +! This file contains the global data used by the trap routine. + + +! DATA +.data +EARRAY: +.asciz "Array bound error\n\r" +ERANGE: +.asciz "Range bound error\n\r" +ESET: +.asciz "Set bound error\n\r" +EIOVFL: +.asciz "Integer overflow\n\r" +ECONV: +.asciz "Conversion error\n\r" +ESTACK: +.asciz "Stack overflow\n\r" +EHEAP: +.asciz "Heap overflow\n\r" +EODDZ: +.asciz "Illegal size argument\n\r" +ECASE: +.asciz "Case error\n\r" +EBADMON: +.asciz "Bad monitor call\n\r" +EBADLIN: +.asciz "Argument of LIN to high\n\r" +EBADGTO: +.asciz "GTO descriptor error\n\r" + + diff --git a/mach/6500/libem/div4.s b/mach/6500/libem/div4.s new file mode 100644 index 00000000..3cd68a1d --- /dev/null +++ b/mach/6500/libem/div4.s @@ -0,0 +1,41 @@ +.define Div4 + +! This subroutine performs a signed divide on two fourbyte integers. +! For more detail see dvi.s +! The only difference is that zeropage locations are twice as big. + +Div4: + ldy #0 + sty SIGN + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 ! divisor in ARTH - ARTH+3 + tay + bpl 1f + lda #0 + ldx #ARTH + jsr Ngi4 + ldy #1 + sty SIGN ! it's signed + 1: jsr Pop + stx ARTH+4 + sta ARTH+5 + jsr Pop + stx ARTH+6 + sta ARTH+7 ! dividend in ARTH+4 - ARTH+7 + tay + bpl 1f + lda #0 + ldx #ARTH+4 + jsr Ngi4 + lda SIGN + eor #1 + sta SIGN + lda #1 + sta NBYTES + 1: jmp Duv4 + + diff --git a/mach/6500/libem/dum_float.s b/mach/6500/libem/dum_float.s new file mode 100644 index 00000000..b4f49702 --- /dev/null +++ b/mach/6500/libem/dum_float.s @@ -0,0 +1,59 @@ +.define Adf4 +.define Adf8 +.define Sbf4 +.define Sbf8 +.define Mlf4 +.define Mlf8 +.define Dvf4 +.define Dvf8 +.define Ngf4 +.define Ngf8 +.define Zrf4 +.define Zrf8 +.define Cmf4 +.define Cmf8 +.define Fef4 +.define Fef8 +.define Fif4 +.define Fif8 +.define Cfi +.define Cif +.define Cuf +.define Cff +.define Cfu +.define Lfr8 +.define Ret8 + +! Dummy floating point package for 6500 +! every EM floating point instruction results in an +! "Illegal EM instruction" trap. + + +Adf4: +Adf8: +Sbf4: +Sbf8: +Mlf4: +Mlf8: +Dvf4: +Dvf8: +Ngf4: +Ngf8: +Zrf4: +Zrf8: +Cmf4: +Cmf8: +Fef4: +Fef8: +Fif4: +Fif8: +Cfi: +Cif: +Cuf: +Cff: +Cfu: +Lfr8: +Ret8: + ldx #Eillins + lda #0 + jsr Trap diff --git a/mach/6500/libem/dup.s b/mach/6500/libem/dup.s new file mode 100644 index 00000000..22e33ac5 --- /dev/null +++ b/mach/6500/libem/dup.s @@ -0,0 +1,30 @@ +.define Dup + +! This subroutine duplicate's the top n (in register Y) bytes. +! N is atmost 256. +! The duplicating takes place as follows. +! The registerpair is filled with the bytes at stackpointer + N +! and stackpopinter + N-1. +! These two bytes then are pushed onto the stack. +! Next the offset N is decremented and the next two byte are taken +! care off. Until N = 0. + + +Dup: + lda SP+1 + ldx SP+2 + stx ADDR ! address of group (lowbyte) + sta ADDR+1 ! address of group (highbyte) + 1: dey + lda (ADDR),y ! get lowbyte + pha + dey + lda (ADDR),y ! get highbyte + tax + pla + jsr Push ! push them + tya + bne 1b + rts + + diff --git a/mach/6500/libem/duv4.s b/mach/6500/libem/duv4.s new file mode 100644 index 00000000..1395a672 --- /dev/null +++ b/mach/6500/libem/duv4.s @@ -0,0 +1,66 @@ +.define Duv4 + +! This subroutine performs an unsigned division on two fourbyte +! unsigned integers. +! For more details see dvi.s +! The only difference is that zeropage locations are twice as big. + + +Duv4: + 1: ldy #0 + sty ARTH+8 + sty ARTH+9 + sty ARTH+10 + sty ARTH+11 + ldy #33 + 4: lda ARTH+11 + cmp ARTH+3 + bcc 1f ! no sub + bne 2f ! sub + lda ARTH+10 + cmp ARTH+2 + bcc 1f + bne 2f + lda ARTH+9 + cmp ARTH+1 + bcc 1f + bne 2f + lda ARTH+8 + cmp ARTH + bcc 1f + 2: sec + lda ARTH+8 + sbc ARTH + sta ARTH+8 + lda ARTH+9 + sbc ARTH+1 + sta ARTH+9 + lda ARTH+10 + sbc ARTH+2 + sta ARTH+10 + lda ARTH+11 + sbc ARTH+3 + sta ARTH+11 + sec + rol ARTH+4 + bne 3f + 1: asl ARTH+4 + 3: rol ARTH+5 + rol ARTH+6 + rol ARTH+7 + rol ARTH+8 + rol ARTH+9 + rol ARTH+10 + rol ARTH+11 + dey + bne 4b + ldy UNSIGN + beq 1f + ldy SIGN + beq 1f + lda #0 + ldx #ARTH+4 + jsr Ngi4 + 1: rts + + diff --git a/mach/6500/libem/dvi.s b/mach/6500/libem/dvi.s new file mode 100644 index 00000000..3f5d69a2 --- /dev/null +++ b/mach/6500/libem/dvi.s @@ -0,0 +1,82 @@ +.define Dvi2, Div, Duv + +! The subroutine Dvi2 performs a signed division. +! Its operands are on the stack. +! The subroutine Div performs also a signed division, ecxept that +! its operand are already in zeropage. +! The subroutine Duv performs a n unsigned division. +! For an explanation of the algoritm used see +! A. S. Tanenbaum's Structered Computer Organisation. 1976 + + +Dvi2: + stx ARTH + sta ARTH+1 ! store divisor + jsr Pop + stx ARTH+2 + sta ARTH+3 ! store dividend + ldy #1 + sty UNSIGN ! used for result sign +Div: + ldy #0 + sty SIGN + lda ARTH+1 + bpl 1f ! if divisor is negative + ldx ARTH ! make it positive + jsr Ngi2 + ldy #1 + sty SIGN + stx ARTH + sta ARTH+1 + 1: lda ARTH+3 + bpl 1f ! if dividend is negative + ldx ARTH+2 ! make it positive + jsr Ngi2 + pha + lda SIGN + eor #1 ! excusive or with sign of divisor + sta SIGN + lda #1 + sta NBYTES + pla + stx ARTH+2 + sta ARTH+3 +Duv: + 1: ldy #0 + sty ARTH+4 + sty ARTH+5 + ldy #17 + 4: lda ARTH+5 + cmp ARTH+1 + bcc 1f ! no subtraction + bne 2f ! divisor goes into dividend + lda ARTH+4 + cmp ARTH + bcc 1f ! no subtraction + 2: sec ! divisor goes into dividend + lda ARTH+4 + sbc ARTH + sta ARTH+4 + lda ARTH+5 + sbc ARTH+1 + sta ARTH+5 ! subtract divisor from dividend + sec + rol ARTH+2 ! a subtraction so shift in a 1 + bne 3f + 1: asl ARTH+2 ! no subtraction so shift in a 0 + 3: rol ARTH+3 + rol ARTH+4 + rol ARTH+5 ! shift dividend + dey + bne 4b + ldx ARTH+2 + lda ARTH+3 + ldy UNSIGN ! is it an unsigned division + beq 1f + ldy SIGN ! is the result negative + beq 1f + jsr Ngi2 + 1: rts + + + diff --git a/mach/6500/libem/dvi4.s b/mach/6500/libem/dvi4.s new file mode 100644 index 00000000..5b068ab3 --- /dev/null +++ b/mach/6500/libem/dvi4.s @@ -0,0 +1,19 @@ +.define Dvi4 + +! This subroutine performs a fourbyte signed division. +! For more details see dvi.s +! The only difference is that zeropage locations are twice as big. + + +Dvi4: + ldy #1 + sty UNSIGN + jsr Div4 + lda ARTH+7 + ldx ARTH+6 + jsr Push + lda ARTH+5 + ldx ARTH+4 + jmp Push + + diff --git a/mach/6500/libem/dvu.s b/mach/6500/libem/dvu.s new file mode 100644 index 00000000..1cb6b8df --- /dev/null +++ b/mach/6500/libem/dvu.s @@ -0,0 +1,17 @@ +.define Dvu2 + +! This subroutine performs a twobyte unsigned division +! For more details see dvi.s. + + +Dvu2: + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 + ldy #0 + sty UNSIGN + jmp Dvu + + diff --git a/mach/6500/libem/dvu4.s b/mach/6500/libem/dvu4.s new file mode 100644 index 00000000..099cf893 --- /dev/null +++ b/mach/6500/libem/dvu4.s @@ -0,0 +1,31 @@ +.define Dvu4 + +! This subroutine performs an unsigned division on fourbyte +! integers. For more details see dvi.s +! The only difference is that zeropage locations are twice as big. + + +Dvu4: + ldy #0 + sty UNSIGN ! it is unsigned + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 ! divisor in ARTH - ARTH+3 + jsr Pop + stx ARTH+4 + sta ARTH+5 + jsr Pop + stx ARTH+6 + sta ARTH+7 ! dividend in ARTH+4 - ARTH+7 + jsr Duv4 + lda ARTH+7 + ldx ARTH+6 + jsr Push + lda ARTH+5 + ldx ARTH+4 + jmp Push ! store result + + diff --git a/mach/6500/libem/exg.s b/mach/6500/libem/exg.s new file mode 100644 index 00000000..12be6e58 --- /dev/null +++ b/mach/6500/libem/exg.s @@ -0,0 +1,33 @@ +.define Exg + +! This subroutine exchanges two groups of bytes on the top of the +! stack. The groups may consist of atmost 255 bytes. +! This number is in register Y. +! The exchange is from ADDR, ADDR+1 to ADDR+2, ADDR+3 + + +Exg: + lda SP+1 + ldx SP+2 + stx ADDR ! address of first group (lowbyte) + sta ADDR+1 ! address of first group (highbyte) + sty Ytmp ! save number of bytes to be exchanged + clc + lda SP+2 + adc Ytmp + sta ADDR+2 ! address of second group (lowbyte) + lda SP+1 + adc #0 + sta ADDR+3 ! address of second group (highbyte) + 1: dey + lda (ADDR),y ! get byte from first group + pha ! temporary save + lda (ADDR+2),y ! get byte from second group + sta (ADDR),y ! store in first group + pla ! get temporary saved byte + sta (ADDR+2),y ! store in second group + tya + bne 1b ! perform n times + rts + + diff --git a/mach/6500/libem/exg2.s b/mach/6500/libem/exg2.s new file mode 100644 index 00000000..0e56587f --- /dev/null +++ b/mach/6500/libem/exg2.s @@ -0,0 +1,23 @@ +.define Exg2 + +! This subroutine exchanges two words on top of the stack. +! The top word of the stack is really in the AX registerpair. +! So this word is exchanged with the top of the real stack. + + +Exg2: + pha ! save A + txa + pha ! save X + jsr Pop ! get top real stack + stx EXG + sta EXG+1 ! save top of real stack + pla ! get X + tax + pla ! get A + jsr Push ! push on real stack + ldx EXG ! get new X + lda EXG+1 ! get new A + rts + + diff --git a/mach/6500/libem/gto.s b/mach/6500/libem/gto.s new file mode 100644 index 00000000..90d168e0 --- /dev/null +++ b/mach/6500/libem/gto.s @@ -0,0 +1,65 @@ +.define Gto + +! This subroutine performs the non_local goto. +! The address of the descriptor is stored in zeropage locations +! ADDR, ADDR+1. +! Since there are two stacks (hardware_stack and the real_stack), +! the stackpointer of the hard_stack is resetted by searching the +! new localbase in the real_stack while adjusting the hardware_stack. + + +Gto: + stx ADDR ! address of descripto (lowbyte) + sta ADDR+1 ! address of descriptor (highbyte) + pla ! remove + pla ! __gto return address. + ldy #4 + lda (ADDR),y ! new localbase (lowbyte) + sta ARTH + tax + iny + lda (ADDR),y ! new localbase (highbyte) + sta ARTH+1 + cmp LB+1 + bne 1f + cpx LB + beq 2f ! goto within same procedure + 1: ldy #0 + lda (LB),y ! get localbase (lowbyte) + tax + iny + lda (LB),y ! get localbase (highbyte) + cmp ARTH+1 + bne 3f + cpx ARTH + beq 2f ! found localbase + 3: stx LB ! temporary save of localbase + sta LB+1 + pla ! adjust + pla ! hardware_stack + jmp 1b + 2: sta LB+1 ! store localbase (highbyte) + pha + stx LB ! store localbase (lowbyte) + sec + txa + sbc #BASE + sta LBl ! localbase - 240 (lowbyte) + pla + sbc #0 + sta LBl+1 ! localbase - 240 (highbyte) + ldy #3 + lda (ADDR),y ! new stackpointer (highbyte) + sta SP+1 + dey + lda (ADDR),y ! new stackpointer (lowbyte) + sta SP+2 + dey + lda (ADDR),y ! jump address (highbyte) + sta ADDR+3 + dey + lda (ADDR),y ! jump address (lowbyte) + sta ADDR+2 + jmp (ADDR+2) ! jump to address + + diff --git a/mach/6500/libem/head_em.s b/mach/6500/libem/head_em.s new file mode 100644 index 00000000..614e09ea --- /dev/null +++ b/mach/6500/libem/head_em.s @@ -0,0 +1,227 @@ +.define WRCH, RDCH, Earray, Erange, Eset +.define Eiovfl, Eidivz, Eiund, Econv +.define Estack, Eheap, Eillins, Eoddz +.define Ecase , Ebadmon, OSBYTE, MON +.define Ebadlin, Ebadgto, BASE, NBYTES +.define hol0, IGNMASK, ADDR, PROGNAME +.define LB, LBl, SP, HP, ERRPROC, UNSIGN +.define Ytmp, EXG, ARTH, RETURN, SIGN +.define RETSIZE, TRAPVAL, STACK, BRANCH +.define start, Push, Pop, STACKTh, STACKTl +.define F_DUM + +! DEFINITIONS + + ! The next three definitions are special for the + ! BBC microcomputer + +WRCH = 0FFEEh ! This subroutine writes the character in + ! register A to the screen +RDCH = 0FFE0h ! This subroutine returns a character in + ! register A from the current input stream +OSBYTE = 0FFF4h ! This subroutine performs miscelaneous + ! operating system calls + +F_DUM = 0 ! Dummy floating point constant + + ! Here are the error numbers + +Earray = 0 +Erange = 1 +Eset = 2 +Eiovfl = 3 +Eidivz = 6 +Eiund = 8 +Econv = 10 +Estack = 16 +Eheap = 17 +Eillins = 18 +Eoddz = 19 +Ecase = 20 +Ebadmon = 25 +Ebadlin = 26 +Ebadgto = 27 +MON = 78D0h + +BASE = 240 ! This is the offset from the localbase + ! for the second localbase + +STACKTh = 78h ! This is the top of the stack +STACKTl = 0D0h + + ! Some zeropage declarations + +.zero + +RES: .space 76 ! special for the operating system + +hol0: .space 16 ! the hol0 block + +IGNMASK: .space 2 ! can hold the ingnore mask + +ADDR: .space 4 ! used for indirect addressing + +LB: .space 2 ! the localbase + +LBl: .space 2 ! the second localbase (localbase-BASE) + +SP: .space 3 ! the stackpointer (real_stack) + +HP: .space 2 ! the heap pointer + +BRANCH: .space 2 ! used for branch instructions + +ERRPROC: .space 2 ! can hold the address of the error handler + +Ytmp: .space 1 ! used for intermediate storage in Y + +EXG: .space 2 ! used by the exchange subroutine Exg + +ARTH: .space 16 ! used for arithmetic + +NBYTES: .space 2 ! containes the number of bytes for a block move + + +RETURN: .space 4 ! the return area + +RETSIZE: .space 1 ! the size of the object returned + +SIGN: .space 1 ! the sign of the calculation + +UNSIGN : .space 1 ! is it signed or unsigned arithmetic + +TRAPVAL: .space 1 ! intermediate storage of the error number + +STACK: .space 1 ! contains the hardware stackpointer on + ! entering m_a_i_n for a neat return + +RESERVED: .space 112 ! used by the operating system + +.base 0E02h ! where to start in the BBC micro +.text +! GENERAL PURPOSE ROUTINES + +start: + tsx + stx STACK ! save stackpointer for exit and error + + ! The following three operating system calls are only + ! for the BBC microcomputer + + lda #2 + ldx #0 + ldy #0 + jsr OSBYTE ! return control to the keyboard + lda #15 + ldx #0 + ldy #0 + jsr OSBYTE ! clear all internal buffers + lda #3 + ldx #5 + ldy #0 + jsr OSBYTE ! output to screen and RS423 + + lda #STACKTl + sta LB ! set localbase (lowbyte) + sta SP+2 + lda #0 + sta SP ! set stackpointer (lowbyte) + sta ERRPROC ! set start address for error handler (lowbyte) + sta ERRPROC+1 ! set start address for error handler (highbyte) + sta hol0 ! set the line number (lowbyte) + sta hol0+1 ! set the line number (highbyte) + lda #STACKTh + sta SP+1 ! set the stacpointer (highbyte) + sta LB+1 ! set the localbase (highbyte) + lda #[endbss].l + sta HP ! set the heap pointer (lowbyte) + lda #[endbss].h + sta HP+1 ! set the heap pointer (highbyte) + lda #[PROGNAME].l + sta hol0+4 ! set fake programname pointer (lowbyte) + lda #[PROGNAME].h + sta hol0+5 ! set fake programname pointer (highbyte) + lda #[beginbss].l + sta ADDR ! start address of bss block (lowbyte) + lda #[beginbss].h + sta ADDR+1 ! start address of bss block (highbyte) + ldy #0 + lda #0 + 4: ldx #[endbss].h ! clear bss block + cpx ADDR+1 + bcc 1f ! end of bss block reached + bne 2f + ldx #[endbss].l + cpx ADDR + bcc 1f ! end of bss block reached + 2: sta (ADDR),y + inc ADDR + bne 3f + inc ADDR+1 + 3: jmp 4b + 1: lda #0 + tax + jsr Push ! push fake envelope pointer + lda #[PROGNAME].h + ldx #[PROGNAME].l + jsr Push ! push argv[0] + lda #0 + ldx #1 + jsr Push ! push argc + jsr _m_a_i_n ! start the real program + + lda #0FFh + jsr WRCH ! send end of program to R423 + lda #3 + ldx #0 + jsr OSBYTE ! send output to screen only + lda #2 + ldx #1 + jsr OSBYTE ! input only from R423 + rts + + +! The subroutine Push pushes the registerpair AX onto the stack. + +Push: + sty Ytmp ! save Y + ldy SP+2 + bne 1f ! lowbyte of stackpointer <> 0 + dec SP+1 ! decrement highbyte of stackpointer + 1: dey + dey ! decrement lowbyte of stackpointer + sty SP+2 ! save lowbyte of stackpointer + pha ! save A + txa + sta (SP),y ! push X onto the stack + iny + pla ! get A + sta (SP),y ! push A onto the stack + ldy Ytmp ! restore Y + rts + + +! The subroutine Pop pops the registerpair AX from the stack. + +Pop: + sty Ytmp ! save Y + ldy SP+2 + lda (SP),y ! pop X from the stack + tax + iny + lda (SP),y ! pop A from the stack + iny + bne 1f ! lowbyte of stackpointer <> 0 + inc SP+1 ! increment highbyte of stackpointer + 1: sty SP+2 ! store lowbyte of stackpointer + pha ! save A + pla ! get A + ldy Ytmp ! restore Y + rts + + +.data +PROGNAME: ! for initialising the programname pointer +.asciz "program" +.bss +beginbss: diff --git a/mach/6500/libem/indir.s b/mach/6500/libem/indir.s new file mode 100644 index 00000000..64425128 --- /dev/null +++ b/mach/6500/libem/indir.s @@ -0,0 +1,13 @@ +.define Indir + +! This subroutine performs an indirect procedurecall. +! This must be done this way since the jump instruction +! is the only one which can indirect change the programcounter. +! The address of the function must be in zeropage loactions +! ADDR, ADDR+1. + + +Indir: + jmp (ADDR) + + diff --git a/mach/6500/libem/inn.s b/mach/6500/libem/inn.s new file mode 100644 index 00000000..3ac1550c --- /dev/null +++ b/mach/6500/libem/inn.s @@ -0,0 +1,55 @@ +.define Inn + +! This subroutine checks if a certain bit is set in a set +! of n bytes on top of the stack. + + +Inn: + stx ARTH ! save bit number (lowbyte) + sta ARTH+1 ! save bit number (highbyte) + and #80h + beq 1f + lda #0 ! bit number is negative + sta ARTH+2 ! make it zero + beq 3f + 1: txa + and #07h ! get bit number mod 8 + tax + lda #1 + cpx #0 ! bit number = 0 + beq 2f ! no shifting to right place + 1: asl a ! shift left until bit is in place + dex + bne 1b + 2: sta ARTH+2 ! bit is one in place + ldx #3 + 1: lsr ARTH+1 ! shift left 3 times bit number (highbyte) + ror ARTH ! shift left 3 times bit number (lowbyte) + dex ! this is bit number div 8 + bne 1b ! which is byte number + 3: lda SP+1 + ldx SP+2 + stx ADDR ! address of the set (lowbyte) + sta ADDR+1 ! address of the set (highbyte) + iny + tya + bne 2f + inc SP+1 + 2: clc ! remove the set + adc SP+2 + sta SP+2 ! new stackpointer (lowbyte) + lda #0 + adc SP+1 + sta SP+1 ! new stackpointer (highbyte) + ldy ARTH + lda (ADDR),y ! load the byte in A + bit ARTH+2 ! test bit + bne 1f + 3: lda #0 ! bit is zero + tax + rts + 1: lda #0 ! bit is one + ldx #1 + rts + + diff --git a/mach/6500/libem/ior.s b/mach/6500/libem/ior.s new file mode 100644 index 00000000..0ba1a381 --- /dev/null +++ b/mach/6500/libem/ior.s @@ -0,0 +1,29 @@ +.define Ior + +! This subroutine performs the logical inclusive or on two +! groups of bytes. The groups may consist of atmost 254 bytes. +! The two groups are on the stack. + +Ior: + lda SP+1 + sta ADDR+1 ! address of the first group (highbyte) + lda SP+2 + sta ADDR ! address of the first group (lowbyte) + clc + tya + adc SP+2 + sta SP+2 ! new stackpointer (lowbyte) + sta ADDR+2 ! address of second group (lowbyte) + lda #0 + adc SP+1 + sta SP+1 ! new stackpointer (highbyte) + sta ADDR+3 ! address of second group (highbyte) + 1: dey + lda (ADDR),y ! get byte first group + ora (ADDR+2),y ! inclusive or with byte second group + sta (ADDR+2),y ! restore result on stack + tya + bne 1b ! perform n times + rts + + diff --git a/mach/6500/libem/lar.s b/mach/6500/libem/lar.s new file mode 100644 index 00000000..15bb581d --- /dev/null +++ b/mach/6500/libem/lar.s @@ -0,0 +1,25 @@ +.define Lar + +! This subroutine performs the LAR instruction. +! For details see rapport IR-81. + + +Lar: + jsr Aar ! get object address + ldy NBYTES+1 ! the size of the object (highbyte) + bne 2f + ldy NBYTES ! the size of the object (lowbyte) + cpy #1 + bne 1f ! object size is one byte + jsr Loi1 ! get object + jmp Push ! push on the stack + 1: cpy #2 + bne 1f ! object size is a word + jsr Loi ! get word + jmp Push ! push on the stack + 1: cpy #4 + bne 2f ! object size is four bytes + jmp Ldi ! get object + 2: jmp Loil ! get object + + diff --git a/mach/6500/libem/lcs.s b/mach/6500/libem/lcs.s new file mode 100644 index 00000000..7c387f5c --- /dev/null +++ b/mach/6500/libem/lcs.s @@ -0,0 +1,19 @@ +.define Lcs + +! This subroutine creates space for locals on procedure entry +! by lowering the stackpointer. + + +Lcs: + sta ARTH ! number of locals (lowbyte) + stx ARTH+1 ! number of locals (highbyte) + sec + lda SP+2 + sbc ARTH + sta SP+2 ! new stackpointer (lowbyte) + lda SP+1 + sbc ARTH+1 + sta SP+1 ! new stackpointer (highbyte) + rts + + diff --git a/mach/6500/libem/ldi.s b/mach/6500/libem/ldi.s new file mode 100644 index 00000000..a5b056a7 --- /dev/null +++ b/mach/6500/libem/ldi.s @@ -0,0 +1,24 @@ +.define Ldi, Ldo + +! The subroutine Ldi pushes a four byte object onto the stack. +! The address is in registerpair AX. +! If the address is already in zeropage Ldo is used. + + +Ldi: + stx ADDR ! address of object (lowbyte) + sta ADDR+1 ! address of object (highbyte) +Ldo: + ldy #3 + 1: lda (ADDR),y ! get lowbyte + pha + dey + lda (ADDR),y ! get highbyte + tax + pla + jsr Push ! do the push + dey + bpl 1b ! perform 2 times + rts + + diff --git a/mach/6500/libem/locaddr.s b/mach/6500/libem/locaddr.s new file mode 100644 index 00000000..2156f7e1 --- /dev/null +++ b/mach/6500/libem/locaddr.s @@ -0,0 +1,18 @@ +.define Locaddr + +! This routine gets the address of a local which offset is to big. +! The offset is in registerpair AX. + + +Locaddr: + pha ! save A + txa + clc + adc LB ! localbase + offset (lowbyte) + sta ADDR ! address (lowbyte) + pla + adc LB+1 ! localbase + offset (highbyte) + sta ADDR+1 ! address (highbyte) + rts + + diff --git a/mach/6500/libem/loi.s b/mach/6500/libem/loi.s new file mode 100644 index 00000000..45c135ea --- /dev/null +++ b/mach/6500/libem/loi.s @@ -0,0 +1,17 @@ +.define Loi, Lext +! This subroutine performs an indirect load on a word of two bytes. +! Lext is used when the address is already in zeropage. + + +Loi: + stx ADDR ! address of object (lowbyte) + sta ADDR+1 ! address of object (highbyte) +Lext: + ldy #0 + lda (ADDR),y ! get lowbyte + tax + iny + lda (ADDR),y ! get highbyte + rts + + diff --git a/mach/6500/libem/loi1.s b/mach/6500/libem/loi1.s new file mode 100644 index 00000000..82109224 --- /dev/null +++ b/mach/6500/libem/loi1.s @@ -0,0 +1,15 @@ +.define Loi1 + +! This routine loads a one byte object in registerpair AX. + + +Loi1: + stx ADDR ! address of byte (lowbyte) + sta ADDR+1 ! address of byte (highbyte) + ldy #0 + lda (ADDR),y ! load byte + tax ! store byte in X + tya ! clear highbyte of AX + rts + + diff --git a/mach/6500/libem/loil.s b/mach/6500/libem/loil.s new file mode 100644 index 00000000..4c0e3597 --- /dev/null +++ b/mach/6500/libem/loil.s @@ -0,0 +1,23 @@ +.define Loil + +! This subroutine pushes an object of size greater than four bytes +! onto the stack. + + +Loil: + sta ADDR+1 ! source address (lowbyte) + stx ADDR ! source address (highbyte) + sty NBYTES + sec + lda SP+2 + sbc NBYTES + sta ADDR+2 ! destination address (lowbyte) + sta SP+2 ! new stackpointer + lda SP+1 + sbc NBYTES+1 + sta ADDR+3 ! destination address (highbyte) + sta SP+1 ! new stackpointer + inc NBYTES+1 + jmp Blmnp ! do the move + + diff --git a/mach/6500/libem/lol.s b/mach/6500/libem/lol.s new file mode 100644 index 00000000..6f1bce05 --- /dev/null +++ b/mach/6500/libem/lol.s @@ -0,0 +1,16 @@ +.define Lol + +! This subroutine loads a local in registerpair AX which +! offset from the localbase is to big. + + +Lol: + jsr Locaddr ! get the address of local + ldy #0 + lda (ADDR),y ! get lowbyte + tax + iny + lda (ADDR),y ! get highbyte + rts + + diff --git a/mach/6500/libem/los.s b/mach/6500/libem/los.s new file mode 100644 index 00000000..1ba88f66 --- /dev/null +++ b/mach/6500/libem/los.s @@ -0,0 +1,30 @@ +.define Los + +! This subroutine perfoms the LOS instruction. +! For detail see rapport IR-81. + + +Los: + cmp #0 + bne 3f + cpx #1 + bne 1f ! the size is one + jsr Pop ! get address + jsr Loi1 ! push it on the stack + jmp Push + 1: cpx #2 + bne 2f ! the size is two + jsr Pop ! get address + jsr Loi ! push it on the stack + jmp Push + 2: cpx #4 + bne 3f ! the size is four + jsr Pop ! get address + jmp Ldi ! push it on the stack + 3: sta ARTH+1 ! the size is greater than four + txa + tay + jsr Pop ! get address + jmp Loil ! push it on the stack + + diff --git a/mach/6500/libem/lxa1.s b/mach/6500/libem/lxa1.s new file mode 100644 index 00000000..402ef8b7 --- /dev/null +++ b/mach/6500/libem/lxa1.s @@ -0,0 +1,15 @@ +.define Lxa1 + +! This subroutine loads the address of AB zero static levels back. + +Lxa1: + ldy LB+1 ! load address of localbase (highbyte) + ldx LB ! load address of localbase (lowbyte) + inx + inx ! argumentbase = localbase + 2 + bne 1f + iny + 1: tya + rts + + diff --git a/mach/6500/libem/lxa2.s b/mach/6500/libem/lxa2.s new file mode 100644 index 00000000..58df1dcc --- /dev/null +++ b/mach/6500/libem/lxa2.s @@ -0,0 +1,32 @@ +.define Lxa2 + +! This subroutine load the address of AB n (255 >= n > 0) static levels +! back. + + +Lxa2: + lda LB + sta ADDR ! address of localbase (lowbyte) + lda LB+1 + sta ADDR+1 ! address of localbase (highbyte) + 1: ldy #2 + lda (ADDR),y ! static level LB (lowbyte) + pha + iny + lda (ADDR),y ! static level LB (highbyte) + sta ADDR+1 ! static level LB (highbyte) + pla + sta ADDR ! static level LB (lowbyte) + dex + bne 1b + tax + ldy ADDR+1 + inx + inx ! argumentbase = localbase + 2 + bne 1f + iny + 1: tya + rts + + + diff --git a/mach/6500/libem/lxl.s b/mach/6500/libem/lxl.s new file mode 100644 index 00000000..d72c9fb0 --- /dev/null +++ b/mach/6500/libem/lxl.s @@ -0,0 +1,25 @@ +.define Lxl + +! This subroutine loads LB n (255 => n > 0) static levels back. + + +Lxl: + lda LB + sta ADDR ! address of localbase (lowbyte) + lda LB+1 + sta ADDR+1 ! address of localbase (highbyte) + 1: ldy #2 + lda (ADDR),y ! get localbase (lowbyte) 1 level back + pha + iny + lda (ADDR),y ! get localbase (highbyte) 1 level back + sta ADDR+1 ! new localbase (highbyte) + pla + sta ADDR ! new localbase (lowbyte) + dex + bne 1b ! n levels + tax + lda ADDR+1 + rts + + diff --git a/mach/6500/libem/mli.s b/mach/6500/libem/mli.s new file mode 100644 index 00000000..b441229d --- /dev/null +++ b/mach/6500/libem/mli.s @@ -0,0 +1,69 @@ +.define Mli2, Mlinp, Mul + +! The subroutine Mli2 multiplies two signed integers. The integers +! are popped from the stack. +! The subroutine Mlinp expects the two integer to be in zeropage. +! While the subroutine Mul an unsigned multiply subroutine is. +! For the algoritme see A. S. Tanenbaum +! Structured Computer Organisation. 1976. + + +Mli2: + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 +Mlinp: ldy #1 + sty UNSIGN ! it's signed + lda ARTH+1 + bpl 3f ! multiplier negative so: + ldx ARTH + jsr Ngi2 ! negate multiplier + stx ARTH + sta ARTH+1 + ldx ARTH+2 + lda ARTH+3 + jsr Ngi2 ! negate multiplicand + stx ARTH+2 + sta ARTH+3 +Mul: + 3: lda #0 + sta ARTH+4 + sta ARTH+5 + sta ARTH+6 + sta ARTH+7 ! clear accumulator + ldy #16 + 1: lda #1h + bit ARTH + beq 2f ! multiplying by zero: no addition + clc + lda ARTH+6 + adc ARTH+2 + sta ARTH+6 + lda ARTH+7 + adc ARTH+3 + sta ARTH+7 + 2: lsr ARTH+1 + ror ARTH ! shift multiplier + lsr ARTH+7 + ror ARTH+6 + ror ARTH+5 + ror ARTH+4 ! shift accumulator + lda UNSIGN + beq 3f ! unsigned multiply: so no shift in of signbit + lda ARTH+3 + bpl 3f + lda #40h + bit ARTH+7 + beq 3f + lda ARTH+7 + ora #80h + sta ARTH+7 + 3: dey + bne 1b + ldx ARTH+4 + lda ARTH+5 + rts + + diff --git a/mach/6500/libem/mli4.s b/mach/6500/libem/mli4.s new file mode 100644 index 00000000..81b59ff8 --- /dev/null +++ b/mach/6500/libem/mli4.s @@ -0,0 +1,33 @@ +.define Mli4 + +! This subroutine multiplies two signed fourbyte integers +! For more detail see mli.s +! The only difference is that zeropage locations are twice as big. + + +Mli4: + ldy #1 + sty UNSIGN + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 ! multiplier + jsr Pop + stx ARTH+4 + sta ARTH+5 + jsr Pop + stx ARTH+6 + sta ARTH+7 ! multiplicand + lda ARTH+3 + bpl 3f + lda #0 + ldx #ARTH + jsr Ngi4 + lda #0 + ldx #ARTH+4 + jsr Ngi4 + 3: jmp Mul4 + + diff --git a/mach/6500/libem/mlu.s b/mach/6500/libem/mlu.s new file mode 100644 index 00000000..c11f835c --- /dev/null +++ b/mach/6500/libem/mlu.s @@ -0,0 +1,17 @@ +.define Mlu2 + +! This subroutine multiplies two unsigned fourbyte intergers. +! For more details see mli.s + + +Mlu2: + stx ARTH + sta ARTH+1 ! multiplier + jsr Pop + stx ARTH+2 + sta ARTH+3 ! multiplicand + ldy #0 + sty UNSIGN + jmp Mul + + diff --git a/mach/6500/libem/mlu4.s b/mach/6500/libem/mlu4.s new file mode 100644 index 00000000..4d6b0436 --- /dev/null +++ b/mach/6500/libem/mlu4.s @@ -0,0 +1,25 @@ +.define Mlu4 + +! This subroutine multiplies two fourbyte unsigned integers. +! For more details see mli.s +! The only difference is that zeropage locations are twice as big. + + +Mlu4: + ldy #0 + sty UNSIGN + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 ! multiplier + jsr Pop + stx ARTH+4 + sta ARTH+5 + jsr Pop + stx ARTH+6 + sta ARTH+7 ! multiplicand + jmp Mul4 + + diff --git a/mach/6500/libem/mon.s b/mach/6500/libem/mon.s new file mode 100644 index 00000000..69a9dd5b --- /dev/null +++ b/mach/6500/libem/mon.s @@ -0,0 +1,35 @@ +.define Mon + +! This subroutine performs some monitor calls. +! The exit call just resets the hardware_stackpointer so +! this routine will return to the operating system. +! The close call just returns a zero. +! The ioctl call just pops its arguments and returns a zero. +! The write routine is a real one. + + +Mon: + cpx #1 + bne 1f ! exit + ldx STACK ! load stackpointer + dex + dex ! adjust stackpointer + txs ! set stackpointer + rts + 1: cpx #4 + bne 1f + jmp Mwrite + 1: cpx #6 ! facked + bne 1f ! close + lda #0 + tax ! return zero + rts + 1: cpx #54 + jsr Pop ! pop first argument (fildes) + jsr Pop ! pop second argument (request) + jsr Pop ! pop third argument (argp) + lda #0 + tax ! return zero + rts + + diff --git a/mach/6500/libem/mul4.s b/mach/6500/libem/mul4.s new file mode 100644 index 00000000..98d046f4 --- /dev/null +++ b/mach/6500/libem/mul4.s @@ -0,0 +1,66 @@ +.define Mul4 + +! This subroutine multiplies two fourbyte signed integers. +! For more details see mli.s +! The only difference is that zeropage locations are twice as big. + + +Mul4: + 3: lda #0 + sta ARTH+8 + sta ARTH+9 + sta ARTH+10 + sta ARTH+11 + sta ARTH+12 + sta ARTH+13 + sta ARTH+14 + sta ARTH+15 ! clear accumulator + ldy #32 + 1: lda #1h + bit ARTH + beq 2f ! multiplying by zero: no addition + clc + lda ARTH+12 + adc ARTH+4 + sta ARTH+12 + lda ARTH+13 + adc ARTH+5 + sta ARTH+13 + lda ARTH+14 + adc ARTH+6 + sta ARTH+14 + lda ARTH+15 + adc ARTH+7 + sta ARTH+15 + 2: lsr ARTH+3 + ror ARTH+2 + ror ARTH+1 + ror ARTH ! shift multiplier + lsr ARTH+15 + ror ARTH+14 + ror ARTH+13 + ror ARTH+12 + ror ARTH+11 + ror ARTH+10 + ror ARTH+9 + ror ARTH+8 ! shift accumulator + lda UNSIGN + beq 3f ! it's unsigned: so no shift in of signbit + lda ARTH+7 + bpl 3f + lda #40h + bit ARTH+15 + beq 3f + lda ARTH+15 + ora #80h + sta ARTH+15 + 3: dey + bne 1b + ldx ARTH+10 + lda ARTH+11 + jsr Push + ldx ARTH+8 + lda ARTH+9 + jmp Push + + diff --git a/mach/6500/libem/ngi.s b/mach/6500/libem/ngi.s new file mode 100644 index 00000000..d375b199 --- /dev/null +++ b/mach/6500/libem/ngi.s @@ -0,0 +1,19 @@ +.define Ngi2 + +! This subroutine negates the integer in registerpair AX. +! The negation is a one's complement plus one. + + +Ngi2: + eor #0FFh ! one's complement A + tay + txa + eor #0FFh ! one's complement X + tax + inx ! increment X + bne 1f + iny ! increment A if neccesairy + 1: tya + rts + + diff --git a/mach/6500/libem/ngi4.s b/mach/6500/libem/ngi4.s new file mode 100644 index 00000000..f62cd489 --- /dev/null +++ b/mach/6500/libem/ngi4.s @@ -0,0 +1,30 @@ +.define Ngi4 + +! This subroutine takes a fourbyte interger and negates it. +! For more details see ngi2.s + + +Ngi4: + sta ADDR+1 + stx ADDR + ldy #3 + 1: lda (ADDR),y + eor #0FFh ! one's complement lowbyte+y + sta (ADDR),y + dey + bpl 1b + ldx #0FDh + iny + clc + lda (ADDR),y + adc #1 + sta (ADDR),y ! lowbyte+y + 1: iny + lda (ADDR),y + adc #0 + sta (ADDR),y ! (lowbyte+y)+0 + inx + bne 1b + rts + + diff --git a/mach/6500/libem/print.s b/mach/6500/libem/print.s new file mode 100644 index 00000000..7cd70e32 --- /dev/null +++ b/mach/6500/libem/print.s @@ -0,0 +1,22 @@ +.define Mprint + +! This subroutine prints a zero terminated ascii string. +! The registerpair AX contains the start of the string. +! The subroutine WRCH is a special routine on the BBC microcomputer +! which prints the character in A to the screen. +! The subroutine WRCH is a special one provided by the BBC +! microcomputer. + + +Mprint: + stx ADDR ! start address of string (lowbyte) + sta ADDR+1 ! start address of string (highbyte) + ldy #0 + 1: lda (ADDR),y ! get ascii character + beq 2f + jsr WRCH ! put it on the screen + iny + bne 1b + 2: rts + + diff --git a/mach/6500/libem/printhex.s b/mach/6500/libem/printhex.s new file mode 100644 index 00000000..be979a85 --- /dev/null +++ b/mach/6500/libem/printhex.s @@ -0,0 +1,27 @@ +.define Printhex + +! This subroutine print the contents of register A to the screen +! in hexadecimal form. +! The subroutine WRCH is a special one provided by the BBC +! microcomputer. + + +Printhex: + pha ! save A + lsr a + lsr a + lsr a + lsr a ! get four high bits + jsr 1f + pla ! restore A + and #0Fh ! get four low bits + jsr 1f + rts + 1: sed ! print in hex + clc + adc #90h + adc #40h + cld + jmp WRCH + + diff --git a/mach/6500/libem/printstack.s b/mach/6500/libem/printstack.s new file mode 100644 index 00000000..a554d9e5 --- /dev/null +++ b/mach/6500/libem/printstack.s @@ -0,0 +1,44 @@ +.define Printstack + +! This a special subroutine which prints some things to the +! monitorscreen for debugging. + + +Printstack: + ldy #0 + 2: lda (hol0+4),y + beq 1f + jsr WRCH ! print filename + iny + jmp 2b + 1: lda #32 + jsr WRCH ! print a space + lda hol0+1 + jsr Printhex ! print line number (highbyte) + lda hol0 + jsr Printhex ! print line number (lowbyte) + lda #32 + jsr WRCH ! print a space + lda SP+1 + jsr Printhex ! print stackpointer (highbyte) + lda SP+2 + jsr Printhex ! print stackpointer (lowbyte) + lda #32 + jsr WRCH ! print a space + lda LB+1 + jsr Printhex ! print real localbase (highbyte) + lda LB + jsr Printhex ! print real localbase (lowbyte) + lda #32 + jsr WRCH ! print a space + lda LBl+1 + jsr Printhex ! print second lowerbase (highbyte) + lda LBl + jsr Printhex ! print second lowerbase (lowbyte) + lda #10 + jsr WRCH ! print a newline + lda #13 + jsr WRCH ! print a carriagereturn + rts + + diff --git a/mach/6500/libem/pro.s b/mach/6500/libem/pro.s new file mode 100644 index 00000000..27a565fa --- /dev/null +++ b/mach/6500/libem/pro.s @@ -0,0 +1,28 @@ +.define Pro + +! This routine is called at the entry of a procedure. +! It saves the localbase of the invoking procedure, and sets the +! new localbase to the present value of the stackpointer. +! It then initializes the second localbase by subtracting +! BASE from the real one. + + +Pro: + ldx LB ! get localbase (lowbyte) + lda LB+1 ! get localbase (highbyte) + jsr Push ! push localbase onto the stack + ldx SP+2 ! get stackpointer (lowbyte) + lda SP+1 ! get stackpointer (highbyte) + stx LB ! new localbase (lowbyte) + sta LB+1 ! new localbse (highbyte) + tay + txa + sec + sbc #BASE + sta LBl ! second localbase (lowbyte) + tya + sbc #0 + sta LBl+1 ! second localbase (highbyte) + rts + + diff --git a/mach/6500/libem/read.s b/mach/6500/libem/read.s new file mode 100644 index 00000000..0f6ab67b --- /dev/null +++ b/mach/6500/libem/read.s @@ -0,0 +1,32 @@ +.define Mread + +! This subroutine reads characters from the standard input. +! It ignores the filedes. +! It reads atmost 255 characters. So the runtime system must +! provide a way of dealing with this. +! The subroutine RDCH is a special one provided by the BBC +! microcomputer. + + +Mread: + jsr Pop ! ignore filedescriptor + jsr Pop ! bufptr + stx ADDR ! address of character buffer (lowbyte) + sta ADDR+1 ! address of character buffer (highbyte) + jsr Pop ! number of characters + ldy #0 ! <= 255 + inx + 1: jsr RDCH ! read a character from the current inputstream + bcs 8f + sta (ADDR),y + iny + dex + bne 1b + 8: tya + tax + lda #0 + jsr Push ! number of characters red. + tax ! report a succesfull read. + rts + + diff --git a/mach/6500/libem/ret.s b/mach/6500/libem/ret.s new file mode 100644 index 00000000..8002fc1f --- /dev/null +++ b/mach/6500/libem/ret.s @@ -0,0 +1,43 @@ +.define Ret + +! This subroutine stores the returnvalue in the return area. +! This area is in zeropage. +! The size of the object to be returned is in zeropage location +! RETSIZE. +! It also restores the localbases and the stackpointer of the +! invoking procedure. + + +Ret: + sty RETSIZE ! save returnsize + beq 1f ! the return size is zero + lda #0 ! address of returnvalue area (highbyte) + ldx #RETURN ! address of returnvalue area (lowbyte) + cpy #2 + bne 2f + jsr Sti ! store word + jmp 1f + 2: cpy #4 + jsr Sdi ! store fourbyte word + 1: ldx LB ! get old stackpointer (lowbyte) + stx SP+2 + lda LB+1 ! get old stackpointer (highbyte) + sta SP+1 + inc LB + inc LB + bne 1f + inc LB+1 + 1: jsr Pop ! get old localbase + stx LB ! localbase (lowbyte) + sta LB+1 ! localbase (highbyte) + pha + sec + txa + sbc #BASE + sta LBl ! second localbase (lowbyte) + pla + sbc #0 + sta LBl+1 ! second localbase (highbyte) + rts + + diff --git a/mach/6500/libem/rmi.s b/mach/6500/libem/rmi.s new file mode 100644 index 00000000..12bc6425 --- /dev/null +++ b/mach/6500/libem/rmi.s @@ -0,0 +1,27 @@ +.define Rmi2 + +! This subroutine returns the remainder of a twobyte signed division. +! The sign of the result is as specified in the emtest. + + +Rmi2: + ldy #0 + sty NBYTES ! for the sign of the result + stx ARTH + sta ARTH+1 ! first operand + jsr Pop + stx ARTH+2 + sta ARTH+3 ! second operand + ldy #0 + sty UNSIGN ! its signed arithmetic + jsr Div + lsr ARTH+5 + ror ARTH+4 ! result must be shifted one time + ldx ARTH+4 + lda ARTH+5 + ldy NBYTES + beq 1f ! result must be positive + jmp Ngi2 + 1: rts + + diff --git a/mach/6500/libem/rmi4.s b/mach/6500/libem/rmi4.s new file mode 100644 index 00000000..0b221e2e --- /dev/null +++ b/mach/6500/libem/rmi4.s @@ -0,0 +1,28 @@ +.define Rmi4 + +! This subroutine returns the remainder of a fourbyte division. + + +Rmi4: + ldy #0 + sty NBYTES ! for the sign of the result + ldy #0 + sty UNSIGN ! it is signed arithmetic + jsr Div4 + lsr ARTH+11 + ror ARTH+10 + ror ARTH+9 + ror ARTH+8 ! result must be shifted one time + ldy NBYTES + beq 1f ! result is positive + lda #0 + ldx #ARTH+8 + jsr Ngi4 + 1: lda ARTH+11 + ldx ARTH+10 + jsr Push + lda ARTH+9 + ldx ARTH+8 + jmp Push + + diff --git a/mach/6500/libem/rmu.s b/mach/6500/libem/rmu.s new file mode 100644 index 00000000..dff2c3c7 --- /dev/null +++ b/mach/6500/libem/rmu.s @@ -0,0 +1,22 @@ +.define Rmu2 + +! This subroutine returns the remainder of an twobyte unsigned +! integer division. + + +Rmu2: + stx ARTH + sta ARTH+1 ! first operand + jsr Pop + stx ARTH+2 + sta ARTH+3 ! second operand + ldy #1 + sty UNSIGN ! it unsigned + jsr Duv + lsr ARTH+5 + ror ARTH+4 ! shift result one time + ldx ARTH+4 + lda ARTH+5 + rts + + diff --git a/mach/6500/libem/rmu4.s b/mach/6500/libem/rmu4.s new file mode 100644 index 00000000..e3c848cd --- /dev/null +++ b/mach/6500/libem/rmu4.s @@ -0,0 +1,34 @@ +.define Rmu4 + +! This subroutine returns the remainder of a fourbyte unsigned +! division. + + +Rmu4: + ldy #1 + sty UNSIGN ! its unsigned + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 ! second operand + jsr Pop + stx ARTH+4 + sta ARTH+5 + jsr Pop + stx ARTH+6 + sta ARTH+7 ! first operand + jsr Duv4 + lsr ARTH+11 + ror ARTH+10 + ror ARTH+9 + ror ARTH+8 ! shift result one time + lda ARTH+11 + ldx ARTH+10 + jsr Push + lda ARTH+9 + ldx ARTH+8 + jmp Push + + diff --git a/mach/6500/libem/rol.s b/mach/6500/libem/rol.s new file mode 100644 index 00000000..34786e2b --- /dev/null +++ b/mach/6500/libem/rol.s @@ -0,0 +1,26 @@ +.define Rol + +! This subroutine rotates left an integer n times +! N is in register X. +! The result is returned in registerpair AX. + + +Rol: + + txa + bne 1f + jmp Pop ! zero rotate return input + 1: tay ! Y contains number of rotates + jsr Pop + stx Ytmp ! save lowbyte + 2: clc + rol Ytmp ! rotate lowbyte + rol a ! rotate highbyte + bcc 1f ! no carry + inc Ytmp ! put carry in rightmost bit + 1: dey + bne 2b + ldx Ytmp ! store lowbyte in X + rts + + diff --git a/mach/6500/libem/rol4.s b/mach/6500/libem/rol4.s new file mode 100644 index 00000000..5f040727 --- /dev/null +++ b/mach/6500/libem/rol4.s @@ -0,0 +1,33 @@ +.define Rol4 + +! This subroutine rotates left a fourbyte integer n times. +! N is in register X. + + +Rol4: + txa + bne 1f ! a zero rotate skip + rts + 1: tay + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 + 2: asl ARTH + rol ARTH+1 + rol ARTH+2 + rol ARTH+3 ! rotate left + bcc 1f + inc ARTH ! put carry in rightmost bit + 1: dey + bne 2b + ldx ARTH+2 + lda ARTH+3 + jsr Push + ldx ARTH + lda ARTH+1 + jmp Push + + diff --git a/mach/6500/libem/ror.s b/mach/6500/libem/ror.s new file mode 100644 index 00000000..f70db75f --- /dev/null +++ b/mach/6500/libem/ror.s @@ -0,0 +1,25 @@ +.define Ror + +! This subroutine rotates right a integer twobyte word. +! The number of rotates is in X. +! The result is returned in registerpair AX. + + +Ror: + txa + bne 1f ! a zero rotate just return input + jmp Pop + 1: tay + jsr Pop ! get word + stx Ytmp ! save lowbyte + 2: clc + ror a ! rotate highbyte + ror Ytmp ! rotate lowbyte + bcc 1f ! no carry + ora #80h ! put carry in leftmost bit + 1: dey + bne 2b + ldx Ytmp ! get lowbyte + rts + + diff --git a/mach/6500/libem/ror4.s b/mach/6500/libem/ror4.s new file mode 100644 index 00000000..e0b0d2db --- /dev/null +++ b/mach/6500/libem/ror4.s @@ -0,0 +1,35 @@ +.define Ror4 + +! This subroutine rotates right a fourbyte word. +! The number of rotates is in X. + + +Ror4: + txa + bne 1f ! a zero rotate skip + rts + 1: tay + jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + sta ARTH+3 + 2: lsr ARTH+3 ! rotate word + ror ARTH+2 + ror ARTH+1 + ror ARTH + bcc 1f ! no carry + lda #80h ! put carry in leftmost bit + ora ARTH+3 + sta ARTH+3 + 1: dey + bne 2b + lda ARTH+3 + ldx ARTH+2 + jsr Push + lda ARTH+1 + ldx ARTH + jmp Push ! push result onto the stack + + diff --git a/mach/6500/libem/rtt.s b/mach/6500/libem/rtt.s new file mode 100644 index 00000000..ed2d8b7d --- /dev/null +++ b/mach/6500/libem/rtt.s @@ -0,0 +1,21 @@ +.define Rtt + +! This subroutine performs the return from trap. + + +Rtt: + ldy #0 + jsr Ret ! restore old stackpointer and localbase + jsr Pop ! remove trapnumber + jsr Pop + sta hol0+1 + stx hol0 ! restore linenumber + jsr Pop + sta hol0+5 + stx hol0+4 ! restore filename pointer + lda #0 + ldx #RETURN + jsr Sdi ! restore return area + rts + + diff --git a/mach/6500/libem/sar.s b/mach/6500/libem/sar.s new file mode 100644 index 00000000..0b482a2c --- /dev/null +++ b/mach/6500/libem/sar.s @@ -0,0 +1,23 @@ +.define Sar + +! This subroutine performs the SAR instruction. +! For details see rapport IR-81. + + +Sar: + jsr Aar ! get object address + ldy NBYTES+1 ! the size of the object (highbyte) + bne 2f + ldy NBYTES ! the size of the object (lowbyte) + cpy #1 + bne 1f ! object size is one byte + jmp Sti1 ! put it in array + 1: cpy #2 + bne 1f ! object size is two bytes + jmp Sti ! put it in array + 1: cpy #4 + bne 2f ! object size is fourbytes + jmp Sdi ! put it in array + 2: jmp Stil ! put it in array + + diff --git a/mach/6500/libem/sbi.s b/mach/6500/libem/sbi.s new file mode 100644 index 00000000..8c5c3e39 --- /dev/null +++ b/mach/6500/libem/sbi.s @@ -0,0 +1,21 @@ +.define Sbi2 + +! This subroutine subtracts two twobyte signed integers +! and returnes the result in registerpair AX. + + +Sbi2: + stx ARTH ! save second operand (lowbyte) + sta ARTH+1 ! save second operand (highbyte) + jsr Pop + pha + sec + txa ! get first operand (lowbyte) + sbc ARTH ! subtract second operand (lowbyte) + tax + iny + pla ! get first operand (highbyte) + sbc ARTH+1 ! subtract second operand (highbyte) + rts + + diff --git a/mach/6500/libem/sbi4.s b/mach/6500/libem/sbi4.s new file mode 100644 index 00000000..b4a12a27 --- /dev/null +++ b/mach/6500/libem/sbi4.s @@ -0,0 +1,17 @@ +.define Sbi4 + +! This subroutine subtracts two fourbyte signed integers. + + +Sbi4: + jsr Addsub ! initiate addresses + sec + 1: lda (ADDR+2),y ! get lowbyte+y first operand + sbc (ADDR),y ! subtract lowbyte+y second operand + sta (ADDR+2),y ! put on stack lowbyte+y result + iny + inx + bne 1b + rts + + diff --git a/mach/6500/libem/sdl.s b/mach/6500/libem/sdl.s new file mode 100644 index 00000000..11def2b3 --- /dev/null +++ b/mach/6500/libem/sdl.s @@ -0,0 +1,25 @@ +.define Sdi, Sdo + +! The subroutine Sdi takes a fourbyte word and stores it +! at the address in registerpair AX. +! If the address is in zeropage, Sdo is used. + + +Sdi: + stx ADDR ! address (lowbyte) + sta ADDR+1 ! address (highbyte) +Sdo: + ldy #0 + 1: jsr Pop + pha + txa + sta (ADDR),y ! store lowbyte + iny + pla + sta (ADDR),y ! store highbyte + iny + cpy #4 + bne 1b + rts + + diff --git a/mach/6500/libem/set.s b/mach/6500/libem/set.s new file mode 100644 index 00000000..f64f74f4 --- /dev/null +++ b/mach/6500/libem/set.s @@ -0,0 +1,36 @@ +.define Set + +! This subroutine creates a set of n (n <= 256) bytes. +! In this set a certain bit, which number is in registerpair AX, +! is set. The rest is zero. + + +Set: + stx ARTH ! save bitnumber (lowbyte) + sta ARTH+1 ! save bitnumber (highbyte) + jsr Zer ! create n zerobytes + lda ARTH + and #07h ! n mod 8 (bitnumber in byte) + tax + lda #1 + cpx #0 + beq 2f + 1: asl a ! set bit (n mod 8) + dex + bne 1b + 2: sta ARTH+2 + ldx #3 + 1: lsr ARTH+1 ! shiftright n 3 times (= n div 8) + ror ARTH ! this is the bytenumber + dex + bne 1b + ldy ARTH ! load bytenumber + lda SP+1 + ldx SP+2 + stx ADDR ! address of set (lowbyte) + sta ADDR+1 ! address of set (highbyte) + lda ARTH+2 ! get bit + sta (ADDR),y ! store byte with bit on + rts + + diff --git a/mach/6500/libem/sli.s b/mach/6500/libem/sli.s new file mode 100644 index 00000000..9d195593 --- /dev/null +++ b/mach/6500/libem/sli.s @@ -0,0 +1,23 @@ +.define Sli2 + +! This subroutine shifts a signed or unsigned interger to the +! left n times. +! N is in register X. +! The returned value is in registerpair AX. + + +Sli2: + txa + bne 1f + jmp Pop ! zero shift, return input + 1: tay + jsr Pop ! get integer + stx Ytmp ! save lowbyte + 2: asl Ytmp + rol a ! shift left + dey + bne 2b + ldx Ytmp ! get lowbyte + rts + + diff --git a/mach/6500/libem/sli4.s b/mach/6500/libem/sli4.s new file mode 100644 index 00000000..d9c670cd --- /dev/null +++ b/mach/6500/libem/sli4.s @@ -0,0 +1,35 @@ +.define Sli4 + +! This subroutine shift a signed or unsigned fourbyte integer +! n times left. N is in register X. + + +Sli4: + cpx #0 + beq 9f ! zero shift, return input + lda SP+2 ! the shifting is done on the stack + sta ADDR ! address of integer (lowbyte) + lda SP+1 + sta ADDR+1 ! address of integer (highbyte) + 2: ldy #0 + clc + lda (ADDR),y + rol a + sta (ADDR),y + iny + lda (ADDR),y + rol a + sta (ADDR),y + iny + lda (ADDR),y + rol a + sta (ADDR),y + iny + lda (ADDR),y + rol a + sta (ADDR),y ! shift left + dex + bne 2b + 9: rts + + diff --git a/mach/6500/libem/sri.s b/mach/6500/libem/sri.s new file mode 100644 index 00000000..da44e072 --- /dev/null +++ b/mach/6500/libem/sri.s @@ -0,0 +1,40 @@ +.define Sri2, Sru2 + +! The subroutine Sri2 shifts a signed integer n times right. +! In the case of a negative integer there is signextension. +! The subroutine Sru2 shifts right an unsigned integer. +! The returned value is in registerpair AX. + + +Sru2: + txa + bne 1f + jmp Pop ! zero shift, return input + 1: tay + jsr Pop ! get integer + stx Ytmp ! save lowbyte + jmp 2f ! shift unsigned +Sri2: + txa + bne 1f + jmp Pop ! zero shift, return input + 1: tay + jsr Pop ! get integer + stx Ytmp ! save lowbyte + tax + bmi 1f ! negative signextended shift + 2: lsr a + ror Ytmp ! shift not signextended + dey + bne 2b + ldx Ytmp ! get lowbyte + rts + 1: sec ! shift signextended + ror a + ror Ytmp + dey + bne 1b + ldx Ytmp ! get lowbyte + rts + + diff --git a/mach/6500/libem/sri4.s b/mach/6500/libem/sri4.s new file mode 100644 index 00000000..46b3b7be --- /dev/null +++ b/mach/6500/libem/sri4.s @@ -0,0 +1,52 @@ +.define Sri4, Sru4 + +! The subroutine Sri4 shifts a signed fourbyte integer to the +! right n times +! N is in register X. +! The subroutine Sru4 shifts an unsigned fourbyte integer to the +! right n times. + +Sru4: + txa + tay + bne 1f + rts + 1: jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + jmp 2f +Sri4: + txa + tay + bne 1f + rts + 1: jsr Pop + stx ARTH + sta ARTH+1 + jsr Pop + stx ARTH+2 + tax + bmi 1f + 2: lsr a + ror ARTH+2 + ror ARTH+1 + ror ARTH + dey + bne 2b + beq 4f + 1: sec + ror a + ror ARTH+2 + ror ARTH+1 + ror ARTH + 3: dey + bne 1b + 4: ldx ARTH+2 + jsr Push + lda ARTH+1 + ldx ARTH + jmp Push + + diff --git a/mach/6500/libem/sti.s b/mach/6500/libem/sti.s new file mode 100644 index 00000000..b9772249 --- /dev/null +++ b/mach/6500/libem/sti.s @@ -0,0 +1,24 @@ +.define Sti, Sext, Stii + +! The subroutine Sti stores an twobyte word at the address which +! is in registerpair AX. +! The subroutine Sext is used when the address is already in +! zeropage. +! The subroutine Stii is used when the address is in zeropage +! and the registerpair AX contains the word. + + +Sti: + stx ADDR ! address of word (lowbyte) + sta ADDR+1 ! address of word (highbyte) +Sext: + jsr Pop ! get word +Stii: + ldy #1 + sta (ADDR),y ! store highbyte + dey + txa + sta (ADDR),y ! store lowbyte + rts + + diff --git a/mach/6500/libem/sti1.s b/mach/6500/libem/sti1.s new file mode 100644 index 00000000..2665a805 --- /dev/null +++ b/mach/6500/libem/sti1.s @@ -0,0 +1,16 @@ +.define Sti1 + +! This subroutine stores an onebyte wordfractional at the address +! which is in registerpair AX. + + +Sti1: + stx ADDR ! address of byte (lowbyte) + sta ADDR+1 ! address of byte (highbyte) + jsr Pop ! get byte + ldy #0 + txa + sta (ADDR),y ! store byte + rts + + diff --git a/mach/6500/libem/stil.s b/mach/6500/libem/stil.s new file mode 100644 index 00000000..c44f2979 --- /dev/null +++ b/mach/6500/libem/stil.s @@ -0,0 +1,26 @@ +.define Stil + +! This subroutine stores indirect a block of bytes if +! the number of bytes is greater than four. +! The destination address is in registerpair AX. +! The lowbyte of the number of bytes is in Y, +! the highbyte is in zeropage location NBYTES+1. + + +Stil: + sta ADDR+3 ! destination address (highbyte) + stx ADDR+2 ! destination address (lowbyte) + sty NBYTES ! number of bytes (lowbyte) + clc + lda SP+2 + sta ADDR ! source address (lowbyte) + adc NBYTES + sta SP+2 ! new stackpointer (lowbyte) + lda SP+1 + sta ADDR+1 ! source address (highbyte) + adc NBYTES+1 + sta SP+1 ! new stackpointer (highbyte) + inc NBYTES+1 + jmp Blmnp ! do the move + + diff --git a/mach/6500/libem/stl.s b/mach/6500/libem/stl.s new file mode 100644 index 00000000..353e00b8 --- /dev/null +++ b/mach/6500/libem/stl.s @@ -0,0 +1,17 @@ +.define Stl + +! This subroutine performs the storage of a local which offset +! is to big. + + +Stl: + jsr Locaddr ! get the local address + jsr Pop ! get the word + ldy #1 + sta (ADDR),y ! store highbyte + dey + txa + sta (ADDR),y ! store lowbyte + rts + + diff --git a/mach/6500/libem/sts.s b/mach/6500/libem/sts.s new file mode 100644 index 00000000..8c6ffa94 --- /dev/null +++ b/mach/6500/libem/sts.s @@ -0,0 +1,28 @@ +.define Sts + +! This subroutine stores indirect a number of bytes. +! The number of bytes is in the registerpair AX. + + +Sts: + cmp #0 + bne 3f ! number of bytes > 255 + cpx #1 + bne 1f ! onebyte storage + jsr Pop ! get the address + jmp Sti1 ! store the byte + 1: cpx #2 + bne 2f ! twobyte storage + jsr Pop ! get the address + jmp Sti ! store the word + 2: cpx #4 + bne 3f ! fourbyte storage + jsr Pop ! get the address + jmp Sdi ! store the double word + 3: sta ARTH+1 ! objectsize > 4 + txa + tay + jsr Pop ! get address + jmp Stil ! store the object + + diff --git a/mach/6500/libem/teq.s b/mach/6500/libem/teq.s new file mode 100644 index 00000000..a346e618 --- /dev/null +++ b/mach/6500/libem/teq.s @@ -0,0 +1,20 @@ +.define Teq + +! This subroutine test if the value in registerpair AX is zero +! or nonzero. +! The returned value, a 1 or a 0, is in AX. + + +Teq: + tay + beq 1f ! A is zero + 2: lda #0 ! AX is zero + tax + rts + 1: txa + bne 2b ! X is zero + lda #0 ! AX is nonzero + ldx #1 + rts + + diff --git a/mach/6500/libem/test2.s b/mach/6500/libem/test2.s new file mode 100644 index 00000000..c07497c7 --- /dev/null +++ b/mach/6500/libem/test2.s @@ -0,0 +1,19 @@ +.define Test2 + +! This subroutine tests if the value on top of the stack is 2. +! It is used if the size is on top of the stack. +! The word which is to be handled is returned in registerpair AX. + + +Test2: + tay + bne 1f ! value > 255 + cpx #2 + bne 1f ! value <> 2 + jsr Pop ! get word + rts + 1: ldx #Eoddz + lda #0 + jsr Trap + + diff --git a/mach/6500/libem/testFFh.s b/mach/6500/libem/testFFh.s new file mode 100644 index 00000000..a02c4544 --- /dev/null +++ b/mach/6500/libem/testFFh.s @@ -0,0 +1,23 @@ +.define TestFFh + +! This subroutine tests if the value on top of the stack is <= 256. +! It is used if the istruction argument is on top of the stack. +! The value is saved in Y. + + +TestFFh: + cmp #2 + bpl 1f ! value > 256 + cmp #0 + beq 2f + cpx #0 + bne 1f ! value is zero + 2: dex + txa + tay + rts + 1: ldx #Eoddz + lda #0 + jsr Trap + + diff --git a/mach/6500/libem/tge.s b/mach/6500/libem/tge.s new file mode 100644 index 00000000..49050fd4 --- /dev/null +++ b/mach/6500/libem/tge.s @@ -0,0 +1,18 @@ +.define Tge + +! This subroutine test if the value in registerpair AX is +! greater than or equal to zero. +! The result is returned in AX. + + +Tge: + tay + bpl 1f ! A >= 0 + lda #0 ! AX < 0 + tax + rts + 1: lda #0 ! AX >= 0 + ldx #1 + rts + + diff --git a/mach/6500/libem/tgt.s b/mach/6500/libem/tgt.s new file mode 100644 index 00000000..e2e5f3ba --- /dev/null +++ b/mach/6500/libem/tgt.s @@ -0,0 +1,21 @@ +.define Tgt + +! This subroutine tests if the value in registerpair AX is +! greater than zero. +! The value returned is in AX. + +Tgt: + tay + bpl 1f ! A >= 0 + 3: lda #0 ! AX <= 0 + tax + rts + 1: beq 1f ! A = 0 + 2: lda #0 ! AX > 0 + ldx #1 + rts + 1: txa + bne 2b ! X > 0 + beq 3b ! X = 0 + + diff --git a/mach/6500/libem/tle.s b/mach/6500/libem/tle.s new file mode 100644 index 00000000..073bdbb6 --- /dev/null +++ b/mach/6500/libem/tle.s @@ -0,0 +1,22 @@ +.define Tle + +! This subroutine tests if the value in registerpair AX is +! less than or equal to zero. +! The value returned is in AX. + + +Tle: + tay + bpl 1f ! A >= 0 + 3: lda #0 ! AX <= 0 + ldx #1 + rts + 1: beq 1f ! A = 0 + 2: lda #0 ! AX > 0 + tax + rts + 1: txa + bne 2b ! X > 0 + beq 3b ! x = 0 + + diff --git a/mach/6500/libem/tlt.s b/mach/6500/libem/tlt.s new file mode 100644 index 00000000..557dfdca --- /dev/null +++ b/mach/6500/libem/tlt.s @@ -0,0 +1,18 @@ +.define Tlt + +! This subroutine tests if the value in registerpair AX is +! less than zero. +! The value returned is in AX. + + +Tlt: + tay + bpl 1f ! A >= 0 + lda #0 ! AX < 0 + ldx #1 + rts + 1: lda #0 ! AX >= 0 + tax + rts + + diff --git a/mach/6500/libem/tne.s b/mach/6500/libem/tne.s new file mode 100644 index 00000000..aaaf18e4 --- /dev/null +++ b/mach/6500/libem/tne.s @@ -0,0 +1,20 @@ +.define Tne + +! This subroutine tests if the value in registerpair AX is +! not equal to zero. +! The value returned is in AX. + + +Tne: + tay + beq 1f ! A = 0 + 2: lda #0 ! AX <> 0 + ldx #1 + rts + 1: txa + bne 2b ! X <> 0 + lda #0 ! AX = 0 + tax + rts + + diff --git a/mach/6500/libem/trap.s b/mach/6500/libem/trap.s new file mode 100644 index 00000000..ef7d9e9d --- /dev/null +++ b/mach/6500/libem/trap.s @@ -0,0 +1,134 @@ +.define Trap + +! This subroutine performs the trap instruction. + +Trap: + txa + cmp #64 + bcc 1f + 2: jmp Dotrap + 1: bmi 2b + pha + lda IGNMASK ! get bitmask (lowbyte) + sta ARTH + lda IGNMASK+1 ! get bitmask (highbyte) + 2: lsr a + ror ARTH ! shiftright bitmask n times + dex + bne 2b + lda #1 + and ARTH + bne 3f + pla ! clear hardware_stack + jmp Dotrap + 3: pla ! clear hardware_stack + rts + +Dotrap: + sta TRAPVAL + lda #0 + cmp ERRPROC+1 + bne 1f ! ERRPROC <> 0 (highbyte) + cmp ERRPROC + bne 1f ! ERRPROC <> 0 (lowbyte) + jmp Mtrap + 1: lda #0 + ldx #RETURN + jsr Ldi ! save return area + lda hol0+5 + ldx hol0+4 + jsr Push ! save filename pointer + lda hol0+1 + ldx hol0 + jsr Push ! save linenumber + lda ERRPROC + sta ADDR ! address of errorhandler (lowbyte) + lda ERRPROC+1 + sta ADDR+1 ! address of errorhandler (highbyte) + lda #0 + sta ERRPROC ! reset ERRPROC (lowbyte) + sta ERRPROC+1 ! reset ERRPROC (highbyte) + ldx TRAPVAL + jsr Push + jmp (ADDR) ! proceed with errorhandler + +Mtrap: + cpx #0 + bne 1f + lda #[EARRAY].h + ldx #[EARRAY].l + jsr Mprint + jmp errorend + 1: cpx #1 + bne 1f + lda #[ERANGE].h + ldx #[ERANGE].l + jsr Mprint + jmp errorend + 1: cpx #2 + bne 1f + lda #[ESET].h + ldx #[ESET].l + jsr Mprint + jmp errorend + 1: cpx #3 + bne 1f + lda #[EIOVFL].h + ldx #[EIOVFL].l + jsr Mprint + jmp errorend + 1: cpx #10 + bne 1f + lda #[ECONV].h + ldx #[ECONV].l + jsr Mprint + jmp errorend + 1: cpx #16 + bne 1f + lda #[ESTACK].h + ldx #[ESTACK].l + jsr Mprint + jmp errorend + 1: cpx #17 + bne 1f + lda #[EHEAP].h + ldx #[EHEAP].l + jsr Mprint + jmp errorend + 1: cpx #19 + bne 1f + lda #[EODDZ].h + ldx #[EODDZ].l + jsr Mprint + jmp errorend + 1: cpx #20 + bne 1f + lda #[ECASE].h + ldx #[ECASE].l + jsr Mprint + jmp errorend + 1: cpx #25 + bne 1f + lda #[EBADMON].h + ldx #[EBADMON].l + jsr Mprint + jmp errorend + 1: cpx #26 + bne 1f + lda #[EBADLIN].h + ldx #[EBADLIN].l + jsr Mprint + jmp errorend + 1: cpx #27 + bne errorend + lda #[EBADGTO].h + ldx #[EBADGTO].l + jsr Mprint +errorend: + ldx STACK + dex + dex + txs + rts + + diff --git a/mach/6500/libem/write.s b/mach/6500/libem/write.s new file mode 100644 index 00000000..4bc1e245 --- /dev/null +++ b/mach/6500/libem/write.s @@ -0,0 +1,34 @@ +.define Mwrite + +! This subroutine performs the monitor call write. +! Writing is always done to standardoutput. +! A zero is returned on exit. +! The subroutine WRCH is a special routine of the BBC +! microcomputer. + + +Mwrite: + jsr Pop ! get fildes + jsr Pop ! get address of characterbuffer + stx ADDR ! bufferaddress (lowbyte) + sta ADDR+1 ! bufferaddress (highbyte) + jsr Pop ! number of characters to be writen. + ldy #0 + 1: lda (ADDR),y + cmp #10 + bne 2f + pha + lda #13 + jsr WRCH + pla + 2: jsr WRCH + iny + dex + bne 1b + tya + tax + lda #0 + jsr Push + tax + rts + diff --git a/mach/6500/libem/xor.s b/mach/6500/libem/xor.s new file mode 100644 index 00000000..5ef73a7c --- /dev/null +++ b/mach/6500/libem/xor.s @@ -0,0 +1,30 @@ +.define Xor + +! This subroutine performs the exclusive or on two groups of bytes. +! The groups consists of atmost 254 bytes. +! The result is on top of the stack. + + +Xor: + lda SP+1 + sta ADDR+1 ! address of first group (lowbyte) + lda SP+2 + sta ADDR ! address of first group (highbyte) + clc + tya + adc SP+2 + sta SP+2 ! new stackpointer (lowbyte) + sta ADDR+2 ! address of second group (lowbyte) + lda #0 + adc SP+1 + sta SP+1 ! new stackpointer (highbyte) + sta ADDR+3 ! address of second group (highbyte) + 1: dey + lda (ADDR),y ! get byte first group + eor (ADDR+2),y ! exclusive or with byte second group + sta (ADDR+2),y ! restore result + tya + bne 1b + rts + + diff --git a/mach/6500/libem/zer.s b/mach/6500/libem/zer.s new file mode 100644 index 00000000..9c648508 --- /dev/null +++ b/mach/6500/libem/zer.s @@ -0,0 +1,20 @@ +.define Zer + +! This subroutine puts n (n <=256) zero bytes on top of +! the stack. +! The number of bytes minus one is in Y. + + +Zer: + tya + lsr a ! number of bytes div 2 + tay + iny + lda #0 + tax + 2: jsr Push ! push two bytes + dey + bne 2b + rts + + diff --git a/mach/6500/libem/zri.s b/mach/6500/libem/zri.s new file mode 100644 index 00000000..abc75f90 --- /dev/null +++ b/mach/6500/libem/zri.s @@ -0,0 +1,18 @@ +.define Zrl, Zro + +! The subroutine Zrl makes a local zero which offset is to big. +! The offset of the local is in registerpair AX. +! The subroutine Zro is used if the address is already in zeropage. + + +Zrl: + jsr Locaddr ! get address of local +Zro: + lda #0 + tay + sta (ADDR),y ! lowbyte = 0 + iny + sta (ADDR),y ! highbyte = 0 + rts + + diff --git a/mach/6500/libpc/Makefile b/mach/6500/libpc/Makefile new file mode 100644 index 00000000..13271c21 --- /dev/null +++ b/mach/6500/libpc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=6500" "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 diff --git a/mach/6500/libpc/compmodule b/mach/6500/libpc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/6500/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/6800/Action b/mach/6800/Action new file mode 100644 index 00000000..a135c187 --- /dev/null +++ b/mach/6800/Action @@ -0,0 +1,3 @@ +name "Motorola 6800 assembler" +dir as +end diff --git a/mach/6805/Action b/mach/6805/Action new file mode 100644 index 00000000..7f523c9d --- /dev/null +++ b/mach/6805/Action @@ -0,0 +1,3 @@ +name "Motorola 6805 assembler" +dir as +end diff --git a/mach/6809/Action b/mach/6809/Action new file mode 100644 index 00000000..68967f01 --- /dev/null +++ b/mach/6809/Action @@ -0,0 +1,3 @@ +name "Motorola 6809 assembler" +dir as +end diff --git a/mach/arm/ncg/Makefile b/mach/arm/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/arm/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/compare b/mach/compare new file mode 100755 index 00000000..fc54003f --- /dev/null +++ b/mach/compare @@ -0,0 +1,7 @@ +case $# in +1) DEST="$1" ;; +2) DEST="$2" ;; +*) echo $0 [source] destination ;; +esac +MACH=`(cd .. ; basename \`pwd\`)` +cmp "$1" ../../../lib/${MACH}/$DEST diff --git a/mach/em22/Action b/mach/em22/Action new file mode 100644 index 00000000..afe32803 --- /dev/null +++ b/mach/em22/Action @@ -0,0 +1,9 @@ +name "2-2 Interpreter C libraries" +dir libcc +end +name "2-2 Interpreter Pascal library" +dir libpc +end +name "2-2 Interpreter Basic library" +dir libbc +end diff --git a/mach/em22/libbc/Makefile b/mach/em22/libbc/Makefile new file mode 100644 index 00000000..2a469460 --- /dev/null +++ b/mach/em22/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=int22" "SUF=m" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/em22/libbc/compmodule b/mach/em22/libbc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em22/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em22/libcc/Makefile b/mach/em22/libcc/Makefile new file mode 100644 index 00000000..8c5babec --- /dev/null +++ b/mach/em22/libcc/Makefile @@ -0,0 +1,49 @@ +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 cpmon 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 cmpmon 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 diff --git a/mach/em22/libcc/compmodule b/mach/em22/libcc/compmodule new file mode 100755 index 00000000..671dce6d --- /dev/null +++ b/mach/em22/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -Rcpp=/lib/cpp -I/usr/em/h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em22/libpc/Makefile b/mach/em22/libpc/Makefile new file mode 100644 index 00000000..e96da058 --- /dev/null +++ b/mach/em22/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/em22/libpc/compmodule b/mach/em22/libpc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em22/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em24/Action b/mach/em24/Action new file mode 100644 index 00000000..d29cd593 --- /dev/null +++ b/mach/em24/Action @@ -0,0 +1,9 @@ +name "2-4 Interpreter C libraries" +dir libcc +end +name "2-4 Interpreter Pascal library" +dir libpc +end +name "2-4 Interpreter Basic library" +dir libbc +end diff --git a/mach/em24/libbc/Makefile b/mach/em24/libbc/Makefile new file mode 100644 index 00000000..49e3164d --- /dev/null +++ b/mach/em24/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=int24" "SUF=m" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/em24/libbc/compmodule b/mach/em24/libbc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em24/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em24/libcc/Makefile b/mach/em24/libcc/Makefile new file mode 100644 index 00000000..971906ef --- /dev/null +++ b/mach/em24/libcc/Makefile @@ -0,0 +1,49 @@ +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 cpmon 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 cmpmon 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 diff --git a/mach/em24/libcc/compmodule b/mach/em24/libcc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em24/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em24/libpc/Makefile b/mach/em24/libpc/Makefile new file mode 100644 index 00000000..79770926 --- /dev/null +++ b/mach/em24/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/em24/libpc/compmodule b/mach/em24/libpc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em24/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em44/Action b/mach/em44/Action new file mode 100644 index 00000000..e507c112 --- /dev/null +++ b/mach/em44/Action @@ -0,0 +1,9 @@ +name "4-4 Interpreter C libraries" +dir libcc +end +name "4-4 Interpreter Pascal library" +dir libpc +end +name "4-4 Interpreter Basic library" +dir libbc +end diff --git a/mach/em44/libbc/Makefile b/mach/em44/libbc/Makefile new file mode 100644 index 00000000..8f260a8d --- /dev/null +++ b/mach/em44/libbc/Makefile @@ -0,0 +1,21 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=int44" "SUF=m" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/em44/libbc/compmodule b/mach/em44/libbc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em44/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em44/libcc/Makefile b/mach/em44/libcc/Makefile new file mode 100644 index 00000000..9f0eb0f0 --- /dev/null +++ b/mach/em44/libcc/Makefile @@ -0,0 +1,49 @@ +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 cpmon 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 cmpmon 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 diff --git a/mach/em44/libcc/compmodule b/mach/em44/libcc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em44/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/em44/libpc/Makefile b/mach/em44/libpc/Makefile new file mode 100644 index 00000000..e9ad8f68 --- /dev/null +++ b/mach/em44/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/em44/libpc/compmodule b/mach/em44/libpc/compmodule new file mode 100755 index 00000000..330b4aef --- /dev/null +++ b/mach/em44/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} -LIB $1 1>&2 +echo `basename $1 $2`.m diff --git a/mach/i386/ncg/Makefile b/mach/i386/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/i386/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/i80/Action b/mach/i80/Action new file mode 100644 index 00000000..2687f7be --- /dev/null +++ b/mach/i80/Action @@ -0,0 +1,3 @@ +name "Intel 8080 assembler" +dir as +end diff --git a/mach/i80/libbc/Makefile b/mach/i80/libbc/Makefile new file mode 100644 index 00000000..d6d01c0b --- /dev/null +++ b/mach/i80/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=8080" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/i80/libbc/compmodule b/mach/i80/libbc/compmodule new file mode 100755 index 00000000..2bcf66ca --- /dev/null +++ b/mach/i80/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?ack} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/i80/libcc/Makefile b/mach/i80/libcc/Makefile new file mode 100644 index 00000000..83804182 --- /dev/null +++ b/mach/i80/libcc/Makefile @@ -0,0 +1,37 @@ +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 diff --git a/mach/i80/libmon/mon.s b/mach/i80/libmon/mon.s new file mode 100644 index 00000000..2e8e5dc2 --- /dev/null +++ b/mach/i80/libmon/mon.s @@ -0,0 +1,77 @@ +.define .mon + +! Monitor call +! Expects on stack: monitor call number +! parameters +! Implemented are the following monitor calls: +! number 1: exit +! number 3: read +! number 4: write +! If called with a number of a call that is not implemented, +! a trap is generated. + +.mon: pop h + shld .retadr + mov h,b + mov l,c + shld .bcreg + + pop h ! monitor call number + mov a,l + cpi 1 + jz monexit ! is it an exit? + cpi 3 + jz monread ! is it a read? + cpi 4 + jz monwrite ! is it a write? + jmp ebadmon ! trap + +monexit: + rst 4 + +monread: + pop h ! file-descriptor, not used + pop h ! hl = pointer to output buffer + pop d ! de = number of bytes to be read + lxi b,0 ! bc will contain the number of bytes actually read +1: mov a,d + ora e + jz 2f + call getchar + push psw + call putchar ! echo character + pop psw + mov m,a + inx h + inx b + dcx d + cpi 0x0A ! is it a newline? + jnz 1b +2: push b + lxi h,0 + push h + jmp monret + +monwrite: + pop h ! file-descriptor, not used + pop h ! hl = pointer to output buffer + pop d ! de = number of bytes + push d +1: mov a,e + ora d + jz 2f + mov a,m + call putchar + inx h + dcx d + jmp 1b + +2: push d ! no error + jmp monret + +monret: + lhld .bcreg + mov b,h + mov c,l + lhld .retadr + pchl diff --git a/mach/i80/ncg/Makefile b/mach/i80/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/i80/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/i80/ncg/mach.c b/mach/i80/ncg/mach.c new file mode 100644 index 00000000..cdaf75f4 --- /dev/null +++ b/mach/i80/ncg/mach.c @@ -0,0 +1,96 @@ +/* + * (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 Intel 8080. + */ + +con_part(sz,w) register sz; word w; { + + while (part_size % sz) + part_size++; + if (part_size == 2) + 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 (argval != 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() { + + fatal("no reals"); +} + + +prolog(nlocals) full nlocals; { + + fprintf(codefile,"\tpush\tb\n\tlxi\th,0\n\tdad\tsp\n\tmov\tb,h\n\tmov\tc,l\n"); + switch (nlocals) { + case 4: fprintf(codefile,"\tpush\th\n"); + case 2: fprintf(codefile,"\tpush\th\n"); + case 0: break; + default: + fprintf(codefile,"\tlxi\th,%d\n\tdad\tsp\n\tsphl\n",-nlocals); + break; + } +} + +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", + ".data", + ".data", + ".bss" +}; diff --git a/mach/i80/ncg/mach.h b/mach/i80/ncg/mach.h new file mode 100644 index 00000000..b4550770 --- /dev/null +++ b/mach/i80/ncg/mach.h @@ -0,0 +1,22 @@ +#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 id_first '_' +#define BSS_INIT 0 diff --git a/mach/i80/ncg/table b/mach/i80/ncg/table new file mode 100644 index 00000000..f92ed7f7 --- /dev/null +++ b/mach/i80/ncg/table @@ -0,0 +1,1930 @@ + +/************************************************************/ +/************************************************************/ +/******* ******/ +/******* 8 0 8 0 B A C K E N D T A B L E ******/ +/******* ******/ +/************************************************************/ +/************************************************************/ + + +EM_WSIZE = 2 +EM_PSIZE = 2 +EM_BSIZE = 4 + +SL=4 + +PROPERTIES + +areg /* the a-register */ +lbreg /* the registers used as localbase */ +reg /* the free registers */ +regpair /* register pairs bc, de and hl */ +regind /* register indirect */ +dereg /* de-register-pair */ +hlreg /* hl-register-pair */ +hlorde /* de- or hl-register-pair */ +localbase +stackpointer +psword /* consists of a-register + condition codes */ +mem /* not really a register property */ + + +REGISTERS + +a :areg,reg. +b,c :lbreg. +d,e,h,l :reg. +lb("b")=b+c :regpair, localbase, regind. +de("d")=d+e :regpair, regind, dereg, hlorde. +hl("h")=h+l :regpair, hlreg, hlorde. +sp :stackpointer. +psw=a :psword. +m :mem. /* not really a register */ + +TOKENS + +const1 = { INT num; } 1 num . +const2 = { INT num; } 2 num . +label = { ADDR off; } 2 off . + + +SETS + +reg1 = reg + lbreg + mem . +bdhsp = regpair + stackpointer . +bdhpsw = regpair + psword . +immediate = const2 + label . +src1 = reg . +src2 = hlorde + const2 + label . +src1or2 = src1 + src2 . + +INSTRUCTIONS + +/* aci const1:ro kills a:cc cost(2,7) . */ + adc reg1:ro kills a:cc cost(1,4) . + add reg1:ro kills a:cc cost(1,4) . +/* adi const1:ro kills a:cc cost(2,7) . */ + ana reg1:ro kills a:cc cost(1,4) . + ani const1:ro kills a:cc cost(2,7) . + Call "call" label:ro cost(3,17) . + /* 'call' is a reserved word */ +/* cc label:ro cost(11,3) . */ +/* cm label:ro cost(11,3) . */ + cma kills a cost(1,4) . + cmc kills:cc cost(1,4) . + cmp reg1:ro kills:cc cost(1,4) . +/* cnc label:ro cost(11,3) . */ + cnz label:ro cost(11,3) . +/* cp label:ro cost(11,3) . */ +/* cpe label:ro cost(11,3) . */ + cpi const1:ro kills:cc cost(11,3) . +/* cpo label:ro cost(11,3) . */ +/* cz label:ro cost(11,3) . */ +/* daa kills a:cc cost(1,4) . */ + dad bdhsp:ro kills hl:cc cost(1,10) . + dcr reg1:rw:cc cost(1,5) . + dcx bdhsp:rw cost(1,5) . +/* di cost(1,4) . */ +/* ei cost(1,4) . */ +/* hlt cost(1,4) . */ +/* in const1:ro cost(2,10) . */ + inr reg1:rw:cc cost(1,5) . + inx bdhsp:rw cost(1,5) . + jc label:ro cost(3,10) . + jm label:ro cost(3,10) . + jmp label:ro cost(3,10) . + jnc label:ro cost(3,10) . + jnz label:ro cost(3,10) . + jp label:ro cost(3,10) . +/* jpe label:ro cost(3,10) . */ +/* jpo label:ro cost(3,10) . */ + jz label:ro cost(3,10) . + lda label:ro kills a cost(3,13) . + ldax regind:ro kills a cost(1,7) . + lhld label:ro kills hl cost(3,16) . + lxi bdhsp:wo,immediate:ro cost(3,10) . + mov reg1:wo,reg1:ro cost(1,5) . + mvi reg1:wo,const1:ro cost(2,7) . +/* nop cost(1,0) . */ + ora reg1:ro kills a:cc cost(1,4) . +/* ori const1:ro kills a:cc cost(2,7) . */ +/* out const1:ro cost(2,10) . */ + pchl cost(1,5) . + pop bdhpsw:wo cost(1,10) . + push bdhpsw:ro cost(1,10) . + ral kills a:cc cost(1,4) . + rar kills a:cc cost(1,4) . +/* rc cost(1,8) . */ + ret cost(1,10) . + rlc kills a:cc cost(1,4) . +/* rm cost(1,8) . */ +/* rnc cost(1,8) . */ +/* rnz cost(1,8) . */ +/* rp cost(1,8) . */ +/* rpe cost(1,8) . */ +/* rpo cost(1,8) . */ + rrc kills a:cc cost(1,4) . +/* rst const1:ro cost(1,11) . */ +/* rz cost(1,8) . */ + sbb reg1:ro kills a:cc cost(1,4) . +/* sbi const1:ro kills a:cc cost(2,7) . */ + shld label:ro cost(3,16) . + sphl cost(1,5) . + sta label:ro cost(3,13) . + stax regind:ro cost(1,7) . +/* stc kills:cc cost(1,4) . */ + sub reg1:ro kills a:cc cost(1,4) . + sui const1:ro kills a:cc cost(2,7) . + xchg kills de hl cost(1,4) . + xra reg1:ro kills a:cc cost(1,4) . +/* xri const1:ro kills a:cc cost(2,7) . */ + xthl kills hl cost(1,18) . + + +MOVES + +from reg to reg +gen mov %2,%1 + +from const1 to reg +gen mvi %2,%1 + +from immediate to bdhsp +gen lxi %2,%1 + +from reg to regpair +gen mov %2.2,%1 + mvi %2.1,{const1,0} + +from regpair to regpair +gen mov %2.1,%1.1 + mov %2.2,%1.2 + +TESTS + +to test areg /* just a dummy test, never used */ +gen ora a + +STACKINGRULES + +from regpair to STACK +gen push %1 + +from reg to STACK +uses hlorde +gen move %1,%a + push %a + +from reg to STACK +gen push hl + move %1,hl + xthl. + +from immediate to STACK +uses hlorde +gen lxi %a,%1 + push %a + +from immediate to STACK +gen push hl + move %1,hl + xthl. + +COERCIONS + +from STACK +uses regpair +gen pop %a yields %a + +from STACK +uses hlorde +gen pop %a yields %a.2 + +from STACK +uses areg +gen dcx sp + pop psw + inx sp yields a + +from immediate +uses regpair +gen move %1,%a yields %a + +from const1 +uses reg +gen move %1,%a yields %a + +from reg +uses reusing %1, hlorde +gen mov %a.2,%1 + mvi %a.1,{const1,0} yields %a + +from hlorde yields %1.2 + +from hlorde +uses areg +gen mov a,%1.2 yields a + +PATTERNS + +/*********************************************/ +/* Group 1: Load instructions */ +/*********************************************/ + +pat loc yields {const2,$1} +pat ldc yields {const2,highw($1)} + {const2,loww($1)} +pat lol lol $1==$2 +uses hlreg={const2,$1}, dereg +gen dad lb + mov e,m + inx hl + mov d,m yields de de + +pat lol +uses hlreg={const2,$1}, dereg +gen dad lb + mov e,m + inx hl + mov d,m yields de + +pat loe loe $1==$2 +uses hlreg +gen lhld {label,$1} yields hl hl + +pat loe +uses hlreg +gen lhld {label,$1} yields hl + +pat lil +uses hlreg={const2,$1}, dereg +gen dad lb + mov e,m + inx hl + mov h,m + mov l,e + mov e,m + inx hl + mov d,m yields de + +pat lof +with hlorde +kills hlorde +uses hlorde={const2,$1} +gen dad de + mov e,m + inx hl + mov d,m yields de + +pat lal +uses hlreg={const2,$1} +gen dad lb yields hl + +pat lae yields {label,$1} + +pat lxl $1==0 yields lb + +pat lxl $1==1 +uses dereg, hlreg +gen move {const2,SL},hl + dad lb + mov e,m + inx hl + mov d,m yields de + +pat lxl $1>1 +uses dereg, areg={const1,$1}, hlreg +gen move lb,de + 1: + lxi hl,{const2,SL} + dad de + mov e,m + inx hl + mov d,m + dcr a + jnz {label,"1b"} yields de + +pat lxa $1==0 +uses hlreg +gen move {const2,SL},hl + dad lb yields hl + +pat lxa $1==1 +uses dereg, hlreg +gen move {const2,SL},hl + dad lb + mov e,m + inx hl + mov d,m + lxi hl,{const2,SL} + dad de yields hl + +pat lxa $1>1 && $1<256 +uses dereg, hlreg, areg={const1,$1} +gen move lb,de + 1: + lxi hl,{const2,SL} + dad de + mov e,m + inx hl + mov d,m + dcr a + jnz {label,"1b"} + lxi hl,{const2,SL} + dad de yields hl + +pat loi $1==1 +with exact label + uses areg + gen lda %1 yields a +with dereg + uses areg + gen ldax de yields a +with hlreg + uses reg + gen mov %a,m yields %a + +pat loi $1==2 +with exact label + gen lhld %1 yields hl +with hlreg + uses dereg + gen mov e,m + inx %1 + mov d,m yields de + +pat loi $1==4 +with exact label + gen lhld %1 + xchg. + lhld {label,%1.off+2} yields hl de +with exact label + gen lhld {label,%1.off+2} + xchg. + lhld %1 yields de hl +with hlreg + uses dereg, areg + gen mov e,m + inx %1 + mov d,m + inx hl + mov a,m + inx hl + mov h,m + mov l,a yields hl de + +pat loi $1<=510 +with hlorde STACK +uses hlorde={const2,$1-1}, areg +gen dad de + mvi a,{const1,$1/2} + 1: + mov d,m + dcx hl + mov e,m + dcx hl + push de + dcr a + jnz {label,"1b"} + +pat loi $1>=512 +with STACK +uses dereg={const2,$1} +gen Call {label,".loi"} + +pat los $1==2 +with dereg STACK +gen Call {label,".loi"} + +pat ldl +with STACK +uses dereg, hlreg={const2,$1+3} +gen dad lb + mov d,m + dcx hl + mov e,m + dcx hl + push de + mov d,m + dcx hl + mov e,m yields de + +pat lde +with STACK +gen lhld {label,$1+2} + push hl + lhld {label,$1} yields hl +with +uses dereg, hlreg +gen lhld {label,$1} + xchg. + lhld {label,$1+2} yields hl de +with +uses dereg, hlreg +gen lhld {label,$1+2} + xchg. + lhld {label,$1} yields de hl + +pat ldf +with hlorde STACK +uses hlorde={const2,$1+3} +gen dad de + mov d,m + dcx hl + mov e,m + dcx hl + push de + mov d,m + dcx hl + mov e,m yields de + +pat lpi +uses hlorde={label,$1} yields %a + +/******************************************/ +/* Group 2: Store instructions */ +/******************************************/ + +pat stl lol $1==$2 +with dereg yields de de leaving stl $1 + +pat stl +with dereg +uses hlreg={const2,$1} +gen dad lb + mov m,e + inx hl + mov m,d + +pat ste loe $1==$2 +with hlreg yields hl hl leaving ste $1 + +pat ste +with hlreg +gen shld {label,$1} + +pat sil +with dereg +uses hlreg={const2,$1}, areg +gen dad lb + mov a,m + inx hl + mov h,m + mov l,a + mov m,e + inx hl + mov m,d + +pat sil lil $1==$2 +with dereg +uses hlreg={const2,$1}, areg +gen dad lb + mov a,m + inx hl + mov h,m + mov l,a + mov m,e + inx hl + mov m,d yields de + +pat lil loc adi sil $1==$4 && $3==2 +with STACK +uses hlreg={const2,$1}, dereg, areg +gen dad lb + mov e,m + inx hl + mov h,m + mov l,e + mov e,m + inx hl + mov d,m + push hl + lxi hl,{const2,$2} + dad de + xchg. + pop hl + mov m,d + dcx hl + mov m,e + +pat lil inc sil $1==$3 +uses hlreg={const2,$1}, areg +gen dad lb + mov a,m + inx hl + mov h,m + mov l,a + inr m + jnz {label,"1f"} + inx hl + inr m + 1: + +pat lil dec sil $1==$3 +uses hlreg={const2,$1}, dereg +gen dad lb + mov e,m + inx hl + mov h,m + mov l,e + mov e,m + inx hl + mov d,m + dcx de + mov m,d + dcx hl + mov m,e + +pat stf +with hlorde STACK +uses hlorde={const2,$1} +gen dad de + pop de + mov m,e + inx hl + mov m,d + +pat sti $1==1 +with exact label areg + gen sta %1 +with exact dereg areg + gen stax de +with hlreg reg + gen mov m,%2 + + +pat sti $1==2 +with exact label hlreg +uses hlreg + gen shld %1 +with hlreg dereg + gen mov m,e + inx %1 + mov m,d + +pat sti $1==4 +with exact label hlreg dereg + gen shld %1 + xchg. + shld {label,%1.off+2} +with exact label dereg hlreg + gen shld {label,%1.off+2} + xchg. + shld %1 +with hlreg dereg STACK + gen mov m,e + inx hl + mov m,d + inx hl + pop de + mov m,e + inx hl + mov m,d + +pat sti $1<511 +with hlreg STACK +uses areg={const1,$1/2}, dereg +gen 1: + pop de + mov m,e + inx hl + mov m,d + inx hl + dcr a + jnz {label,"1b"} + +pat sti +with STACK +uses dereg={const2,$1} +gen Call {label,".sti"} + +pat sts $1==2 +with dereg STACK +gen Call {label,".sti"} + +pat sdl +with dereg STACK +uses hlreg={const2,$1} +gen dad lb + mov m,e + inx hl + mov m,d + inx hl + pop de + mov m,e + inx hl + mov m,d + +pat sde +with hlreg STACK +gen shld {label,$1} + pop hl + shld {label,$1+2} +with hlreg dereg STACK +gen shld {label,$1} + xchg. + shld {label,$1+2} +with dereg hlreg STACK +gen shld {label,$1+2} + xchg. + shld {label,$1} + +pat sdf +with hlorde STACK +uses hlorde={const2,$1} +gen dad de + pop de + mov m,e + inx hl + mov m,d + inx hl + pop de + mov m,e + inx hl + mov m,d + +/****************************************/ +/* Group 3: Integer arithmetic */ +/****************************************/ + +pat adi $1==2 +with hlreg dereg + gen dad de yields hl +with dereg hlreg + gen dad de yields hl +with hlreg hlreg + gen dad hl yields hl + +pat adi $1==4 +with STACK +gen Call {label,".adi4"} + +pat sbi $1==2 +with hlorde hlorde +uses areg +gen mov a,%2.2 + sub %1.2 + mov %2.2,a + mov a,%2.1 + sbb %1.1 + mov %2.1,a yields %2 +with hlorde hlorde +uses areg +gen mov a,%2.2 + sub %1.2 + mov %1.2,a + mov a,%2.1 + sbb %1.1 + mov %1.1,a yields %1 + +pat sbi $1==4 +with STACK +gen Call {label,".sbi4"} + +pat mli $1==2 +with STACK +gen Call {label,".mli2"} yields de + +pat mli $1==4 +with STACK +gen Call {label,".mli4"} + +pat dvi $1==2 +with STACK +uses areg={const1,129} +gen Call {label,".dvi2"} yields de + +pat dvi $1==4 +with STACK +uses areg={const1,129} +gen Call {label,".dvi4"} + +pat rmi $1==2 +with STACK +uses areg={const1,128} +gen Call {label,".dvi2"} yields de + +pat rmi $1==4 +with STACK +uses areg={const1,128} +gen Call {label,".dvi4"} + +pat ngi $1==2 +with hlorde +uses areg +gen xra a + sub %1.2 + mov %1.2,a + mvi a,{const1,0} + sbb %1.1 + mov %1.1,a yields %1 + +pat ngi $1==4 +with STACK +gen Call {label,".ngi4"} + +pat sli $1==2 +with STACK +gen Call {label,".sli2"} yields de + +pat sli $1==4 +with STACK +gen Call {label,".sli4"} + +pat sri $1==2 +with STACK +uses areg={const1,1} +gen Call {label,".sri2"} yields de + +pat sri $1==4 +with STACK +uses areg={const1,1} +gen Call {label,".sri4"} + +/********************************************/ +/* Group 4: Unsigned arithmetic */ +/********************************************/ + +pat adu leaving adi $1 + +pat sbu leaving sbi $1 + +pat mlu $1==2 +with STACK +gen Call {label,".mlu2"} yields de + +pat mlu $1==4 +with STACK +gen Call {label,".mli4"} + +pat dvu $1==2 +with STACK +uses areg={const1,1} +gen Call {label,".dvi2"} yields de + +pat dvu $1==4 +with STACK +uses areg={const1,1} +gen Call {label,".dvi4"} + +pat rmu $1==2 +with STACK +uses areg={const1,0} +gen Call {label,".dvi2"} yields de + +pat rmu $1==4 +with STACK +uses areg={const1,0} +gen Call {label,".dvi4"} + +pat slu leaving sli $1 + +pat sru $1==2 +with STACK +uses areg={const1,0} +gen Call {label,".sri2"} yields de + +pat sru $1==4 +with STACK +uses areg={const1,0} +gen Call {label,".sri4"} + +/********************************************/ +/* Group 6: Pointer arithmetic */ +/********************************************/ + +pat adp $1==0 /* do nothing */ + +pat adp $1==1 +with hlorde +gen inx %1 yields %1 + +pat adp $1==2 +with hlorde +gen inx %1 + inx %1 yields %1 + +pat adp $1==0-1 +with hlorde +gen dcx %1 yields %1 + +pat adp $1==0-2 +with hlorde +gen dcx %1 + dcx %1 yields %1 + +pat adp +with hlorde +uses hlorde={const2,$1} +gen dad de yields hl + +pat ads $1==2 leaving adi 2 + +pat sbs $1==2 leaving sbi 2 + +/********************************************/ +/* Group 7: Increment/ decrement/ zero */ +/********************************************/ + +pat inc +with hlorde +gen inx %1 yields %1 + +pat inl +uses hlreg={const2,$1} +gen dad lb + inr m + jnz {label,"1f"} + inx hl + inr m + 1: + +pat ine +uses hlreg={label,$1} +gen inr m + jnz {label,"1f"} + inx hl + inr m + 1: + +pat dec +with hlorde +gen dcx %1 yields %1 + +pat del +uses hlreg={const2,$1}, dereg +gen dad lb + mov e,m + inx hl + mov d,m + dcx de + mov m,d + dcx hl + mov m,e + +pat dee +uses hlreg +gen lhld {label,$1} + dcx hl + shld {label,$1} + +pat zrl +uses hlreg={const2,$1}, areg +gen dad lb + xra a + mov m,a + inx hl + mov m,a + +pat zre +uses hlreg={const2,0} +gen shld {label,$1} + +pat zer $1==2 yields {const2,0} + +pat zer $1==4 yields {const2,0} {const2,0} + +pat zer $1<511 +with STACK +uses reg={const1,$1/2}, hlorde={const2,0} +gen 1: + push %b + dcr %a + jnz {label,"1b"} + +pat zer +with STACK +uses hlorde={const2,$1/2}, hlorde={const2,0}, areg +gen xra a + 1: + push %b + dcx %a + cmp %a.2 + jnz {label,"1b"} + cmp %a.1 + jnz {label,"1b"} + +/*****************************************/ +/* Group 8: Convert instructions */ +/*****************************************/ + +pat loc loc cii $1==$2 + +pat loc loc cii $1==2 && $2==4 +with hlorde +uses hlorde={const2,0}, areg +gen mov a,%1.1 + ora a + jp {label,"1f"} + lxi %a,{const2,0-1} + 1: yields %a %1 + +pat loc loc cii $1==4 && $2==2 +with hlorde hlorde yields %1 + +pat loc loc cii $1==1 && $2==2 +with reg +uses areg=%1, hlorde +gen move {const1,0},%b.1 + move a,%b.2 + ora a + jp {label,"1f"} + mvi %b.1,{const1,255} + 1: yields %b +with hlorde +uses areg=%1.2 +gen move {const1,0},%1.1 + ora a + jp {label,"1f"} + mvi %1.1,{const1,255} + 1: yields %1 + +pat loc loc cii $1==1 && $2==4 +with reg + uses hlreg + gen move %1,l yields hl + leaving loc $1 loc $2 cii +with hlreg + uses dereg, areg + gen move {const1,0},%1.1 + move l,a + ora a + jp {label,"1f"} + mvi h,{const1,255} + 1: + mov e,h + mov d,h yields de hl + +pat cii +with STACK +uses areg={const1,1} +gen Call {label,".cii"} + +pat loc loc ciu leaving loc $1 loc $2 cuu +pat loc loc ciu leaving loc $1 loc $2 cuu + +pat cui leaving cuu $1 + +pat ciu leaving cuu $1 + +pat loc loc cuu $1==$2 + +pat loc loc cuu $1==2 && $2==4 +with src1or2 yields {const2,0} %1 + +pat loc loc cuu $1==4 && $1==2 +with src1or2 src1or2 yields %1 + +pat loc loc cuu $1==1 && $2==2 +with reg + uses reusing %1, hlorde + gen move %1,%a yields %a +with hlorde + gen move {const1,0},%1.1 yields %1 + +pat loc loc cuu $1==1 && $2==4 +with reg + uses reusing %1, hlorde + gen move %1,%a yields {const2,0} %a +with hlorde + gen move {const1,0},%1.1 yields {const2,0} %1 + +pat cuu +with STACK +uses areg={const1,0} +gen Call {label,".cii"} + +/*****************************************/ +/* Group 9: Logical instructions */ +/*****************************************/ + +pat and $1==2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + ana %2.2 + mov %2.2,a + mov a,%1.1 + ana %2.1 + mov %2.1,a yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + ana %2.2 + mov %1.2,a + mov a,%1.1 + ana %2.1 + mov %1.1,a yields %1 + +pat and defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".and"} + +pat and !defined($1) +with dereg STACK +gen Call {label,".and"} + +pat ior $1==2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + ora %2.2 + mov %2.2,a + mov a,%1.1 + ora %2.1 + mov %2.1,a yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + ora %2.2 + mov %1.2,a + mov a,%1.1 + ora %2.1 + mov %1.1,a yields %1 + +pat ior defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".ior"} + +pat ior !defined($1) +with dereg STACK +gen Call {label,".ior"} + +pat xor $1==2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + xra %2.2 + mov %2.2,a + mov a,%1.1 + xra %2.1 + mov %2.1,a yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + xra %2.2 + mov %1.2,a + mov a,%1.1 + xra %2.1 + mov %1.1,a yields %1 + +pat xor defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".xor"} + +pat xor !defined($1) +with dereg STACK +gen Call {label,".xor"} + +pat com $1==2 +with hlorde +uses areg +gen mov a,%1.2 + cma. + mov %1.2,a + mov a,%1.1 + cma. + mov %1.1,a yields %1 + +pat com defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".com"} + +pat com !defined($1) +with dereg STACK +gen Call {label,".com"} + +pat rol $1==2 +with dereg hlreg STACK +uses areg +gen mov a,e + ani {const1,15} + jz {label,"3f"} + 1: + dad hl + jnc {label,"2f"} + inr l + 2: + dcr a + jnz {label,"1b"} + 3: yields hl + +pat rol $1==4 +with dereg STACK +gen Call {label,".rol4"} + +pat ror $1==2 +with dereg hlreg STACK +uses areg +gen mov a,e + ani {const1,15} + jz {label,"2f"} + mov e,a + mov a,l + 1: + rar. + mov a,h + rar. + mov h,a + mov a,l + rar. + mov l,a + dcr e + jnz {label,"1b"} + 2: yields hl + +pat ror $1==4 +with dereg STACK +gen Call {label,".ror4"} + +/***********************************************/ +/* Group 10: Set instructions */ +/***********************************************/ + +pat inn $1==2 +with STACK +gen Call {label,".inn2"} yields de + +pat inn defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".inn"} yields de + +pat inn !defined($1) +with dereg STACK +gen Call {label,".inn"} yields de + +pat set $1==2 +with dereg STACK +gen Call {label,".set2"} yields de + +pat set defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".set"} + +pat set !defined($1) +with dereg STACK +gen Call {label,".set"} + +/***********************************************/ +/* Group 11: Array instructions */ +/***********************************************/ + +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)==0 leaving adi 2 +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)!=0 leaving adi 2 adp 0-rom($1,1) + +pat lae aar $2==2 && rom($1,3)==2 && rom($1,1)==0 +with hlreg +gen dad hl yields hl leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==2 && rom($1,1)!=0 +with hlreg +uses dereg={const2,0-rom($1,1)} +gen dad de + dad hl yields hl leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==4 && rom($1,1)==0 +with hlreg +gen dad hl + dad hl yields hl leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==4 && rom($1,1)!=0 +with hlreg +uses dereg={const2,0-rom($1,1)} +gen dad de + dad hl + dad hl yields hl leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==8 && rom($1,1)==0 +with hlreg +gen dad hl + dad hl + dad hl yields hl leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==8 && rom($1,1)!=0 +with hlreg +uses dereg={const2,0-rom($1,1)} +gen dad de + dad hl + dad hl + dad hl yields hl leaving adi 2 + +pat lar $1==2 +with STACK +gen Call {label,".lar2"} + +pat lar defined($1) +gen Call {label,"eunimpl"} + +pat lar !defined($1) +with hlorde STACK +uses areg +gen mov a,%1.2 + cpi {const1,2} + cnz {label,"eunimpl"} + mov a,%1.1 + ora a + cnz {label,"eunimpl"} + Call {label,".lar2"} + +pat sar $1==2 +with STACK +gen Call {label,".sar2"} + +pat sar defined($1) +gen Call {label,"eunimpl"} + +pat sar !defined($1) +with hlorde STACK +uses areg +gen mov a,%1.2 + cpi {const1,2} + cnz {label,"eunimpl"} + mov a,%1.1 + ora a + cnz {label,"eunimpl"} + Call {label,".sar2"} + +pat aar $1==2 +with STACK +gen Call {label,".aar2"} + +pat aar defined($1) +gen Call {label,"eunimpl"} + +pat aar !defined($1) +with hlorde STACK +uses areg +gen mov a,%1.2 + cpi {const1,2} + cnz {label,"eunimpl"} + mov a,%1.1 + ora a + cnz {label,"eunimpl"} + Call {label,".aar2"} + +/***********************************************/ +/* Group 12: Compare instructions */ +/***********************************************/ + +pat cmi $1==2 leaving sbi 2 + +pat cmi $1==4 +with STACK +uses areg={const1,1} +gen Call {label,".cmi4"} yields de + +pat cmu $1==2 +with hlorde hlorde +uses areg +gen mov a,%2.1 + cmp %1.1 + jz {label,"2f"} + jc {label,"1f"} + 0: + lxi %2,{const2,1} + jmp {label,"3f"} + 1: + lxi %2,{const2,0-1} + jmp {label,"3f"} + 2: + mov a,%2.2 + cmp %1.2 + jc {label,"1b"} + jnz {label,"0b"} + lxi %2,{const2,0} + 3: yields %2 + +pat cmu $1==4 +with STACK +uses areg={const1,0} +gen Call {label,".cmi4"} yields de + +pat cms $1==2 leaving cmi 2 + +pat cms defined($1) +with STACK +uses dereg={const2,$1} +gen Call {label,".cms"} yields de + +pat cms !defined($1) +with dereg STACK +gen Call {label,".cms"} yields de + +pat cmp leaving cmu 2 + +pat tlt +with hlorde +uses areg +gen mov a,%1.1 + ral. + mvi a,{const1,0} + mov %1.1,a + adc a + mov %1.2,a yields %1 + +pat tle +with hlorde +uses hlorde={const2,1}, areg +gen xra a + add %1.1 + jm {label,"2f"} + jnz {label,"1f"} + xra a + add %1.2 + jz {label,"2f"} + 1: + dcx %a + 2: yields %a + +pat teq +with hlorde +uses areg +gen mov a,%1.1 + ora %1.2 + move {const2,0},%1 + jnz {label,"1f"} + inx %1 + 1: yields %1 + +pat tne +with hlorde +uses areg +gen mov a,%1.1 + ora %1.2 + move {const2,0},%1 + jz {label,"1f"} + inx %1 + 1: yields %1 + +pat tge +with hlorde +uses areg +gen mov a,%1.1 + ral. + cmc. + mvi a,{const1,0} + mov %1.1,a + adc a + mov %1.2,a yields %1 + +pat tgt +with hlorde +uses hlorde={const2,0}, areg +gen xra a + add %1.1 + jm {label,"2f"} + jnz {label,"1f"} + xra a + add %1.2 + jz {label,"2f"} + 1: + inx %a + 2: yields %a + +pat loc cmi teq and $1>=0 && $1<=255 && $2==2 && $4==2 +with exact areg hlorde +gen cpi {const1,$1} + jz {label,"1f"} + move {const2,0},%2 + 1: yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jz {label,"2f"} + 1: + move {const2,0},%2 + 2: yields %2 + +pat loc cmi tne and $1>=0 && $1<=255 && $2==2 && $4==2 +with exact areg hlorde +gen cpi {const1,$1} + jnz {label,"1f"} + move {const2,0},%2 + 1: yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jnz {label,"1f"} + move {const2,0},%2 + 1: yields %2 + +pat loc cmi teq ior $1>=0 && $1<=255 && $2==2 && $4==2 +with exact areg hlorde +gen cpi {const1,$1} + jnz {label,"1f"} + move {const2,1},%2 + 1: yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jnz {label,"1f"} + move {const2,1},%2 + 1: yields %2 + +pat loc cmi tne ior $1>=0 && $1<=255 && $2==2 && $4==2 +with exact areg hlorde +gen cpi {const1,$1} + jz {label,"1f"} + move {const2,1},%2 + 1: yields %2 +with hlorde hlorde +uses areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jz {label,"2f"} + 1: + move {const2,1},%2 + 2: yields %2 + +pat loc cmi teq $1>=0 && $1<=255 && $2==2 +with exact areg +uses hlorde={const2,0} +gen cpi {const1,$1} + jnz {label,"1f"} + inx %a + 1: yields %a +with hlorde +uses hlorde={const2,0}, areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jnz {label,"1f"} + inx %a + 1: yields %a + + +pat loc cmi tne $1>=0 && $1<=255 && $2==2 +with exact areg +uses hlorde={const2,0} +gen cpi {const1,$1} + jz {label,"1f"} + inx %a + 1: yields %a +with hlorde +uses hlorde={const2,1}, areg +gen mov a,%1.2 + cpi {const1,$1} + jnz {label,"1f"} + mov a,%1.1 + ora a + jnz {label,"1f"} + dcx %a + 1: yields %a + +pat loc cmi $1>=0 && $1<=255 && $2==2 +with exact areg +uses hlorde +gen sui {const1,$1} + mov %a.2,a + rar. + mov %a.1,a yields %a +with yields {const2,$1} + leaving cmi 2 + +pat loc cmi $1<0 && $2==2 +with exact areg yields {const2,0-1} +with yields {const2,$1} + leaving cmi 2 + +/*******************************************/ +/* Group 13: Branch instructions */ +/*******************************************/ + +pat bra +with STACK +gen jmp {label,$1} + +pat blt +with hlorde hlorde STACK +uses areg +gen mov a,%2.2 + sub %1.2 + mov a,%2.1 + sbb %1.1 + jm {label,$1} + +pat ble +with hlorde hlorde STACK +uses areg +gen mov a,%1.2 + sub %2.2 + mov a,%1.1 + sbb %2.1 + jp {label,$1} + +pat beq +with hlorde hlorde STACK +uses areg +gen mov a,%2.2 + cmp %1.2 + jnz {label,"1f"} + mov a,%2.1 + cmp %1.1 + jz {label,$1} + 1: + +pat bne +with hlorde hlorde STACK +uses areg +gen mov a,%2.2 + cmp %1.2 + jnz {label,$1} + mov a,%2.1 + cmp %1.1 + jnz {label,$1} + +pat bge +with hlorde hlorde STACK +uses areg +gen mov a,%2.2 + sub %1.2 + mov a,%2.1 + sbb %1.1 + jp {label,$1} + +pat bgt +with hlorde hlorde STACK +uses areg +gen mov a,%1.2 + sub %2.2 + mov a,%1.1 + sbb %2.1 + jm {label,$1} + +pat zlt +with STACK +gen pop psw + ral. + jc {label,$1} +with hlorde STACK +gen mov a,%1.1 + ora a + jm {label,$1} + +pat zle +with hlorde STACK +uses areg +gen xra a + add %1.1 + jm {label,$1} + jnz {label,"1f"} + xra a + add %1.2 + jz {label,$1} + 1: + +pat zeq +with hlorde STACK +uses areg +gen mov a,%1.1 + ora %1.2 + jz {label,$1} + +pat zne +with hlorde STACK +uses areg +gen mov a,%1.1 + ora %1.2 + jnz {label,$1} + +pat zge +with STACK +gen pop psw + ral. + jnc {label,$1} +with hlorde STACK +gen mov a,%1.1 + ora a + jp {label,$1} + +pat zgt +with hlorde STACK +uses areg +gen xra a + add %1.1 + jm {label,"1f"} + jnz {label,$1} + xra a + add %1.2 + jnz {label,$1} + 1: + +pat lol zeq +with STACK +uses hlreg={const2,$1}, areg +gen dad lb + mov a,m + inx hl + ora m + jz {label,$2} + +pat lol zne +with STACK +uses hlreg={const2,$1}, areg +gen dad lb + mov a,m + inx hl + ora m + jnz {label,$2} + +pat ior zeq $1==2 +with hlorde hlorde STACK +uses areg +gen mov a,%1.1 + ora %1.2 + ora %2.1 + ora %2.2 + jz {label,$2} + +pat ior zne $1==2 +with hlorde hlorde STACK +uses areg +gen mov a,%1.1 + ora %1.2 + ora %2.1 + ora %2.2 + jnz {label,$2} + +/*********************************************/ +/* Group 14: Procedure call instructions */ +/*********************************************/ + +pat cal +with STACK +gen Call {label,$1} + +pat cai +with hlreg STACK +uses dereg +gen lxi de,{label,"1f"} + push de + pchl. + 1: + +pat lfr $1==2 yields de + +pat lfr $1<=8 +with STACK +uses areg={const1,$1/2}, hlreg={label,".fra"+$1}, dereg +gen 1: + dcx hl + mov d,m + dcx hl + mov e,m + push de + dcr a + jnz {label,"1b"} + +pat lfr ret $1==$2 leaving ret 0 + +pat ret $1==0 +with STACK +uses hlreg +gen move lb,hl + sphl. + pop lb + ret. + +pat ret $1==2 +with dereg STACK +uses hlreg +gen move lb,hl + sphl. + pop lb + ret. + +pat ret $1<=8 +with STACK +uses areg={const1,$1/2}, hlreg={label,".fra"}, dereg +gen 1: + pop de + mov m,e + inx hl + mov m,d + inx hl + dcr a + jnz {label,"1b"} + move lb,hl + sphl. + pop lb + ret. + +/******************************************/ +/* Group 15: Miscellaneous */ +/******************************************/ + +pat asp $1<=0-6 +with STACK +uses hlreg={const2,$1} +gen dad sp + sphl. + +pat asp $1==0-4 +with STACK +gen dcx sp + dcx sp + dcx sp + dcx sp + +pat asp $1==0-2 +with STACK +gen dcx sp + dcx sp + +pat asp $1==0 /* do nothing */ + +pat asp $1==2 +with exact src1or2 +with STACK + gen inx sp + inx sp + +pat asp $1==4 +with exact src1or2 leaving asp 2 +with STACK + gen inx sp + inx sp + inx sp + inx sp + +pat asp $1>=6 +with exact src1or2 leaving asp $1-2 +with STACK + uses hlreg={const2,$1} + gen dad sp + sphl. + +pat ass $1==2 +with hlreg STACK +gen dad sp + sphl. + +pat blm +with STACK +uses dereg={const2,$1} +gen Call {label,".blm"} + +pat bls +with dereg STACK +gen Call {label,".blm"} + +pat csa +with STACK +gen jmp {label,".csa"} + +pat csb +with STACK +gen jmp {label,".csb"} + +pat dch leaving loi 2 + +pat dup $1==2 +with src1or2 yields %1 %1 + +pat dup $1==4 +with src1or2 src1or2 yields %2 %1 %2 %1 + +pat dup +with STACK +uses dereg={const2,$1} +gen Call {label,".dup"} + +pat dus $1==2 +with dereg STACK +gen Call {label,".dup"} + +pat exg $1==2 +with src1or2 src1or2 yields %1 %2 + +pat exg defined($1) +with STACK +uses dereg={const2,1} +gen Call {label,".exg"} + +pat fil +uses hlreg +gen lxi hl,{label,$1} + shld {label,"hol0"+4} + +pat gto +with STACK +gen lhld {label,$1+2} + sphl. + lhld {label,$1+4} + move hl,lb + lhld {label,$1} + pchl. + +pat lim +uses hlreg +gen lhld {label,".ignmask"} yields hl + +pat lin +uses hlreg={const2,$1} +gen shld {label,"hol0"} + +pat lni +uses hlreg +gen lhld {label,"hol0"} + inx hl + shld {label,"hol0"} + +pat lor $1==0 yields lb + +pat lor $1==1 +with STACK +uses hlreg={const2,0} +gen dad sp yields hl + +pat lor $1==2 +uses hlreg +gen lhld {label,".reghp"} yields hl + +pat lpb leaving adp SL + +pat mon +with STACK +gen Call {label,".mon"} + +pat nop +with STACK +gen Call {label,".nop"} + +pat rck +with hlorde STACK + +pat rtt leaving ret 0 + +pat sig +with dereg +uses hlreg + gen lhld {label,".trapproc"} + xchg. + shld {label,".trapproc"} yields de +with STACK +uses hlreg + gen lhld {label,".trapproc"} + xthl. + shld {label,".trapproc"} + +pat sim +with hlreg +gen shld {label,".ignmask"} + +pat str $1==0 +with localbase + +pat str $1==1 +with hlreg +gen sphl. + +pat str $1==2 +with hlreg +gen shld {label,".reghp"} + +pat trp +with STACK +gen Call {label,".trp"} + +pat lof gen Call {label,"eunimpl"} +pat ldf gen Call {label,"eunimpl"} +pat stf gen Call {label,"eunimpl"} +pat sdf gen Call {label,"eunimpl"} +pat adf gen Call {label,"eunimpl"} +pat sbf gen Call {label,"eunimpl"} +pat mlf gen Call {label,"eunimpl"} +pat dvf gen Call {label,"eunimpl"} +pat ngf gen Call {label,"eunimpl"} +pat fif gen Call {label,"eunimpl"} +pat fef gen Call {label,"eunimpl"} +pat zrf gen Call {label,"eunimpl"} +pat cfi gen Call {label,"eunimpl"} +pat cif gen Call {label,"eunimpl"} +pat cuf gen Call {label,"eunimpl"} +pat cff gen Call {label,"eunimpl"} +pat cfu gen Call {label,"eunimpl"} +pat cmf gen Call {label,"eunimpl"} diff --git a/mach/i86/Action b/mach/i86/Action new file mode 100644 index 00000000..9c24923d --- /dev/null +++ b/mach/i86/Action @@ -0,0 +1,24 @@ +name "Intel 8086 assembler" +dir as +end +name "Intel 8086 backend" +dir cg +end +name "Intel 8086 download program(s)" +dir dl +end +name "Intel 8086 C libraries" +dir libcc +end +name "Intel 8086 EM library" +dir libem +end +name "Intel 8086 Pascal library" +dir libpc +end +name "Intel 8086 Stand-alone io library" +dir saio +end +name "Intel 8086 Basic library" +dir libbc +end diff --git a/mach/i86/cg/mach.c b/mach/i86/cg/mach.c new file mode 100644 index 00000000..aca612b1 --- /dev/null +++ b/mach/i86/cg/mach.c @@ -0,0 +1,116 @@ +/* + * (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_m[]= "$Header$" ; +static char rcs_mh[]= ID_MH ; +#endif + +/* + * machine dependent back end routines for the Intel 8086 + */ + +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,"\t.word %d,%d\n", + (int)l&0xFFFF,(int)(l>>16)&0xFFFF); +} + +con_float() { + register i; + + i= argval ; + if (i!= 4 && i!= 8) + fatal("bad fcon size"); + while ( i ) { + fprintf(codefile," .word 0,0\n") ; + i -=4 ; + } +} + +/* + +string holstr(n) word n; { + + sprintf(str,hol_off,n,holno); + return(mystrcpy(str)); +} +*/ + +prolog(nlocals) full nlocals; { + + fprintf(codefile,"\tpush\tbp\n\tmov\tbp,sp\n"); + switch (nlocals) { + case 4: printf("\tpush\tax\n"); + case 2: printf("\tpush\tax\n"); + case 0: break; + default: + printf("\tsub\tsp,%d\n",nlocals); break; + } + +} + +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 */ +}; diff --git a/mach/i86/cg/mach.h b/mach/i86/cg/mach.h new file mode 100644 index 00000000..139393eb --- /dev/null +++ b/mach/i86/cg/mach.h @@ -0,0 +1,30 @@ +#ifndef NORCSID +#define ID_MH "$Header$" +#endif + +#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 loc_off "%d(bp)" +#define arg_off "4+%d(bp)" +#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 diff --git a/mach/i86/cg/table b/mach/i86/cg/table new file mode 100644 index 00000000..d2440d0e --- /dev/null +++ b/mach/i86/cg/table @@ -0,0 +1,2328 @@ +"$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 + * + */ + +#define SL 4 +#define SSL "4" + +/******************************************************** + * Back end tables for Intel 8086 * + * Author : Ed Keizer * + * * + * wordsize = 2 bytes, pointersize = 2 bytes. * + * * + * Register bp is used as LB, sp is used for SP. * + * Some global variables are used: * + * - .reghp : the heap pointer * + * - .ignmask : trap ignore mask * + * - .trppc : address of user defined trap handler * + * * + * Floating point arithmetic and constants are not * + * implemented. + * * + ********************************************************/ + +/* #define DEEPER 1 +/* When DEEPER is disabled, the table contains some + heuristics based on the assumption that look-ahead will + be minimal. + Example: Addition of constants to registers will no take + place via ax, but in an address register, in the rules for ads. + Thereby assuming that the resulting register will be used + to access memory. + When DEEPER is enabled these heuristics are disabled + thereby allowing the code-generator too see for itself + which code will be shorter. +*/ + +#define SPEED 1 +/* This definition produces a slightly different table, + producing slightly less efficient code with greater speed +*/ + +#ifdef SPEED + +#define NO nocoercions : + +#else + +#define NO + +#endif + +EM_WSIZE=2 +EM_PSIZE=2 +EM_BSIZE=SL + +SIZEFACTOR=5 + +REGISTERS: + +al = ("al", 2), REG1, ACC1. +ah = ("ah", 2), REG1. +bl = ("bl", 2), REG1. +bh = ("bh", 2), REG1. +cl = ("cl", 2), REG1, SHIFT_CREG. +ch = ("ch", 2), REG1. +dl = ("dl", 2), REG1. +dh = ("dh", 2), REG1. +ax = ("ax", 2, al, ah), REG, GENREG, ACC. +bx = ("bx", 2, bl, bh), REG, GENREG, BREG, BXREG, ADDREG. +cx = ("cx", 2, cl, ch), REG, GENREG, CXREG, SHIFT_CREG. +dx = ("dx", 2, dl, dh), REG, GENREG, DXREG. +si = ("si", 2), REG, IREG, SIREG, ADDREG. +di = ("di", 2), REG, IREG, DIREG, ADDREG. +bp = ("bp", 2), BREG. + +TOKENS: + +/******************************** + * Types on the EM-machine * + ********************************/ + +ANYCON = { INT val ; } 2 cost=(2, 1) "%[val]" +ADDR_EXTERN = { STRING off ; } 2 cost=(2, 1) "%[off]" +EXTERN1 = { STRING off ; } 2 cost=(2,12) "(%[off])" +EXTERN2 = { STRING off ; } 2 cost=(2,12) "(%[off])" +ADDR_LOCAL = { INT ind ; } 2 cost=(1, 9) "%[ind](bp)" +LOCAL2 = { INT ind, size ; } 2 cost=(1,15) "%[ind](bp)" +LOCAL1 = { INT ind, size ; } 2 cost=(1,15) "%[ind](bp)" + + +/******************************************************** + * Now mostly addressing modes of target machine * + ********************************************************/ + + +/***************************************** + * 'Half modes' consisting of summations * + * of constant and or register(s) * + *****************************************/ + +reg_off = { REGISTER reg; STRING off; } 2 cost=(1, 9) "%[off](%[reg])" +bpreg_off = { REGISTER reg; INT ind; } 2 cost=(1,11) "%[ind](bp)(%[reg])" + +/************************************************** + * Indirect through registers and the modes above * + * Token names ending on digits are indirect * + **************************************************/ + + +ind_reg2 = { REGISTER reg; } 2 cost=(0,11) "(%[reg])" +ind_regoff2 = { REGISTER reg; STRING off; } 2 cost=(1,15) "%[off](%[reg])" +ind_bpregoff2 = { REGISTER reg; INT ind; } 2 cost=(1,18) + "%[ind](bp)(%[reg])" + +ind_reg1 = { REGISTER reg; } 2 cost=(0,11) "(%[reg])" +ind_regoff1 = { REGISTER reg; STRING off; } 2 cost=(1,15) "%[off](%[reg])" +ind_bpregoff1 = { REGISTER reg; INT ind; } 2 cost=(1,18) + "%[ind](bp)(%[reg])" + +TOKENEXPRESSIONS: + +/* SCRATCH REGISTERS */ +X_ACC = ACC*SCRATCH +X_ACC1 = ACC1*SCRATCH +X_REG = REG*SCRATCH +X_BXREG = BXREG*SCRATCH +X_DXREG = DXREG*SCRATCH +X_CXREG = CXREG*SCRATCH +X_SIREG = SIREG*SCRATCH +X_DIREG = DIREG*SCRATCH +X_ADDREG = ADDREG*SCRATCH + +/* Mode refering to a word in memory */ +memory2 = EXTERN2 + ind_reg2 + ind_regoff2 + ind_bpregoff2 + LOCAL2 + +/* Mode refering to a byte in memory */ +memory1 = EXTERN1 + ind_reg1 + ind_regoff1 + ind_bpregoff1 + LOCAL1 + +/* Modes allowed in instructions */ +const = ANYCON + ADDR_EXTERN +anyreg = REG + BREG +rm = anyreg + memory2 +rmorconst = const + rm +regorconst = const + anyreg +dest = REG + memory2 + +rm1 = REG1 + memory1 +rmorconst1 = const + rm1 +regorconst12 = REG1 + GENREG + const +dest1 = REG1 + memory1 + +/* Modes used to indicate tokens to be removed from the fakestack */ +reg_indexed = ind_reg2 + ind_regoff2 + ind_reg1 + ind_regoff1 +lb_indexed = ind_bpregoff2 + ind_bpregoff1 +indexed = reg_indexed + lb_indexed +externals = EXTERN2 + EXTERN1 +locals = LOCAL2 + LOCAL1 +all_locals = locals + lb_indexed +indirects = externals + reg_indexed +referals = indirects + locals + +/* Miscellaneous */ +halfindir = reg_off + bpreg_off + ADDR_LOCAL +some_off = halfindir + ADDR_EXTERN + ADDREG +a_word = rmorconst + rm1 + halfindir +no_reg_off = rmorconst + rm1 + ADDR_LOCAL + +CODE: + +/******************************************************** + * Group 1 : load instructions. * + * * + * For most load instructions no code is generated. * + * Action : put something on the fake-stack. * + ********************************************************/ + +loc | | | {ANYCON, $1} | | +ldc | | | {ANYCON, highw(1)} {ANYCON, loww(1)} | | +lol | | | {LOCAL2, $1, 2} | | +loe | | | {EXTERN2, $1} | | +lil | | allocate(ADDREG={ind_regoff2, bp, tostring($1)}) + | {ind_reg2, %[a]} | | +lof | nocoercions : reg_off | + | {ind_regoff2, %[1.reg], + %[1.off]+"+"+tostring($1)} | | +... | ADDREG | | {ind_regoff2,%[1],tostring($1)} | | +... | nocoercions : bpreg_off | + | {ind_bpregoff2,%[1.reg], %[1.ind]+$1} | | +... | nocoercions : ADDR_EXTERN| + | {EXTERN2,%[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_LOCAL | + | {LOCAL2, %[1.ind] + $1,2} | | +lal | | | {ADDR_LOCAL, $1} | | +lae | | | {ADDR_EXTERN, $1} | | +lpb | | | | adp SL | +lxl $1==0 | | | {ADDR_LOCAL, 0} | | +lxl $1==1 | | | {LOCAL2 ,SL, 2} | | +lxl $1==2 | | allocate(ADDREG={ind_regoff2, bp, SSL}) + | {ind_regoff2,%[a], SSL} | | +lxl $1>2 | | allocate(ADDREG={ind_regoff2, bp, SSL}, + CXREG={ANYCON,$1-1}) + "1:\tmov %[a],4(%[a])" + "loop 1b" + samecc erase(%[a]) erase(%[b]) + | %[a] | | +lxa $1==0 | | | {ADDR_LOCAL, SL} | | +lxa $1==1 | | allocate(ADDREG={ind_regoff2, bp, SSL }) + | {reg_off, %[a], SSL } | | +lxa $1==2 | | allocate(ADDREG={ind_regoff2, bp, SSL }) + move({ind_regoff2, %[a], SSL }, %[a]) + | {reg_off, %[a], SSL } | | +lxa $1 > 2 | | allocate(ADDREG={ind_regoff2,bp,SSL}, + CXREG={ANYCON,$1-1}) + "1:\tmov %[a],4(%[a])" + "loop 1b" + samecc erase(%[a]) erase(%[b]) + | {reg_off, %[a], SSL } | | +dch | | | | loi 2 | +loi $1==2 | ADDREG | | {ind_reg2, %[1]} | | +... | nocoercions : reg_off | + | {ind_regoff2, %[1.reg], %[1.off]} | | +... | nocoercions : bpreg_off | + | {ind_bpregoff2, %[1.reg], %[1.ind]} | | +... | nocoercions : ADDR_EXTERN| + | {EXTERN2, %[1.off]} | | +... | nocoercions : ADDR_LOCAL | + | {LOCAL2, %[1.ind],2} | | +loi $1==1 | ADDREG | | {ind_reg1, %[1]} | | +... | nocoercions : reg_off | + | {ind_regoff1, %[1.reg], %[1.off]} | | +... | nocoercions : bpreg_off | + | {ind_bpregoff1, %[1.reg], %[1.ind]} | | +... | nocoercions : ADDR_EXTERN | + | {EXTERN1, %[1.off]} | | +... | nocoercions : ADDR_LOCAL | + | {LOCAL1, %[1.ind],1} | | +loi $1==4 | ADDREG | | {ind_regoff2,%[1],"2"} {ind_reg2,%[1]}| | +... | nocoercions : reg_off | + | {ind_regoff2,%[1.reg], %[1.off]+"+2"} + {ind_regoff2,%[1.reg], %[1.off]} | | +... | nocoercions : bpreg_off | + | {ind_bpregoff2, %[1.reg], %[1.ind]+2} + {ind_bpregoff2, %[1.reg], %[1.ind]} | | +... | nocoercions : ADDR_LOCAL | | + {LOCAL2,%[1.ind]+2,2} {LOCAL2,%[1.ind],2} | | +... | nocoercions : ADDR_EXTERN| | {EXTERN2, %[1.off]+"+2"} + {EXTERN2, %[1.off]} | | +loi $1>4 | X_SIREG | + remove(ALL) + allocate(CXREG={ANYCON,$1}) + "sub sp,cx" + "sar cx,1" + "mov di,sp" + "rep movs" + erase(%[a]) erase(%[1]) | | | (8,8+$1*9) +... | X_SIREG | + remove(ALL) + allocate(CXREG={ANYCON,$1}) + "call .loi" + erase(%[a]) erase(%[1]) | | | (3,32+$1*9) +los $1==2 | X_CXREG X_SIREG | + remove(ALL) + "call .loi" + erase(%[1]) erase(%[2]) | | | +los !defined($1)| rm X_CXREG X_SIREG | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "call .loi" + erase(%[2]) erase(%[3]) | | | +ldl | | | {LOCAL2, $1+2,2} {LOCAL2, $1,2} | | +lde | | | {EXTERN2, $1+"+2"} {EXTERN2, $1} | | +ldf | nocoercions : reg_off | + | {ind_regoff2, %[1.reg], + %[1.off]+"+2+"+tostring($1)} + {ind_regoff2, %[1.reg], + %[1.off]+"+"+tostring($1)} | | +... | ADDREG | + | {ind_regoff2, %[1], tostring($1+2)} + {ind_regoff2, %[1], tostring($1)} | | +... | nocoercions : bpreg_off | + | {ind_bpregoff2,%[1.reg], %[1.ind]+2+$1} + {ind_bpregoff2,%[1.reg], %[1.ind]+$1} | | +... | nocoercions : ADDR_EXTERN | + | {EXTERN2,%[1.off]+"+2+"+tostring($1)} + {EXTERN2,%[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_LOCAL | + | {LOCAL2, %[1.ind] + $1 + 2, 2} + {LOCAL2, %[1.ind] + $1, 2} | | +lpi | | | {ADDR_EXTERN, $1} | | +/* This code sequence is generated by the C-compiler to tackle + char parameters, on the 8086 it reduces to nil */ +lol lal sti $1==$2 && $3<=2 | | | | | + +/**************************************************************** + * 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. * + ****************************************************************/ + +stl | regorconst | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + move(%[1],{ind_regoff2,bp,tostring($1)})| | | +... | nocoercions : STACK | + "pop $1(bp)" samecc | | |(2,26) +ste | regorconst | + remove(indirects) + move(%[1], {EXTERN2, $1 }) | | | +... | nocoercions : STACK | "pop ($1)" samecc | | | +sil | regorconst | + allocate(ADDREG={ind_regoff2, bp, tostring($1)}) + remove(referals) + move(%[1], {ind_reg2, %[a]}) | | | +stf | ADDREG regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1],tostring($1)})| | | +... | nocoercions : ADDREG STACK | + remove(referals) + "pop $1(%[1])" samecc | | | +... | reg_off regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1.reg], + %[1.off]+"+"+tostring($1)}) | | | +... | nocoercions : halfindir STACK | + remove(referals) + "pop $1+%[1]" samecc | | | +... | ADDR_LOCAL | | | stl %[1.ind]+$1 | +... | bpreg_off regorconst | + remove(all_locals) + remove(indexed) + move(%[2],{ind_bpregoff2,%[1.reg], + %[1.ind]+$1}) | | | +/* +... | ADDR_EXTERN regorconst | + remove(indirects) + move(%[2],{EXTERN2,%[1.off]+"+"+tostring($1)})| | | +*/ +sti $1==2 | ADDREG regorconst | + remove(referals) + move(%[2],{ind_reg2,%[1]}) | | | +... | nocoercions : ADDREG STACK | + remove(referals) + "pop (%[1])" samecc | | | +... | reg_off regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1.reg],%[1.off]}) | | | +... | nocoercions : reg_off STACK | + remove(referals) + "pop %[1]" samecc | | | +... | ADDR_LOCAL | | | stl %[1.ind] | +... | bpreg_off regorconst | + remove(all_locals) + remove(indexed) + move(%[2],{ind_bpregoff2,%[1.reg], %[1.ind]}) | | | +... | nocoercions : bpreg_off STACK | + remove(all_locals) + remove(indexed) + "pop %[1]" samecc | | | +... | ADDR_EXTERN regorconst | + remove(indirects) + move(%[2],{EXTERN2,%[1.off]}) | | | +... | nocoercions : ADDR_EXTERN STACK | + remove(indirects) + "pop (%[1])" samecc | | | +sti $1==1 | ADDREG regorconst12 | + remove(referals) + move(%[2],{ind_reg1,%[1]}) | | | +... | reg_off regorconst12 | + remove(referals) + move(%[2],{ind_regoff1,%[1.reg],%[1.off]}) | | | +... | bpreg_off regorconst12 | + remove(all_locals) + remove(indexed) + move(%[2],{ind_bpregoff1,%[1.reg], %[1.ind]}) | | | +... | ADDR_EXTERN regorconst12 | + remove(indirects) + move(%[2],{EXTERN1,%[1.off]}) | | | +... | ADDR_LOCAL regorconst12 | + remove(indexed) + remove(locals, + %[ind]<=%[1.ind] && %[ind]+%[size]>%[1.ind] ) + move(%[2],{ind_regoff1, bp, tostring(%[1.ind])}) + | | | +sti $1==4 | ADDREG regorconst regorconst | + remove(referals) + move(%[2],{ind_reg2,%[1]}) + move(%[3],{ind_regoff2,%[1],"2"}) | | | +... | reg_off regorconst regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1.reg],%[1.off]}) + move(%[3],{ind_regoff2,%[1.reg],%[1.off]+"+2"})| | | +... | bpreg_off regorconst regorconst | + remove(all_locals) + remove(indexed) + move(%[2],{ind_bpregoff2,%[1.reg], %[1.ind]}) + move(%[3],{ind_bpregoff2,%[1.reg], %[1.ind]+2})| | | +... | ADDR_EXTERN regorconst regorconst | + remove(indirects) + move(%[2],{EXTERN2,%[1.off]}) + move(%[3],{EXTERN2,%[1.off]+"+2"}) | | | +... | ADDR_LOCAL regorconst regorconst | + remove(indexed) + remove(locals, %[ind]>=%[1.ind] && %[ind]<%[1.ind]+4 ) + move(%[2],{ind_regoff2, bp, tostring(%[1.ind])}) + move(%[3],{ind_regoff2, bp, + tostring(%[1.ind]+2)})| | | +sti $1>4 | X_DIREG | + remove(ALL) + allocate(CXREG={ANYCON,$1/2}) + "mov si,sp" + "rep movs" + "mov sp,si" + erase(%[1]) erase(%[a]) | | | (5,4+$1*8) +/* This sort of construction gives problems in the codegenerator + because of the potential verly large lookahead +... | X_ADDREG | + remove(ALL) + "pop (%[1])" + "add %[1],2" + erase(%[1]) | %[1] | sti $1-2 | (5,30) +*/ +sts $1==2 | X_CXREG X_DIREG | + remove(ALL) + "call .sti" + erase(%[1]) erase(%[2]) | | | +sdl | | | | stl $1 stl $1+2 | +sde | | | | ste $1 ste $1+"+2" | +sdf | ADDREG regorconst regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1],tostring($1)}) + move(%[3],{ind_regoff2,%[1],tostring($1+2)})| | | +... | nocoercions : ADDREG STACK | + remove(referals) + "pop $1(%[1])" + "pop %($1+2%)(%[1])" samecc | | | +... | reg_off regorconst regorconst | + remove(referals) + move(%[2],{ind_regoff2,%[1.reg], + %[1.off]+"+"+tostring($1)}) + move(%[3],{ind_regoff2,%[1.reg], + %[1.off]+"+"+tostring($1+2)}) | | | +... | nocoercions : halfindir STACK | + remove(referals) + "pop $1+%[1]" + "pop %($1+2%)+%[1]" samecc | | | + /* Funny things happen when the sign changes in the stl parameters */ +... | ADDR_LOCAL | | | stl %[1.ind]+$1 stl %[1.ind]+$1+2 | +... | bpreg_off regorconst regorconst | + remove(all_locals) + remove(indexed) + move(%[2],{ind_bpregoff2,%[1.reg], + %[1.ind]+$1}) + move(%[3],{ind_bpregoff2,%[1.reg], + %[1.ind]+$1+2}) | | | +... | halfindir regorconst | + remove(referals) + "mov %[1],%[2]" + samecc | %[1] | stf $1+2 | (0,12)+%[1]+%[2]+%[1] + +/**************************************************************** + * Group 3 : Integer arithmetic. * + * * + * Implemented (sometimes with the use of subroutines) : * + * all 2 and 4 byte arithmetic. * + ****************************************************************/ + +adi $1==2 | NO X_REG rmorconst | + "add %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | rmorconst X_REG | + "add %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "add %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "add %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +adi $1==4 | NO X_REG X_REG rmorconst rmorconst | + "add %[1],%[3]" + "adc %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(4,6)+%[4]+%[3] +... | X_ACC X_REG const rmorconst | + "add %[1],%[3]" + "adc %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(5,7)+%[4] +... | rmorconst rmorconst X_REG X_REG | + "add %[3],%[1]" + "adc %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(4,6)+%[1]+%[2] +... | const rmorconst X_ACC X_REG | + "add %[3],%[1]" + "adc %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(5,7)+%[2] +adi !defined($1)| X_CXREG X_ACC | + remove(ALL) + "call .adi" + erase(%[1]) erase(%[2]) | ax | | +sbi $1==2 | rmorconst X_REG | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | const X_ACC | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +... | NO X_REG rmorconst | + "sub %[1],%[2]" + "neg %[1]" + erase(%[1]) setcc(%[1]) | %[1] | | (4,6) + %[2] +... | NO X_ACC const | + "sub %[1],%[2]" + "neg %[1]" + erase(%[1]) setcc(%[1]) | %[1] | | (5,7) +sbi $1==4 | rmorconst rmorconst X_REG X_REG | + "sub %[3],%[1]" + "sbb %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(4,6)+%[1]+%[2] +... | const rmorconst-ACC X_ACC X_REG | + "sub %[3],%[1]" + "sbb %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(5,7)+%[2] +sbi !defined($1)| X_CXREG X_ACC | + remove(ALL) + "call .sbi" + erase(%[1]) erase(%[2]) | ax | | +mli $1==2 | X_ACC rm | + allocate(%[2],DXREG) + "mul %[2]" + /* mul and imul have same low order result + but mul is faster + */ + nocc erase(%[1]) | %[1] | |(2,118)+%[2] +... | rm-ACC X_ACC | + allocate(%[1],DXREG) + "mul %[1]" + nocc erase(%[2]) | %[2] | |(2,118)+%[1] +mli $1==4 | SIREG DIREG BXREG X_ACC | + remove(ALL) + "call .mli4" + erase(ax) setcc(dx) | dx ax | | +/* Not now, +mli !defined($1)| X_ACC | + remove(ALL) + "call .mli" | | | +*/ +dvi $1==2 | rm-ACC X_ACC | + allocate(DXREG) + "cwd" + "idiv %[1]" + erase(%[2]) | ax | |(3,176)+%[1] +dvi $1==4 | | remove(ALL) + "call .dvi4" | cx ax | | +/* +dvi !defined($1)| X_ACC | + remove(ALL) + "call .dvi" erase(%[1]) | | | +*/ +#ifdef LONGEMPAT +loc loc cii dvi loc loc cii $1==2 && $2==4 && $4==4 && $5==4 && $6==2 + | rm-ACC-DXREG X_ACC X_DXREG | + "idiv %[1]" + erase(%[2]) erase(%[3]) | ax | |(2,171)+%[1] +#endif +rmi $1==2 | rm-ACC X_ACC | + allocate(DXREG) + "cwd" + "idiv %[1]" + erase(%[2]) | dx | |(3,176)+%[1] +rmi $1==4 | | remove(ALL) + "call .rmi4" | bx dx | | +/* +rmi !defined($1)| X_ACC | + remove(ALL) + "call .rmi" erase(%[1]) | | | +*/ +#ifdef LONGEMPAT +loc loc cii rmi loc loc cii $1==2 && $2==4 && $4==4 && $5==4 && $6==2 + | rm-ACC-DXREG X_ACC X_DXREG | + "idiv %[1]" + erase(%[2]) erase(%[3]) | dx | |(2,171)+%[1] +#endif +ngi $1==2 | X_REG | + "neg %[1]" + setcc(%[1]) erase(%[1]) | %[1] | |(2,3) +ngi $1==4 | X_REG X_REG | + "neg %[2]" + "neg %[1]" + "sbb %[2],0" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | | (8,10) +... | X_REG-ACC X_ACC | + "neg %[2]" + "neg %[1]" + "sbb %[2],0" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | | (7,10) +/* +ngi !defined($1)| X_ACC | + remove(ALL) + "call .ngi" | | | +*/ +loc sli $1==1 && $2==2 | X_REG | + "sal %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | | (2,2) +sli $1==2 | SHIFT_CREG X_REG | + "sal %[2],cl" + setcc(%[2]) erase(%[2]) | %[2] | | (2,8) +sli $1==4 | X_CXREG X_REG X_REG | + "jcxz 1f" + "2: sal %[2],1" + "rcl %[3],1" + "loop 2b\n1:" + erase(%[1]) erase(%[2]) erase(%[3]) + | %[3] %[2] | | +/* +sli !defined($1)| X_ACC | + remove(ALL) + "call .sli" | | | +*/ +loc sri $1==1 && $2==2 | X_REG | + "sar %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | | (2,2) +sri $1==2 | SHIFT_CREG X_REG | + "sar %[2],cl" + setcc(%[2]) erase(%[2]) | %[2] | | (2,8) +sri $1==4 | X_CXREG X_REG X_REG | + "jcxz 1f" + "2: sar %[3],1" + "rcr %[2],1" + "loop 2b\n1:" + erase(%[1]) erase(%[2]) erase(%[3]) + | %[3] %[2] | | +/* +sri !defined($1)| X_ACC | + remove(ALL) + "call .sri" | | | +*/ + + +/************************************************ + * Group 4 : unsigned arithmetic * + * * + * adu = adi * + * sbu = sbi * + * slu = sli * + * mlu = mli * + * * + * Supported : 2- and 4 byte arithmetic. * + ************************************************/ + +adu | | | | adi $1 | +sbu | | | | sbi $1 | +mlu | | | | mli $1 | +dvu $1==2 | rm-ACC X_ACC | + allocate(%[1],DXREG={ANYCON,0}) + "div %[1]" + erase(%[2]) erase(%[a]) | %[2] | |(2,149)+%[1] +dvu $1==4 | | remove(ALL) + "call .dvu4" | cx ax | | +/* +dvu !defined($1)| X_ACC | + remove(ALL) + "call .dvu" erase(%[1]) | | | +*/ +rmu $1==2 | rm-ACC X_ACC | + allocate(%[1],DXREG={ANYCON,0}) + "div %[1]" + erase(%[2]) erase(%[a]) | dx | |(3,149)+%[1] +rmu $1==4 | | remove(ALL) + "call .rmu4" | bx dx | | +/* +rmu !defined($1)| X_ACC | + remove(ALL) + "call .rmu" erase(%[1]) | | | +*/ +slu | | | | sli $1 | +loc sru $1==1 && $2==2 | X_REG | + "shr %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | | (2,2) +sru $1==2 | SHIFT_CREG X_REG | + "shr %[2],cl" + setcc(%[2]) erase(%[2]) | %[2] | | (2,8) +sru $1==4 | X_CXREG X_REG X_REG | + "jcxz 1f" /* result => samecc */ + "2: shr %[3],1" + "rcr %[2],1" + "loop 2b\n1:" + erase(%[1]) erase(%[2]) erase(%[3]) + | %[3] %[2] | | +/* +sru !defined($1)| X_ACC | + remove(ALL) + "call .sru" | | | +*/ + +/************************************************ + * Group 5 : Floating point arithmetic * + * * + ************************************************/ + +adf $1==4 | | + remove(ALL) + "call .adf4" | | | +adf $1==8 | | + remove(ALL) + "call .adf8" | | | +adf !defined($1) | X_CXREG | + remove(ALL) + "call .adf" erase(%[1]) | | | +sbf $1==4 | | + remove(ALL) + "call .sbf4" | | | +sbf $1==8 | | + remove(ALL) + "call .sbf8" | | | +sbf !defined($1) | X_CXREG | + remove(ALL) + "call .sbf" erase(%[1]) | | | +mlf $1==4 | | + remove(ALL) + "call .mlf4" | | | +mlf $1==8 | | + remove(ALL) + "call .mlf8" | | | +mlf !defined($1) | X_CXREG | + remove(ALL) + "call .mlf" erase(%[1]) | | | +dvf $1==4 | | + remove(ALL) + "call .dvf4" | | | +dvf $1==8 | | + remove(ALL) + "call .dvf8" | | | +dvf !defined($1) | X_CXREG | + remove(ALL) + "call .dvf" erase(%[1]) | | | +ngf $1==4 | | + remove(ALL) + "call .ngf4" | | | +ngf $1==8 | | + remove(ALL) + "call .ngf8" | | | +ngf !defined($1) | X_CXREG | + remove(ALL) + "call .ngf" erase(%[1]) | | | +fif $1==4 | | + remove(ALL) + "call .fif4" | | | +fif $1==8 | | + remove(ALL) + "call .fif8" | | | +fif !defined($1) | X_CXREG | + remove(ALL) + "call .fif" erase(%[1]) | | | +fef $1==4 | | + remove(ALL) + "call .fef4" | | | +fef $1==8 | | + remove(ALL) + "call .fef8" | | | +fef !defined($1) | X_CXREG | + remove(ALL) + "call .fef" erase(%[1]) | | | + + + +/**************************************** + * Group 6 : pointer arithmetic. * + * * + * Pointers have size 2 bytes. * + ****************************************/ + +adp $1==1 | nocoercions : reg_off | | + {reg_off, %[1.reg],%[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_EXTERN | | + {ADDR_EXTERN, %[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_LOCAL | | + {ADDR_LOCAL, %[1.ind]+$1 } | | +... | nocoercions : bpreg_off | | + {bpreg_off, %[1.reg], %[1.ind]+$1} | | +... | X_REG | + "inc %[1]" + erase(%[1]) setcc(%[1]) | %[1] | | (1,2) +adp $1 == 0-1 | nocoercions : reg_off | | + {reg_off, %[1.reg],%[1.off]+tostring($1)} | | +... | nocoercions : ADDR_EXTERN | | + {ADDR_EXTERN, %[1.off]+tostring($1)} | | +... | nocoercions : ADDR_LOCAL| |{ADDR_LOCAL, %[1.ind]+$1 } | | +... | nocoercions : bpreg_off | | + {bpreg_off, %[1.reg], %[1.ind]+$1} | | +... | X_REG | + "dec %[1]" + erase(%[1]) setcc(%[1]) | %[1] | | (1,2) +adp | nocoercions : reg_off | | + {reg_off, %[1.reg],%[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_EXTERN | | + {ADDR_EXTERN, %[1.off]+"+"+tostring($1)} | | +... | nocoercions : ADDR_LOCAL | | + {ADDR_LOCAL, %[1.ind]+$1 } | | +... | nocoercions : bpreg_off | | + {bpreg_off, %[1.reg], %[1.ind]+$1} | | +... | X_ADDREG | | {reg_off, %[1], tostring($1)} | | +... | nocoercions : X_ACC + X_CXREG + X_DXREG | + "add %[1],$1" + erase(%[1]) setcc(%[1]) | %[1] | | (4,4) +ads $1==2 | nocoercions : ANYCON reg_off | | + {reg_off, %[2.reg], + %[2.off]+"+"+tostring(%[1.val])} | | +... | nocoercions : ADDR_EXTERN reg_off | | + {reg_off, %[2.reg], %[2.off]+"+"+%[1.off]} | | +... | rm reg_off | + "add %[2.reg],%[1]" + erase(%[2.reg]) setcc(%[2.reg]) | + {reg_off, %[2.reg], %[2.off]} | | (2,3) + %[1] +... | nocoercions : ANYCON bpreg_off | | + {bpreg_off, %[2.reg], %[2.ind]+%[1.val]} | | +... | rm bpreg_off | + "add %[2.reg],%[1]" + erase(%[2.reg]) setcc(%[2.reg]) | + {bpreg_off, %[2.reg], %[2.ind]} | | (2,3) + %[1] +... | reg_off rmorconst | + "add %[1.reg],%[2]" + erase(%[1.reg]) setcc(%[1.reg]) | + {reg_off, %[1.reg], %[1.off]} | | (2,3) + %[2] +... | bpreg_off rmorconst | + "add %[1.reg],%[2]" + erase(%[1.reg]) setcc(%[1.reg]) | + {bpreg_off, %[1.reg], %[1.ind]} | | (2,3) + %[2] +... | nocoercions : reg_off ANYCON | | + {reg_off, %[1.reg], + %[1.off]+"+"+tostring(%[2.val])} | | +... | nocoercions : reg_off ADDR_EXTERN | | + {reg_off, %[1.reg], %[1.off]+"+"+%[2.off]} | | +... | nocoercions : reg_off reg_off | + "add %[1.reg],%[2.reg]" + erase(%[1.reg]) setcc(%[1.reg]) | + {reg_off,%[1.reg],%[1.off]+"+"+%[2.off]} | | (2,3) +... | IREG ADDR_LOCAL | | {bpreg_off,%[1],%[2.ind]} | | +/* +... | (REG-IREG) ADDR_LOCAL | + allocate(%[1],ADDREG=%[1]) + "add %[a],bp" + | {reg_off, %[a], tostring(%[2.ind])} | | (2,3) +*/ +#ifdef DEEPER +... | X_REG rmorconst | + "add %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | rmorconst X_REG | + "add %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "add %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "add %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +#else +... | X_ADDREG ADDR_EXTERN | | {reg_off, %[1], %[2.off]} | | +... | X_ADDREG rm | + "add %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | ADDR_EXTERN X_ADDREG | | {reg_off, %[2], %[1.off]} | | +... | rm X_ADDREG | + "add %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +#endif +sbs $1==2 | nocoercions : ANYCON reg_off | | + {reg_off, %[2.reg], %[2.off]+"-"+tostring(%[1.val])} | | +... | nocoercions : ANYCON ADDR_LOCAL | | + {ADDR_LOCAL, %[2.ind]-%[1.val]} | | +... | rm reg_off | + "sub %[2.reg],%[1]" + erase(%[2.reg]) setcc(%[2.reg]) | + {reg_off, %[2.reg], %[2.off]} | | +/* Should not occur +... | nocoercions : reg_off ANYCON | | + {reg_off, %[1.reg], %[1.off]+"-"+tostring(%[2.val])} | | +... | ANYCON ADDR_EXTERN | | + {ADDR_EXTERN, %[2.off]+"+"+tostring(%[1.val])} | | +... | nocoercions : ANYCON ADDR_LOCAL | | + {ADDR_LOCAL, %[1.val]+%[2.ind]} | | +*/ +... | rm X_REG | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | const X_ACC | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) + +/**************************************** + * Group 7 : increment/decrement/zero * + ****************************************/ + +inc | X_REG | + "inc %[1]" + setcc(%[1]) erase(%[1]) | %[1] | |(1,2) +inl | | remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "inc $1(bp)" + setcc({LOCAL2,$1,2}) | | |(3,24) +ine | | remove(indirects) + "inc ($1)" + setcc({EXTERN2,$1}) | | |(4,21) +dec | X_REG | + "dec %[1]" + setcc(%[1]) erase(%[1]) | %[1] | |(1,2) +del | | remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "dec $1(bp)" + setcc({LOCAL2,$1,2}) | | |(3,24) +dee | | remove(indirects) + "dec ($1)" + setcc({EXTERN2,$1}) | | |(4,21) +zrl | | remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + move({ANYCON,0},{LOCAL2,$1,2}) + | | | +zre | | remove(indirects) + move({ANYCON,0},{EXTERN2,$1})| | | +zrf $1==4 | | + remove(ALL) + "call .zrf4" | | | +zrf $1==8 | | + remove(ALL) + "call .zrf8" | | | +zrf !defined($1) | X_CXREG | + remove(ALL) + "call .zrf" erase(%[1]) | | | +zer $1==2 | | | {ANYCON,0} | | +zer $1==4 | | | {ANYCON,0} {ANYCON,0} | | +zer $1==6 | | | {ANYCON,0} {ANYCON,0} + {ANYCON,0} | | +zer $1==8 | | | {ANYCON,0} {ANYCON,0} + {ANYCON,0} {ANYCON,0} | | +zer defined($1) | | remove(ALL) + move({ANYCON,$1/2},cx) + move({ANYCON,0},bx) + "1: push bx" + "loop 1b" + samecc erase(cx) | | |(3,10+$1*4) +zer !defined($1)| X_CXREG | + remove(ALL) + move({ANYCON,0},bx) + "sar cx,1" + "1:\tpush bx" + "loop 1b" + samecc erase(%[1]) | | | + +lol adi stl $1==$3 && $2==2 | regorconst | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "add $1(bp),%[1]" + setcc({LOCAL2, $1, 2}) | | | +lol ngi stl $1==$3 && $2==2 | | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "neg $1(bp)" + setcc({LOCAL2, $1, 2}) | | | +lol ads stl $1==$3 && $2==2 | regorconst | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "add $1(bp),%[1]" + setcc({LOCAL2, $1, 2}) | | | +lol adp stl $1==$3 | | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "add $1(bp),$2" + setcc({LOCAL2, $1, 2}) | | | +lol adp stl $1==$3 && $2==1 | | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "inc $1(bp)" + setcc({LOCAL2, $1, 2}) | | | +lol adp stl $1==$3 && $2==0-1 | | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "dec $1(bp)" + setcc({LOCAL2, $1, 2}) | | | +lol and stl $1==$3 && $2==2 | regorconst | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "and $1(bp),%[1]" + setcc({LOCAL2, $1, 2}) | | | +lol ior stl $1==$3 && $2==2 | regorconst | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "or $1(bp),%[1]" + setcc({LOCAL2, $1, 2}) | | | +lol com stl $1==$3 && $2==2 | | + remove(indexed) + remove(locals, %[ind]>=$1 && %[ind]<$1+2 ) + "not $1(bp)" + samecc | | | +lil adi sil $1==$3 && $2==2 | regorconst | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "add (%[a]),%[1]" + setcc({ind_reg2, %[a]}) | | | +lil ngi sil $1==$3 && $2==2 | | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "neg (%[a])" + setcc({ind_reg2, %[a]}) | | | +lil ads sil $1==$3 && $2==2 | regorconst | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "add (%[a]),%[1]" + setcc({ind_reg2, %[a]}) | | | +lil adp sil $1==$3 | | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "add (%[a]),$2" + setcc({ind_reg2, %[a]}) | | | +lil adp sil $1==$3 && $2==1 | | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "inc (%[a])" + setcc({ind_reg2, %[a]}) | | | +lil adp sil $1==$3 && $2==0-1 | | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "dec (%[a])" + setcc({ind_reg2, %[a]}) | | | +lil and sil $1==$3 && $2==2 | regorconst | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "and (%[a]),%[1]" + setcc({ind_reg2, %[a]}) | | | +lil ior sil $1==$3 && $2==2 | regorconst | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "or (%[a]),%[1]" + setcc({ind_reg2, %[a]}) | | | +lil com sil $1==$3 && $2==2 | | + allocate(ADDREG={LOCAL2, $1, 2}) + remove(referals) + "not (%[a])" + samecc | | | +loe adi ste $1==$3 && $2==2 | regorconst | + remove(indirects) + "add ($1),%[1]" + setcc({EXTERN2, $1}) | | | +loe ngi ste $1==$3 && $2==2 | | + remove(indirects) + "neg ($1)" + setcc({EXTERN2, $1}) | | | +loe ads ste $1==$3 && $2==2 | regorconst | + remove(indirects) + "add ($1),%[1]" + setcc({EXTERN2, $1}) | | | +loe adp ste $1==$3 | | + remove(indirects) + "add ($1),$2" + setcc({EXTERN2, $1}) | | | +loe adp ste $1==$3 && $2==1 | | + remove(indirects) + "inc ($1)" + setcc({EXTERN2, $1}) | | | +loe adp ste $1==$3 && $2==0-1 | | + remove(indirects) + "dec ($1)" + setcc({EXTERN2, $1}) | | | +loe and ste $1==$3 && $2==2 | regorconst | + remove(indirects) + "and ($1),%[1]" + setcc({EXTERN2, $1}) | | | +loe ior ste $1==$3 && $2==2 | regorconst | + remove(indirects) + "or ($1),%[1]" + setcc({EXTERN2, $1}) | | | +loe com ste $1==$3 && $2==2 | | + remove(indirects) + "not ($1)" + samecc | | | + +/**************************************** + * Group 8 : Convert instructions * + ****************************************/ + +cii | CXREG DXREG X_ACC | + remove(ALL) + "call .cii" + erase(%[3]) | %[3] | | +ciu | | | | cuu | +cui | | | | cuu | +cuu | CXREG BXREG X_ACC | + remove(ALL) + "call .cuu" + erase(%[3]) | %[3] | | +cif | CXREG DXREG | + remove(ALL) + "call .cif" | | | +cuf | CXREG DXREG | + remove(ALL) + "call .cuf" | | | +cfi | CXREG DXREG | + remove(ALL) + "call .cfi" | | | +cfu | CXREG DXREG | + remove(ALL) + "call .cfu" | | | +cff | CXREG DXREG | + remove(ALL) + "call .cff" | | | +loc loc cii $1==1 && $2==2 | ACC1 | + allocate(%[1],ACC) + "cbw" + samecc | %[a] | |(1,2) +loc loc cii $1==1 && $2==4 | ACC1 | + allocate(%[1],ACC,DXREG) + "cbw" + "cwd" + samecc | dx ax | |(2,7) +loc loc cii $1==2 && $2==4 | ACC | + allocate(DXREG) + "cwd" + samecc | dx ax | |(1,5) +loc loc cii $1==4 && $2==2 | a_word a_word | | %[1] | | +loc loc cuu $1==2 && $2==4 | a_word | + allocate(REG={ANYCON,0})| %[a] %[1] | | +loc loc cuu $1==4 && $2==2 | a_word a_word | | %[1] | | +loc loc ciu $1==2 && $2==4 | a_word | + allocate(REG={ANYCON,0})| %[a] %[1] | | +loc loc ciu $1==4 && $2==2 | a_word a_word | | %[1] | | +loc loc cui $1==2 && $2==4 | a_word | + allocate(REG={ANYCON,0})| %[a] %[1] | | +loc loc cui $1==4 && $2==2 | a_word a_word | | %[1] | | + +/**************************************** + * Group 9 : Logical instructions * + ****************************************/ + +and $1==2 | NO X_REG rmorconst | + "and %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | rmorconst X_REG | + "and %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "and %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "and %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +and $1==4 | NO X_REG X_REG rmorconst rmorconst | + "and %[1],%[3]" + "and %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(4,6)+%[4]+%[3] +... | X_ACC X_REG const rmorconst | + "and %[1],%[3]" + "and %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(5,7)+%[4] +... | rmorconst rmorconst X_REG X_REG | + "and %[3],%[1]" + "and %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(4,6)+%[1]+%[2] +... | const rmorconst-ACC X_ACC X_REG | + "and %[3],%[1]" + "and %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(5,7)+%[2] +and defined($1) | | remove(ALL) + "mov cx,$1" + "call .and" | | | +and !defined($1)| X_CXREG | + remove(ALL) + "call .and" + erase(%[1]) | | | +ior $1==2 | X_REG rmorconst | + "or %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | NO rmorconst X_REG | + "or %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "or %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "or %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +ior $1==4 | NO X_REG X_REG rmorconst rmorconst | + "or %[1],%[3]" + "or %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(4,6)+%[4]+%[3] +... | X_ACC X_REG const rmorconst | + "or %[1],%[3]" + "or %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(5,7)+%[4] +... | rmorconst rmorconst X_REG X_REG | + "or %[3],%[1]" + "or %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(4,6)+%[1]+%[2] +... | const rmorconst-ACC X_ACC X_REG | + "or %[3],%[1]" + "or %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(5,7)+%[2] +ior defined($1) | | remove(ALL) + "mov cx,$1" + "call .ior" | | | +ior !defined($1)| X_CXREG | + remove(ALL) + "call .ior" + erase(%[1]) | | | +xor $1==2 | NO X_REG rmorconst | + "xor %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | rmorconst X_REG | + "xor %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "xor %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "xor %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +xor $1==4 | NO X_REG X_REG rmorconst rmorconst | + "xor %[1],%[3]" + "xor %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(4,6)+%[4]+%[3] +... | X_ACC X_REG const rmorconst | + "xor %[1],%[3]" + "xor %[2],%[4]" + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] %[1] | |(5,7)+%[4] +... | rmorconst rmorconst X_REG X_REG | + "xor %[3],%[1]" + "xor %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(4,6)+%[1]+%[2] +... | const rmorconst-ACC X_ACC X_REG | + "xor %[3],%[1]" + "xor %[4],%[2]" + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] %[3] | |(5,7)+%[2] +xor defined($1) | | remove(ALL) + "mov cx,$1" + "call .xor" | | | +xor !defined($1)| X_CXREG | + remove(ALL) + "call .xor" + erase(%[1]) | | | +com $1==2 | X_REG | + "not %[1]" + samecc erase(%[1]) | %[1] | |(2,3) +com $1==4 | X_REG X_REG | + "not %[2]" + "not %[1]" + samecc erase(%[1]) erase(%[2]) + | %[2] %[1] | |(4,6) +com defined($1) | | remove(ALL) + "mov cx,$1" + "call .com" | | | +com !defined($1)| X_CXREG | + remove(ALL) + "call .com" + erase(%[1]) | | | +loc rol $1==1 && $2==2 | X_REG | + "rol %[1],1" + samecc erase(%[1]) | %[1] | | (2,2) +rol $1==2 | SHIFT_CREG X_REG | + "rol %[2],cl" + samecc erase(%[2]) | %[2] | | (2,8) +rol $1==4 | X_CXREG X_REG X_REG | + "jcxz 1f" + "2: sal %[2],1" + "rcl %[3],1" + "adc %[2],0" + "loop 2b\n1:" + erase(%[1]) erase(%[2]) erase(%[3]) + | %[3] %[2] | | +/* +rol !defined($1)| X_CXREG | + remove(ALL) + "call .rol" | | | +*/ +loc ror $1==1 && $2==2 | X_REG | + "ror %[1],1" + samecc erase(%[1]) | %[1] | | (2,2) +ror $1==2 | SHIFT_CREG X_REG | + "ror %[2],cl" + samecc erase(%[2]) | %[2] | | (2,8) +ror $1==4 | X_CXREG X_REG X_REG | + "jcxz 1f" + "neg cx" + "add cx,32" + "2: sal %[2],1" + "rcl %[3],1" + "adc %[2],0" + "loop 2b\n1:" + erase(%[1]) erase(%[2]) erase(%[3]) + | %[3] %[2] | | +/* +ror !defined($1)| X_CXREG | + remove(ALL) + "call .ror" | | | +*/ + +/******************************** + * Group 10 : Set instructions * + ********************************/ + +inn $1==2 | SHIFT_CREG X_REG | + "shr %[2],cl" + "and %[2],1" + setcc(%[2]) erase(%[2]) | %[2] | |(6,13) +... | SHIFT_CREG X_ACC | + "shr %[2],cl" + "and %[2],1" + setcc(%[2]) erase(%[2]) | %[2] | |(5,13) +loc inn $1==1 && $2==2 | X_REG | + "shr %[1],1" + "and %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | |(6,6) +... | X_ACC | + "shr %[1],1" + "and %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | |(5,6) +loc inn $1==0 && $2==2 | X_REG | + "and %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | |(6,6) +... | X_ACC | + "and %[1],1" + setcc(%[1]) erase(%[1]) | %[1] | |(5,6) +inn defined($1) | X_ACC | + remove(ALL) + move({ANYCON,$1},cx) + "call .inn" + erase(ax) | ax | | +inn !defined($1)| CXREG X_ACC | + remove(ALL) + "call .inn" + erase(%[2]) | ax | | +loc inn zeq $2==2 | rm | + remove(ALL) + "test %[1],%(1<<$1%)" + "je $3" | | | +loc inn zne $2==2 | rm | + remove(ALL) + "test %[1],%(1<<$1%)" + "jne $3" | | | +set $1==2 | SHIFT_CREG | + allocate(REG={ANYCON,1}) + "shl %[a],cl" + setcc(%[a]) erase(%[a]) | %[a] | | +set defined($1) | X_ACC | + remove(ALL) + move({ANYCON,$1},cx) + "call .set" + erase(%[1]) | | | +set !defined($1)| CXREG X_ACC | + remove(ALL) + "call .set" + erase(%[2]) | | | + +/**************************************** + * Group 11 : Array instructions * + ****************************************/ + +lae aar $2==2 && rom(1,3)==1 && rom(1,1)==0 | | | | ads 2 | +lae aar $2==2 && rom(1,3)==1 && rom(1,1)!=0 | | | | adp 0-rom(1,1) ads 2 | +lae aar $2==2 && rom(1,3)==2 && rom(1,1)==0 | X_ADDREG | + "sal %[1],1" + erase(%[1]) | %[1] | ads 2 | +lae aar $2==2 && rom(1,3)==2 && rom(1,1)!=0 | X_ADDREG | + "sal %[1],1" + erase(%[1]) | %[1] | adp 0-2*rom(1,1) ads 2 | +lae aar $2==2 && rom(1,3)==4 && rom(1,1)==0 | X_ADDREG | + "sal %[1],1" + "sal %[1],1" + erase(%[1]) | %[1] | ads 2 | +lae aar $2==2 && rom(1,3)==4 && rom(1,1)!=0 | X_ADDREG | + "sal %[1],1" + "sal %[1],1" + erase(%[1]) | %[1] | adp 0-4*rom(1,1) ads 2 | +lae aar $2==2 && rom(1,1)==0 | X_ACC | + allocate(DXREG,REG={ANYCON,rom(1,3)}) + "mul %[b]" + erase(%[1]) | %[1] | ads 2 | +lae aar $2==2 && defined(rom(1,1)) | X_ACC | + allocate(DXREG,REG={ANYCON,rom(1,3)}) + "mul %[b]" + erase(%[1]) | %[1] | adp 0-rom(1,1)*rom(1,3) ads 2 | +aar $1==2 | halfindir X_ACC X_ADDREG | + allocate(DXREG) + "sub %[2],%[1]" + "mul 4+%[1]" + "add %[3],%[2]" + erase(%[2]) erase(%[3]) + | %[3] | | +... | ADDR_EXTERN X_ACC X_ADDREG | + allocate(DXREG) + "sub %[2],(%[1])" + "mul (4+%[1])" + "add %[3],%[2]" + erase(%[2]) erase(%[3]) + | %[3] | | +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) | +aar !defined($1) | | remove(ALL) + "call .iaar" | di | | +sar $1==2 | X_SIREG X_ACC X_DIREG | + remove(ALL) + "call .sar2" + erase(%[1]) erase(%[2]) erase(%[3]) + | | | +sar !defined($1) | | remove(ALL) + "call .isar" | | | +lar $1==2 | X_DIREG X_ACC X_SIREG | + remove(ALL) + "call .lar2" + erase(%[1]) erase(%[2]) erase(%[3]) + | | | +lar !defined($1) | | remove(ALL) + "call .ilar" | | | + +/**************************************** + * group 12 : Compare instructions * + ****************************************/ + +cmi $1==2 | | | | sbi 2 | +cmi $1==4 | rmorconst rmorconst X_REG X_REG | + "sub %[3],%[1]" + "sbb %[4],%[2]" + "jne 1f" + "and %[3],%[3]" + "je 1f" + "inc %[4]\n1: " + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] | | +cmu $1==2 | | | | cmp | +cmu $1==4 | | remove(ALL) + "call .cmu4" | ax | | +cms $1==2 | NO X_REG rmorconst | + "sub %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (2,3) + %[2] +... | rmorconst X_REG | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (2,3) + %[1] +... | X_ACC const | + "sub %[1],%[2]" + erase(%[1]) setcc(%[1]) | %[1] | | (3,4) +... | const X_ACC | + "sub %[2],%[1]" + erase(%[2]) setcc(%[2]) | %[2] | | (3,4) +cms $1==4 | rmorconst rmorconst X_REG X_REG | + "sub %[3],%[1]" + "sbb %[4],%[2]" + "jne 1f" + "or %[4],%[3]\n1: " + setcc(%[4]) erase(%[3]) erase(%[4]) + | %[4] | | +... | NO X_REG X_REG rmorconst rmorconst | + "sub %[1],%[3]" + "sbb %[2],%[4]" + "jne 1f" + "or %[2],%[1]\n1: " + setcc(%[2]) erase(%[1]) erase(%[2]) + | %[2] | | +cms defined($1) | | remove(ALL) + move({ANYCON,$1},cx) + "call .cms" + erase(cx) | cx | | +cms !defined($1)| X_CXREG | + remove(ALL) + "call .cms" + erase(cx) | cx | | +cmf $1==4 | | + remove(ALL) + "call .cmf4" | | | +cmf $1==8 | | + remove(ALL) + "call .cmf8" | | | +cmf !defined($1) | X_CXREG | + remove(ALL) + "call .cmf" erase(%[1]) | | | + +/* The costs with cmp are the cost of the 8086 cmp instruction */ +cmp | NO REG rmorconst | + allocate(REG = {ANYCON,0}) + "cmp %[1],%[2]" + "je 2f" + "jb 1f" + "inc %[a]" + "jmp 2f" + "1:\tdec %[a]\n2:" + setcc(%[a]) + erase(%[a]) | %[a] | |(4,4) +... | rmorconst REG | + allocate(REG = {ANYCON,0}) + "cmp %[1],%[2]" + "je 2f" + "jb 1f" + "inc %[a]" + "jmp 2f" + "1:\tdec %[a]\n2:" + setcc(%[a]) + erase(%[a]) | %[a] | |(4,4) +... | ACC const | + allocate(REG = {ANYCON,0}) + "cmp %[1],%[2]" + "je 2f" + "jb 1f" + "inc %[a]" + "jmp 2f" + "1:\tdec %[a]\n2:" + setcc(%[a]) + erase(%[a]) | %[a] | |(3,4) +... | const ACC | + allocate(REG = {ANYCON,0}) + "cmp %[1],%[2]" + "je 2f" + "jb 1f" + "inc %[a]" + "jmp 2f" + "1:\tdec %[a]\n2:" + setcc(%[a]) + erase(%[a]) | %[a] | |(3,4) +tlt | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "jge 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +tle | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "jg 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +teq | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +tne | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +tge | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "jl 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +tgt | rm | + allocate(REG={ANYCON,0}) + test(%[1]) + "jle 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +tlt ior $2==2 | rm X_REG | + test(%[1]) + "jge 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +tle ior $2==2 | rm X_REG | + test(%[1]) + "jg 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +teq ior $2==2 | rm X_REG | + test(%[1]) + "jne 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +tne ior $2==2 | rm X_REG | + test(%[1]) + "je 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +tge ior $2==2 | rm X_REG | + test(%[1]) + "jl 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +tgt ior $2==2 | rm X_REG | + test(%[1]) + "jle 1f" + "or %[2],1\n1:" + erase(%[2]) | %[2] | | +cmi tlt ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "jge 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +cmi tle ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "jg 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +cmi teq ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "jne 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +cmi tne ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "je 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +cmi tge ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "jl 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +cmi tgt ior $1==2 && $3==2 | regorconst rm X_REG | + "cmp %[2],%[1]" + "jle 1f" + "or %[3],1\n1:" + erase(%[3]) | %[3] | | +/* The cmp instruction has a special form for comparing + a byte ( sign-extended ) to a word (e.g. a register) + The "cmp ax,0" and "cmp bx,0" instructions have widely different + encodings but take the same amount of time and space. + Conclusion, using the special instruction for comparing + constants with ax is only better when the constant is <-128 or >127. + This relatively rare event wasn't worth extra entries in this table. +*/ +cmi tlt $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jge 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jle 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmi tle $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jg 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jl 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmi teq $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmi tne $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmi tge $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jl 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jg 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmi tgt $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jle 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jge 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp tlt | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jae 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jbe 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp tle | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "ja 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jb 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp teq | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp tne | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp tge | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jb 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "ja 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp tgt | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jbe 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jae 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cms teq $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "jne 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cms tne $1==2 | regorconst rm | + allocate(REG={ANYCON,0}) + "cmp %[2],%[1]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +... | NO rm regorconst | + allocate(REG={ANYCON,0}) + "cmp %[1],%[2]" + "je 1f" + "inc %[a]\n1:" + erase(%[a]) | %[a] | | +cmp zlt | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jb $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "ja $2" | | | +cmp zle | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jbe $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jae $2" | | | +cmp zeq | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "je $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "je $2" | | | +cmp zne | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jne $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jne $2" | | | +cmp zge | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jae $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jbe $2" | | | +cmp zgt | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "ja $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jb $2" | | | +cms zeq $1==2 | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "je $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "je $2" | | | +cms zne $1==2 | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jne $2" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jne $2" | | | +and zeq $1==2 | regorconst rm | + remove(ALL) + "test %[2],%[1]" + "je $2" | | | +... | NO rm regorconst | + remove(ALL) + "test %[1],%[2]" + "je $2" | | | +and zne $1==2 | regorconst rm | + remove(ALL) + "test %[2],%[1]" + "jne $2" | | | +... | NO rm regorconst | + remove(ALL) + "test %[1],%[2]" + "jne $2" | | | +loc and zeq $1<256 && $1>=0 && $2==2 | nocoercions : rm1 + memory2 | + remove(ALL) + "testb %[1],$1" + "je $3" | | | (1,3) + %[1] +... | GENREG | + remove(ALL) + "testb %[1.1],$1" + "je $3" | | | (1,3) + %[1] +... | nocoercions : IREG | + remove(ALL) + "test %[1],$1" + "je $3" | | | (2,3) + %[1] +loc and zne $1<256 && $1>=0 && $2==2 | nocoercions : rm1 + memory2 | + remove(ALL) + "testb %[1],$1" + "jne $3" | | | (1,3) + %[1] +... | GENREG | + remove(ALL) + "testb %[1.1],$1" + "jne $3" | | | (1,3) + %[1] +... | nocoercions : IREG | + remove(ALL) + "test %[1],$1" + "jne $3" | | | (2,3) + %[1] +loc beq $1<256 && $1>=0 | nocoercions : rm1 | + remove(ALL) + "cmpb %[1],$1" + "je $2" | | | (1,3) + %[1] +... | rm | + remove(ALL) + "cmp %[1],$1" + "je $2" | | | (2,3) + %[1] +loc bne $1<256 && $1>=0 | nocoercions : rm1 | + remove(ALL) + "cmpb %[1],$1" + "jne $2" | | | (1,3) + %[1] +... | rm | + remove(ALL) + "cmp %[1],$1" + "jne $2" | | | (2,3) + %[1] +/* Note: test for <,<=,>,>= can be done in this way, + with use of the unsigned conditional jumps, jb, etc. */ +loc cmu zeq $1<256 && $1>=0 && $2==2 | nocoercions : rm1 | + remove(ALL) + "cmpb %[1],$1" + "je $3" | | | (1,3) + %[1] +... | rm | + remove(ALL) + "cmp %[1],$1" + "je $3" | | | (2,3) + %[1] +loc cmu zne $1<256 && $1>=0 && $2==2 | nocoercions : rm1 | + remove(ALL) + "cmpb %[1],$1" + "jne $3" | | | (1,3) + %[1] +... | rm | + remove(ALL) + "cmp %[1],$1" + "jne $3" | | | (2,3) + %[1] + +/**************************************** + * Group 13 : Branch instructions * + ****************************************/ + +bra | | remove(ALL) + "jmp $1" + samecc | | | +blt | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jl $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jg $1" | | | +ble | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jle $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jge $1" | | | +beq | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "je $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "je $1" | | | +bne | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jne $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jne $1" | | | +bge | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jge $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jle $1" | | | +bgt | regorconst rm | + remove(ALL) + "cmp %[2],%[1]" + "jg $1" | | | +... | NO rm regorconst | + remove(ALL) + "cmp %[1],%[2]" + "jl $1" | | | +zlt | rm | + remove(ALL) + test(%[1]) + "jl $1" | | | +zle | rm | + remove(ALL) + test(%[1]) + "jle $1" | | | +zeq | rm+rm1 | + remove(ALL) + test(%[1]) + "je $1" | | | +zne | rm+rm1 | + remove(ALL) + test(%[1]) + "jne $1" | | | +zge | rm | + remove(ALL) + test(%[1]) + "jge $1" | | | +zgt | rm | + remove(ALL) + test(%[1]) + "jg $1" | | | + +/************************************************ + * group 14 : Procedure call instructions * + ************************************************/ + +cal | | remove(ALL) + "call $1" | | | +cai | rm | remove(ALL) + "call %[1]" | | | +lfr $1==2 | | | ax | | +lfr $1==4 | | | dx ax | | +lfr $1==6 | | | bx dx ax | | +lfr $1==8 | | | cx bx dx ax | | +ret $1==0 | | remove(ALL) + "mov sp,bp" + "pop bp" + "ret" | | | +ret $1==2 | ACC | + "mov sp,bp" + "pop bp" + "ret" | | | +ret $1==4 | ACC DXREG | + "mov sp,bp" + "pop bp" + "ret" | | | +ret $1==6 | ACC DXREG BXREG | + "mov sp,bp" + "pop bp" + "ret" | | | +ret $1==8 | ACC DXREG BXREG CXREG | + "mov sp,bp" + "pop bp" + "ret" | | | + +/************************************************ + * Group 15 : Miscellaneous instructions * + ************************************************/ + +asp $1==2 | nocoercions : a_word | | | | +... | STACK | + allocate(IREG) /* GENREG may contain lfr area */ + "pop %[a]" erase(%[a]) samecc | | | (1,8) +asp $1==4 | nocoercions : a_word a_word | | | | +... | STACK | + allocate(IREG) /* GENREG may contain lfr area */ + "pop %[a]" "pop %[a]" + erase(%[a]) samecc | | | (2,16) +asp $1==0-2 | | /* Anything will do */ | bp | | +... | | remove(ALL) + "push lb" | | | (1,10) +asp | | remove(ALL) + "add sp,$1" | | | (4,4) +ass $1==2 | rmorconst | + remove(ALL) + "add sp,%[1]" | | | +ass !defined($1)| rm rmorconst | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "add sp,%[2]" | | | +blm $1==0 | | | | asp 4 | +blm $1>0 | X_DIREG X_SIREG | + remove(ALL) + allocate(CXREG={ANYCON,$1/2}) + "rep movs" + erase(%[1]) erase(%[2]) erase(%[a]) + | | | +bls $1==2 | X_CXREG X_DIREG X_SIREG | + remove(ALL) + "sar cx,1" + "rep movs" + erase(%[1]) erase(%[2]) erase(%[3]) + | | | +bls !defined($1)| rm-CXREG-DIREG-SIREG X_CXREG X_DIREG X_SIREG | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "sar cx,1" + "rep movs" + erase(%[2]) erase(%[3]) erase(%[4]) + | | | +csa $1==2 | X_SIREG X_BXREG | + remove(ALL) + "jmp .csa2" + erase(%[1]) erase(%[2]) | | | +csa !defined($1)| rm-SIREG-BXREG X_SIREG X_BXREG | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "jmp .csa2" + erase(%[2]) erase(%[3]) | | | +csb $1==2 | X_SIREG X_DXREG | + remove(ALL) + "jmp .csb2" + erase(%[1]) erase(%[2]) | | | +csb !defined($1)| rm-SIREG-DIREG X_SIREG X_DXREG | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "jmp .csb2" + erase(%[2]) erase(%[3]) | | | +dup $1==2 | REG | | %[1] %[1] | | +dup $1==4 | REG REG | | %[2] %[1] %[2] %[1] | | +dup | | remove(ALL) + move({ANYCON, $1}, cx) + "call .dup" + erase(cx) | | | +dus $1==2 | X_CXREG | + remove(ALL) + "call .dup" + erase(%[1]) | | | +dus !defined($1)| rm-CXREG X_CXREG | + remove(ALL) + "cmp %[1],2" + "jne .unknown" + "call .dup" + erase(%[2]) | | | +exg $1==2 | a_word a_word | | %[1] %[2] | | +exg $1==4 | a_word a_word a_word a_word | + | %[2] %[1] %[4] %[3] | | +exg defined($1) | | remove(ALL) + move({ANYCON,$1},cx) + "call .exg" + erase(cx) | | | +exg | rmorconst | + remove(ALL) + move(%[1],cx) + "call .exg" + erase(cx) | | | +gto | | remove(ALL) + "mov bx,$1" + "jmp .gto" | | | +fil | | "mov (hol0+4),$1" | | | +lim | | allocate(REG) + "mov %[a],(.ignmask)" | %[a] | | +lin | | "mov (hol0),$1" | | | +lni | | "inc (hol0)" | | | +lor $1==0 | | | bp | | +lor $1==1 | | remove(ALL) + allocate(REG) + "mov %[a],sp" | %[a] | | +lor $1==2 | | allocate(REG) + "mov %[a],(.reghp)" | %[a] | | +mon | X_ACC | + remove(ALL) + "call .mon" | | | +nop | | remove(ALL) + "call .nop" | | | +rck $1==2 | SIREG ACC | + "call .rck" | ax | | +rck !defined($1)| rm-SIREG-ACC SIREG ACC | + "cmp %[1],2" + "jne .unknown" + "call .rck" | ax | | +rtt | | | | ret 0 | +sig | X_REG | + "xchg (.trppc),%[1]" + erase(%[1]) | %[1] | | +sim | regorconst | + "mov (.ignmask),%[1]" | | | +str $1==0 | rmorconst | + "mov bp,%[1]" | | | +str $1==1 | rmorconst | + remove(ALL) + "mov sp,%[1]" | | | +str $1==2 | | + remove(ALL) + "call .strhp" | | | +trp | X_ACC | + remove(ALL) + "call .trp" | | | + +/******************************** + * From source to register * + ********************************/ + +| rmorconst | allocate(%[1],REG=%[1]) | %[a] | | +| reg_off | "add %[1.reg],%[1.off]" + erase(%[1.reg]) setcc(%[1.reg]) + | %[1.reg] | |(2,3) + %[1] +#ifdef DEEPER +| halfindir | + allocate(%[1],REG) + move(%[1],%[a]) + samecc | %[a] | |(0,0) +#else +| halfindir | + allocate(%[1],ADDREG) + move(%[1],%[a]) + samecc | %[a] | |(0,0) +#endif + +/******************************** + * From source to token * + ********************************/ + +| ANYCON | | {ADDR_EXTERN,tostring(%[1.val])} | | + +/******************************** + * From source1 * + ********************************/ + +| rm1 | allocate(%[1],REG1=%[1]) | %[a] | | +| rm1 | allocate(%[1],GENREG) + move(%[1],%[a.1]) + "xorb %[a.2],%[a.2]" | %[a] | |(2,3) +| ACC1 | allocate(%[1],ACC) + "xorb %[a.2],%[a.2]" | %[a] | |(2,3) +/* +| BLREG | allocate(%[1],BXREG) + "xorb %[a.2],%[a.2]" | %[a] | |(2,3) +*/ + + + +/************************ + * From STACK coercions * + ************************/ + +| STACK | allocate(REG) + "pop %[a]" + samecc | %[a] | | (2,8) + +MOVES: +(ACC, EXTERN2, "mov %[2],%[1]" samecc, (3,16)) +(ACC1, EXTERN1, "movb %[2],%[1]" samecc, (3,16)) +(ACC, EXTERN1, "movb %[2],%[1.1]" samecc, (3,16)) +(EXTERN2, ACC, "mov %[2],%[1]" samecc, (3,14)) +(EXTERN1, ACC1, "movb %[2],%[1]" samecc, (3,14)) +(rm, REG, "mov %[2],%[1]" samecc, (2,2) + %[1] ) +(anyreg, dest, "mov %[2],%[1]" samecc, (2,3) + %[2] ) +(halfindir, REG, "lea %[2],%[1]" samecc, (2,3) + %[1] ) +(rm1, REG1, "movb %[2],%[1]" samecc, (2,2) + %[1] ) +(REG1, rm1, "movb %[2],%[1]" samecc, (2,3) + %[2] ) +(GENREG, rm1, "movb %[2],%[1.1]" samecc, (2,3) + %[2] ) +(ANYCON %[val]==0, REG, "xor %[2],%[2]" setcc(%[2]), (2,3)) +(ANYCON %[val]==0, REG1, "xorb %[2],%[2]" setcc(%[2]),(2,3)) +(const, REG, "mov %[2],%[1]" samecc, (3,4)) +(const, REG1, "movb %[2],%[1]" samecc, (2,4)) +(const, dest, "mov %[2],%[1]" samecc, (4,4) + %[2] ) +(const, rm1, "movb %[2],%[1]" samecc, (3,4) + %[2] ) + +TESTS: +(anyreg, "or %[1],%[1]", (2,3)) +(memory2, "cmp %[1],0", (3,11)+%[1]) +(REG1, "orb %[1],%[1]", (2,3)) +(memory1, "cmpb %[1],0", (3,11)+%[1]) + +STACKS: +(anyreg, , "push %[1]" + samecc , (1,10) ) +(memory2, , "push %[1]" + samecc , (2,10) + %[1] ) +(const, REG, move(%[1],%[a]) + "push %[a]" + samecc , (4,11) ) +(const, , ".data\n1: .word %[1]\n.text" + "push (1b)" + samecc , (6,24) ) +(rm1, GENREG, move({ANYCON,0},%[a]) + move(%[1],%[a.1]) + "push %[a]" + samecc , (2,10) + %[1] ) +(rm1, , "push %[1]" + "push si" + "mov si,sp" + "movb 3(si),0" + "pop si" + samecc , (10,60) + %[1] ) +(reg_off, , "add %[1.reg],%[1.off]" + "push %[1.reg]" + erase(%[1.reg]) + setcc(%[1.reg]) , ( 4,14) ) +(bpreg_off, , move(%[1],%[1.reg]) + "push %[1.reg]" + samecc , ( 6,17) + %[1] ) +(ADDR_LOCAL %[ind]==0, , + "push bp" + samecc , ( 1,10) ) +(halfindir, REG,move(%[1],%[a]) + "push %[a]" + samecc , ( 6,17) + %[1] ) +(halfindir, , "push ax" + "push si" + "lea ax,%[1]" + "mov si,sp" + "xchg 2(si),ax" + "pop si" + samecc , (10,59) + %[1] ) diff --git a/mach/i86/libbc/Makefile b/mach/i86/libbc/Makefile new file mode 100644 index 00000000..69179491 --- /dev/null +++ b/mach/i86/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=i86" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/i86/libbc/compmodule b/mach/i86/libbc/compmodule new file mode 100755 index 00000000..2bcf66ca --- /dev/null +++ b/mach/i86/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?ack} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/i86/libcc/Makefile b/mach/i86/libcc/Makefile new file mode 100644 index 00000000..8a3ebdf3 --- /dev/null +++ b/mach/i86/libcc/Makefile @@ -0,0 +1,38 @@ +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 diff --git a/mach/i86/libcc/compmodule b/mach/i86/libcc/compmodule new file mode 100755 index 00000000..2bcf66ca --- /dev/null +++ b/mach/i86/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?ack} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/i86/libem/LIST b/mach/i86/libem/LIST new file mode 100644 index 00000000..370909b6 --- /dev/null +++ b/mach/i86/libem/LIST @@ -0,0 +1,53 @@ +tail_em.a +adi.s +and.s +cii.s +cms.s +cmu4.s +com.s +csa2.s +csb2.s +cuu.s +dup.s +dvi.s +dvi4.s +dvu.s +dvu4.s +exg.s +fakfp.s +gto.s +iaar.s +ilar.s +inn.s +ior.s +isar.s +lar2.s +loi.s +mli.s +mli4.s +mon.s +ngi.s +nop.s +rck.s +rmi.s +rmi4.s +rmu.s +rmu4.s +rol.s +ror.s +sar2.s +sbi.s +set.s +sli.s +sri.s +sti.s +strhp.s +xor.s +error.s +unknown.s +fat.s +trp.s +stop.s +printf.s +print.s +tail.s diff --git a/mach/i86/libem/Makefile b/mach/i86/libem/Makefile new file mode 100644 index 00000000..351b5160 --- /dev/null +++ b/mach/i86/libem/Makefile @@ -0,0 +1,16 @@ +install: + ../../install head_em.s head_em + ../../install tail_em.a tail_em + +cmp: + -../../compare head_em.s head_em + -../../compare tail_em.a tail_em + +clean : + +opr : + make pr | opr + +pr: + @pr head_em.s + @arch pv tail_em.a | pr -h `pwd`/tail_em.a diff --git a/mach/i86/libem/adi.s b/mach/i86/libem/adi.s new file mode 100644 index 00000000..f1f06090 --- /dev/null +++ b/mach/i86/libem/adi.s @@ -0,0 +1,25 @@ +.define .adi + + ! $Header$ + ! #bytes in cx , top of stack in ax +.adi: + pop bx ! return address + cmp cx,2 + jne 1f + pop cx + add ax,cx + jmp bx +1: + cmp cx,4 + jne 9f + pop dx + pop cx + add ax,cx + pop cx + adc dx,cx + push dx + jmp bx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/and.s b/mach/i86/libem/and.s new file mode 100644 index 00000000..e77b09d5 --- /dev/null +++ b/mach/i86/libem/and.s @@ -0,0 +1,15 @@ +.define .and + + ! $Header$ + ! #bytes in cx +.and: + pop bx ! return address + mov di,sp + add di,cx + sar cx,1 +1: + pop ax + and ax,(di) + stos + loop 1b + jmp bx diff --git a/mach/i86/libem/cii.s b/mach/i86/libem/cii.s new file mode 100644 index 00000000..4304a0ee --- /dev/null +++ b/mach/i86/libem/cii.s @@ -0,0 +1,37 @@ +.define .cii + +.cii: + ! $Header$ + pop di ! return address + ! pop cx, dest. size + ! pop bx, src. size + ! ax is first word of source + cmp bx,cx + je 8f + cmp bx,2 + je 1f + cmp bx,4 + jne 7f + cmp cx,2 + jne 9f + pop dx +8: + jmp di +7: cmp bx,1 + jne 9f + cmp cx,2 + jne 9f + cbw + jmp 8b +1: + cmp cx,4 + jne 9f + cwd + push dx + jmp di +9: + push ax ! push low source + mov ax,EILLINS + push ax + jmp .fat + jmp bx diff --git a/mach/i86/libem/cms.s b/mach/i86/libem/cms.s new file mode 100644 index 00000000..cec20db0 --- /dev/null +++ b/mach/i86/libem/cms.s @@ -0,0 +1,18 @@ +.define .cms + + ! $Header$ + ! #bytes in cx +.cms: + pop bx ! return address + mov dx,sp + mov si,dx + add dx,cx + mov di,dx + add dx,cx + sar cx,1 + repe cmps + je 1f + inc cx +1: + mov sp,dx + jmp bx diff --git a/mach/i86/libem/cmu4.s b/mach/i86/libem/cmu4.s new file mode 100644 index 00000000..2e4bf946 --- /dev/null +++ b/mach/i86/libem/cmu4.s @@ -0,0 +1,25 @@ +.define .cmu4 + +.cmu4: + ! $Header$ + pop bx ! return address + xor ax,ax + pop cx + pop dx + pop si + pop di + cmp di,dx + ja 1f + jb 2f + cmp si,cx + ja 1f + je 3f +2: + dec ax +3: + jmp bx +1: + inc ax + jmp bx + + ret diff --git a/mach/i86/libem/com.s b/mach/i86/libem/com.s new file mode 100644 index 00000000..23aee51d --- /dev/null +++ b/mach/i86/libem/com.s @@ -0,0 +1,14 @@ +.define .com + + ! $Header$ + ! #bytes in cx +.com: + pop bx ! return address + mov di,sp + sar cx,1 +1: + not (di) + inc di + inc di + loop 1b + jmp bx diff --git a/mach/i86/libem/csa2.s b/mach/i86/libem/csa2.s new file mode 100644 index 00000000..60ef8ed1 --- /dev/null +++ b/mach/i86/libem/csa2.s @@ -0,0 +1,23 @@ +.define .csa2 + +.csa2: + ! $Header$ + ! si, descriptor address + ! bx, index + mov dx,(si) ! default + sub bx,2(si) + cmp bx,4(si) + ja 1f + sal bx,1 + mov bx,6(bx)(si) + test bx,bx + jnz 2f +1: + mov bx,dx + test bx,bx + jnz 2f + mov ax,ECASE + push ax + jmp .fat +2: + jmp bx diff --git a/mach/i86/libem/csb2.s b/mach/i86/libem/csb2.s new file mode 100644 index 00000000..f49fe8a5 --- /dev/null +++ b/mach/i86/libem/csb2.s @@ -0,0 +1,26 @@ +.define .csb2 + +.csb2: + ! $Header$ + !si, descriptor address + !dx, index + lods + xchg ax,bx ! default + lods + xchg ax,cx ! number of cases +1: + dec cx + jl 2f + lods + cmp ax,dx + lods + jne 1b + xchg ax,bx +2: + test bx,bx + jnz 3f + mov ax,ECASE + push ax + jmp .fat +3: + jmp bx diff --git a/mach/i86/libem/cuu.s b/mach/i86/libem/cuu.s new file mode 100644 index 00000000..7719f39d --- /dev/null +++ b/mach/i86/libem/cuu.s @@ -0,0 +1,35 @@ +.define .ciu +.define .cui +.define .cuu + +.ciu: +.cui: +.cuu: + ! $Header$ + pop di ! return address + ! pop cx, dest. size + ! pop bx, source size + ! ax is low word of source + cmp bx,cx + je 8f + cmp bx,2 + je 1f + cmp bx,4 + jne 9f + cmp cx,2 + jne 9f + pop dx +8: + jmp di +1: + cmp cx,4 + jne 9f + xor dx,dx + push dx + jmp di +9: + push ax ! to help debugging ? + mov ax,EILLINS + push ax + jmp .fat + jmp bx diff --git a/mach/i86/libem/dup.s b/mach/i86/libem/dup.s new file mode 100644 index 00000000..9634463c --- /dev/null +++ b/mach/i86/libem/dup.s @@ -0,0 +1,12 @@ +.define .dup + + ! $Header$ + ! #bytes in cx +.dup: + pop bx ! return address + mov si,sp + sub sp,cx + mov di,sp + sar cx,1 + rep movs + jmp bx diff --git a/mach/i86/libem/dvi.s b/mach/i86/libem/dvi.s new file mode 100644 index 00000000..fd3daac8 --- /dev/null +++ b/mach/i86/libem/dvi.s @@ -0,0 +1,35 @@ +.define .dvi + + ! $Header$ + ! #bytes in ax +.dvi: + pop bx ! return address + cmp ax,2 + jne 1f + pop ax + cwd + pop cx + idiv cx + push ax + jmp bx +1: + cmp ax,4 + jne 9f + pop ax + pop dx + pop si + pop di + push bx + push di + push si + push dx + push ax + call .dvi4 + pop bx + push cx + push ax + jmp bx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/dvi4.s b/mach/i86/libem/dvi4.s new file mode 100644 index 00000000..e4c66ff1 --- /dev/null +++ b/mach/i86/libem/dvi4.s @@ -0,0 +1,85 @@ +.define .dvi4 + +yl=2 +yh=4 +xl=6 +xh=8 + +.dvi4: + ! $Header$ + mov si,sp ! copy of sp + mov bx,yl(si) + mov ax,yh(si) + cwd + mov di,dx + cmp dx,ax + jne 7f + and dx,dx + jge 1f + neg bx + je 7f +1: + xor dx,dx + mov cx,xl(si) + mov ax,xh(si) + and ax,ax + jge 2f + neg ax + neg cx + sbb ax,dx + not di +2: + div bx + xchg ax,cx + div bx ! cx = high abs(result), ax=low abs(result) +9: + and di,di + jge 1f + neg cx + neg ax + sbb cx,0 +1: + ! cx is high order result + ! ax is low order result + ret 8 + +7: + push dx ! sign of y + mov di,ax + xor bx,bx + and di,di + jge 1f + neg di + neg yl(si) + sbb di,bx +1: + mov ax,xl(si) + mov dx,xh(si) + and dx,dx + jge 1f + neg dx + neg ax + sbb dx,bx + not -2(si) +1: + mov cx,16 +1: + shl ax,1 + rcl dx,1 + rcl bx,1 + cmp di,bx + ja 3f + jb 2f + cmp yl(si),dx + jbe 2f +3: + loop 1b + jmp 1f +2: + sub dx,yl(si) + sbb bx,di + inc ax + loop 1b +1: + pop di ! di=sign of result,ax= result + jmp 9b diff --git a/mach/i86/libem/dvu.s b/mach/i86/libem/dvu.s new file mode 100644 index 00000000..b2bcdd67 --- /dev/null +++ b/mach/i86/libem/dvu.s @@ -0,0 +1,35 @@ +.define .dvu + + ! $Header$ + ! #bytes in ax +.dvu: + pop bx ! return address + cmp ax,2 + jne 1f + pop ax + xor dx,dx + pop cx + div cx + push ax + jmp bx +1: + cmp ax,4 + jne 9f + pop ax + pop dx + pop si + pop di + push bx + push di + push si + push dx + push ax + call .dvu4 + pop bx + push cx + push ax + jmp bx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/dvu4.s b/mach/i86/libem/dvu4.s new file mode 100644 index 00000000..fff547b6 --- /dev/null +++ b/mach/i86/libem/dvu4.s @@ -0,0 +1,49 @@ +.define .dvu4 + +yl=2 +yh=4 +xl=6 +xh=8 + +.dvu4: + ! $Header$ + mov si,sp ! copy of sp + mov bx,yl(si) + mov ax,yh(si) + or ax,ax + jne 7f + xor dx,dx + mov cx,xl(si) + mov ax,xh(si) + div bx + xchg ax,cx + div bx +9: + ! cx is high order result + ! ax is low order result + ret 8 + +7: + mov di,ax + xor bx,bx + mov ax,xl(si) + mov dx,xh(si) + mov cx,16 +1: + shl ax,1 + rcl dx,1 + rcl bx,1 + cmp di,bx + ja 3f + jb 2f + cmp yl(si),dx + jbe 2f +3: + loop 1b + jmp 9b +2: + sub dx,yl(si) + sbb bx,di + inc ax + loop 1b + jmp 9b diff --git a/mach/i86/libem/error.s b/mach/i86/libem/error.s new file mode 100644 index 00000000..64354e67 --- /dev/null +++ b/mach/i86/libem/error.s @@ -0,0 +1,30 @@ +.define .error + + ! $Header$ + ! ax is trap number + ! all registers must be saved + ! because return is possible + ! May only be called with error no's <16 +.error: + push bp + push si + push di + push dx + push cx + push bx + push ax + mov cx,ax + mov bx,1 + sal bx,cl + test bx,(.ignmask) + jne 2f + call .trp +2: + pop ax + pop bx + pop cx + pop dx + pop di + pop si + pop bp + ret diff --git a/mach/i86/libem/exg.s b/mach/i86/libem/exg.s new file mode 100644 index 00000000..8b5bf4b9 --- /dev/null +++ b/mach/i86/libem/exg.s @@ -0,0 +1,20 @@ +.define .exg + + ! $Header$ + ! #bytes in cx +.exg: + pop bx ! return address + mov dx,cx + mov si,sp + sub sp,cx + mov di,sp + rep movs + mov si,sp + mov di,sp + add di,dx + add di,dx + mov cx,dx + sar cx,1 + rep movs + mov sp,si + jmp bx diff --git a/mach/i86/libem/fakfp.s b/mach/i86/libem/fakfp.s new file mode 100644 index 00000000..df97bc26 --- /dev/null +++ b/mach/i86/libem/fakfp.s @@ -0,0 +1,42 @@ +.define .mlf,.dvf,.ngf,.adf,.sbf,.cmf,.zrf,.fif,.fef +.define .mlf8,.dvf8,.ngf8,.adf8,.sbf8,.cmf8,.zrf8,.fif8,.fef8 +.define .mlf4,.dvf4,.ngf4,.adf4,.sbf4,.cmf4,.zrf4,.fif4,.fef4 +.define .cif,.cfi,.cuf,.cfu,.cff + +.mlf: +.dvf: +.ngf: +.adf: +.sbf: +.cmf: +.zrf: +.fif: +.fef: +.mlf4: +.dvf4: +.ngf4: +.adf4: +.sbf4: +.cmf4: +.zrf4: +.fif4: +.fef4: +.mlf8: +.dvf8: +.ngf8: +.adf8: +.sbf8: +.cmf8: +.zrf8: +.fif8: +.fef8: +.cif: +.cfi: +.cuf: +.cfu: +.cff: + ! $Header$ + pop bx ! return address + mov ax,EILLINS + push ax + jmp .fat diff --git a/mach/i86/libem/fat.s b/mach/i86/libem/fat.s new file mode 100644 index 00000000..5a0dd072 --- /dev/null +++ b/mach/i86/libem/fat.s @@ -0,0 +1,7 @@ +.define .fat + +.fat: + ! $Header$ + call .trp + call .stop + ! no return diff --git a/mach/i86/libem/gto.s b/mach/i86/libem/gto.s new file mode 100644 index 00000000..8fdb23ba --- /dev/null +++ b/mach/i86/libem/gto.s @@ -0,0 +1,7 @@ +.define .gto + +.gto: + ! $Header$ + mov bp,4(bx) + mov sp,2(bx) + jmp (bx) diff --git a/mach/i86/libem/iaar.s b/mach/i86/libem/iaar.s new file mode 100644 index 00000000..4a2a92eb --- /dev/null +++ b/mach/i86/libem/iaar.s @@ -0,0 +1,15 @@ +.define .iaar + +.iaar: + ! $Header$ + pop bx + pop dx + cmp dx,2 + jne .unknown + pop si ! descriptor address + pop ax ! index + pop di ! array base + sub ax,(si) + mul 4(si) + add di,ax + jmp bx diff --git a/mach/i86/libem/ilar.s b/mach/i86/libem/ilar.s new file mode 100644 index 00000000..11fbed54 --- /dev/null +++ b/mach/i86/libem/ilar.s @@ -0,0 +1,13 @@ +.define .ilar + +.ilar: + ! $Header$ + pop bx + pop dx + cmp dx,2 + jne .unknown + pop di ! descriptor address + pop ax ! index + pop si ! array base + push bx + jmp .lar2 diff --git a/mach/i86/libem/inn.s b/mach/i86/libem/inn.s new file mode 100644 index 00000000..ced6bbc2 --- /dev/null +++ b/mach/i86/libem/inn.s @@ -0,0 +1,29 @@ +.define .inn + + ! $Header$ + ! #bytes in cx + ! bit # in ax +.inn: + pop bx ! return address + xor dx,dx + xor si,si + mov di,8 + div di + mov di,sp + add di,ax + cmp ax,cx + xchg ax,dx + xchg ax,si ! ax:=si,si:=dx,does not change carry + jae 1f + movb dl,bits(si) + testb (di),dl + jz 1f + inc ax +1: + add sp,cx + ! ax is result + jmp bx + + .data +bits: + .byte 1,2,4,8,16,32,64,128 diff --git a/mach/i86/libem/ior.s b/mach/i86/libem/ior.s new file mode 100644 index 00000000..0fc130a4 --- /dev/null +++ b/mach/i86/libem/ior.s @@ -0,0 +1,15 @@ +.define .ior + + ! $Header$ + ! #bytes in cx +.ior: + pop bx ! return address + mov di,sp + add di,cx + sar cx,1 +1: + pop ax + or ax,(di) + stos + loop 1b + jmp bx diff --git a/mach/i86/libem/isar.s b/mach/i86/libem/isar.s new file mode 100644 index 00000000..569bb779 --- /dev/null +++ b/mach/i86/libem/isar.s @@ -0,0 +1,13 @@ +.define .isar + +.isar: + ! $Header$ + pop bx + pop dx + cmp dx,2 + jne .unknown + pop si ! descriptor address + pop ax ! index + pop di ! array base + push bx + jmp .sar2 diff --git a/mach/i86/libem/lar2.s b/mach/i86/libem/lar2.s new file mode 100644 index 00000000..58a7c3aa --- /dev/null +++ b/mach/i86/libem/lar2.s @@ -0,0 +1,23 @@ +.define .lar2 + +.lar2: + ! $Header$ + pop bx ! return address + ! di, descriptor address + ! ax, index + ! si, base address + sub ax,(di) + mov cx,4(di) + imul cx + add si,ax + sar cx,1 + jnb 1f + xorb ah,ah + lodsb + push ax + jmp bx +1: + sub sp,4(di) + mov di,sp + rep movs + jmp bx diff --git a/mach/i86/libem/loi.s b/mach/i86/libem/loi.s new file mode 100644 index 00000000..c958d5e7 --- /dev/null +++ b/mach/i86/libem/loi.s @@ -0,0 +1,19 @@ +.define .loi + + ! $Header$ + ! #bytes in cx + ! source address in si +.loi: + pop bx + mov dx,cx + sar cx,1 + jnb 1f + xorb ah,ah + lodsb + push ax + jmp bx +1: + sub sp,dx + mov di,sp + rep movs + jmp bx diff --git a/mach/i86/libem/mli.s b/mach/i86/libem/mli.s new file mode 100644 index 00000000..f143488d --- /dev/null +++ b/mach/i86/libem/mli.s @@ -0,0 +1,27 @@ +.define .mli + + ! $Header$ + ! #bytes in ax +.mli: + pop bx ! return address + cmp ax,2 + jne 1f + pop ax + pop cx + mul cx + push ax + jmp bx +1: + mov dx,bx + cmp ax,4 + jne 9f + pop si + pop di + pop bx + pop ax + push dx + jmp .mli4 +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/mli4.s b/mach/i86/libem/mli4.s new file mode 100644 index 00000000..36395fd7 --- /dev/null +++ b/mach/i86/libem/mli4.s @@ -0,0 +1,17 @@ +.define .mli4 + + ! $Header$ + ! x * y with + ! x.low = si x.high = di + ! y.low = bx y.high = ax + +.mli4: + mul si ! xl*yh + mov cx,ax + mov ax,di + mul bx ! xh*yl + add cx,ax ! xh*yl+xl*yh + mov ax,si + mul bx ! xl*yl + add dx,cx + ret diff --git a/mach/i86/libem/mon.s b/mach/i86/libem/mon.s new file mode 100644 index 00000000..30dd48ef --- /dev/null +++ b/mach/i86/libem/mon.s @@ -0,0 +1,5 @@ +.define .mon + +.mon: + ! $Header$ + call .stop diff --git a/mach/i86/libem/ngi.s b/mach/i86/libem/ngi.s new file mode 100644 index 00000000..6a479f7f --- /dev/null +++ b/mach/i86/libem/ngi.s @@ -0,0 +1,27 @@ +.define .ngi + + ! $Header$ + ! #bytes in ax +.ngi: + pop bx ! return address + cmp ax,2 + jne 1f + pop cx + neg cx + push cx + jmp bx +1: + cmp ax,4 + jne 9f + pop dx + pop ax + neg ax + neg dx + sbb ax,0 + push dx + push ax + jmp bx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/nop.s b/mach/i86/libem/nop.s new file mode 100644 index 00000000..26aa071d --- /dev/null +++ b/mach/i86/libem/nop.s @@ -0,0 +1,22 @@ +.define .nop + +SIO_S = 0xDA +SIO_D = 0xD8 +RXRDY = 0x02 + +.nop: + ! $Header$ + mov ax,(hol0) + call printd +! movb al,' ' +! call printc +! mov ax,sp +! call printd +!1: +! inb SIO_S +! andb al,RXRDY +! jz 1b +! inb SIO_D +! call printc + movb al,'\n' + jmp printc diff --git a/mach/i86/libem/print.s b/mach/i86/libem/print.s new file mode 100644 index 00000000..bb8ea8ae --- /dev/null +++ b/mach/i86/libem/print.s @@ -0,0 +1,47 @@ +.define printc,printd,prints + +SIO_D = 0xD8 +SIO_S = 0xDA +TXRDY = 0x01 + + ! $Header$ + ! argument in ax + ! uses bx +prints: + xchg ax,bx +1: + movb al,(bx) + inc bx + testb al,al + jz 2f + call printc + jmp 1b +2: + ret + + ! argument in ax + ! uses cx and dx +printd: + xor dx,dx + mov cx,10 + div cx + test ax,ax + jz 1f + push dx + call printd + pop dx +1: + xchg ax,dx + addb al,'0' + .errnz printc - . + + ! argument in ax +printc: + push ax +1: + inb SIO_S + andb al,TXRDY + jz 1b + pop ax + outb SIO_D + ret diff --git a/mach/i86/libem/printf.s b/mach/i86/libem/printf.s new file mode 100644 index 00000000..31ea794b --- /dev/null +++ b/mach/i86/libem/printf.s @@ -0,0 +1,38 @@ +.define printf + +printf: + ! $Header$ + pop bx ! return address + xchg ax,di + mov si,sp +1: + movb al,(di) + inc di + testb al,al + jz 6f + cmpb al,'%' + je 3f +2: + call printc + jmp 1b +3: + movb al,(di) + inc di + cmpb al,'c' + jne 4f + lods + jmp 2b +4: + cmpb al,'d' + jne 5f + lods + call printd + jmp 1b +5: + cmpb al,'s' + jne 2b + lods + call prints + jmp 1b +6: + jmp bx diff --git a/mach/i86/libem/rck.s b/mach/i86/libem/rck.s new file mode 100644 index 00000000..5a012147 --- /dev/null +++ b/mach/i86/libem/rck.s @@ -0,0 +1,17 @@ +.define .rck + + ! $Header$ + ! descriptor address in si + ! value in ax, must be left there +.rck: + cmp ax,(si) + jl 2f + cmp ax,2(si) + jg 2f + ret +2: + push ax + mov ax,ERANGE + call .error + pop ax + ret diff --git a/mach/i86/libem/rmi.s b/mach/i86/libem/rmi.s new file mode 100644 index 00000000..81fdc89e --- /dev/null +++ b/mach/i86/libem/rmi.s @@ -0,0 +1,35 @@ +.define .rmi + + ! $Header$ + ! #bytes in ax +.rmi: + pop bx ! return address + cmp ax,2 + jne 1f + pop ax + cwd + pop cx + idiv cx + push dx + jmp bx +1: + cmp ax,4 + jne 9f + pop ax + pop dx + pop si + pop di + push bx + push di + push si + push dx + push ax + call .rmi4 + pop ax + push bx + push dx + jmp ax +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/rmi4.s b/mach/i86/libem/rmi4.s new file mode 100644 index 00000000..6abaea1b --- /dev/null +++ b/mach/i86/libem/rmi4.s @@ -0,0 +1,83 @@ +.define .rmi4 + +yl=2 +yh=4 +xl=6 +xh=8 + +.rmi4: + ! $Header$ + mov si,sp ! copy of sp + mov bx,yl(si) + mov ax,yh(si) + cwd + cmp dx,ax + jne 7f + and dx,dx + jge 1f + neg bx + je 7f +1: + xor dx,dx + mov cx,xl(si) + mov ax,xh(si) + and ax,ax + jge 2f + neg ax + neg cx + sbb ax,dx +2: + div bx + xchg ax,cx + div bx ! dx= result(low), 0=result(high) + xor bx,bx +9: + cmp xh(si),0 + jge 1f + neg bx + neg dx + sbb bx,0 +1: + ! bx is high order result + ! dx is low order result + ret 8 + +7: + mov di,ax + xor bx,bx + and di,di + jge 1f + neg di + neg yl(si) + sbb di,bx +1: + mov ax,xl(si) + mov dx,xh(si) + and dx,dx + jge 1f + neg dx + neg ax + sbb dx,bx +1: + mov cx,16 +1: + shl ax,1 + rcl dx,1 + rcl bx,1 + cmp di,bx + ja 3f + jb 2f + cmp yl(si),dx + jbe 2f +3: + loop 1b + ! dx=result(low), bx=result(high) + jmp 9b +2: + sub dx,yl(si) + sbb bx,di + inc ax + loop 1b +1: + ! dx=result(low), bx=result(high) + jmp 9b diff --git a/mach/i86/libem/rmu.s b/mach/i86/libem/rmu.s new file mode 100644 index 00000000..3e74de7e --- /dev/null +++ b/mach/i86/libem/rmu.s @@ -0,0 +1,35 @@ +.define .rmu + + ! $Header$ + ! #bytes in ax +.rmu: + pop bx ! return address + cmp ax,2 + jne 1f + pop ax + xor dx,dx + pop cx + idiv cx + push dx + jmp bx +1: + cmp ax,4 + jne 9f + pop ax + pop dx + pop si + pop di + push bx + push di + push si + push dx + push ax + call .rmu4 + pop ax + push bx + push dx + jmp ax +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/rmu4.s b/mach/i86/libem/rmu4.s new file mode 100644 index 00000000..4a79fcf0 --- /dev/null +++ b/mach/i86/libem/rmu4.s @@ -0,0 +1,55 @@ +.define .rmu4 + +yl=2 +yh=4 +xl=6 +xh=8 + +.rmu4: + ! $Header$ + mov si,sp ! copy of sp + mov bx,yl(si) + mov ax,yh(si) + or ax,ax + jne 7f +1: + xor dx,dx + mov cx,xl(si) + mov ax,xh(si) +2: + div bx + xchg ax,cx + div bx + xor bx,bx +9: + ! bx is high order result + ! dx is low order result + ret 8 + +7: + mov di,ax + xor bx,bx + mov ax,xl(si) + mov dx,xh(si) + mov cx,16 +1: + shl ax,1 + rcl dx,1 + rcl bx,1 + cmp di,bx + ja 3f + jb 2f + cmp yl(si),dx + jbe 2f +3: + loop 1b + ! dx=result(low), bx=result(high) + jmp 9b +2: + sub dx,yl(si) + sbb bx,di + inc ax + loop 1b +1: + ! dx=result(low), bx=result(high) + jmp 9b diff --git a/mach/i86/libem/rol.s b/mach/i86/libem/rol.s new file mode 100644 index 00000000..6de420f4 --- /dev/null +++ b/mach/i86/libem/rol.s @@ -0,0 +1,33 @@ +.define .rol + + ! $Header$ + ! #bytes in ax +.rol: + pop dx ! return address + cmp ax,2 + jne 1f + pop ax + pop cx + rol ax,cl + push ax + jmp dx +1: + cmp ax,4 + jne 9f + pop cx + jcxz 2f + pop ax + pop bx +3: + sal ax,1 + rcl bx,1 + adc ax,0 + loop 3b + push bx + push ax +2: + jmp dx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/ror.s b/mach/i86/libem/ror.s new file mode 100644 index 00000000..5b98ec8f --- /dev/null +++ b/mach/i86/libem/ror.s @@ -0,0 +1,34 @@ +.define .ror + + ! $Header$ + ! #bytes in ax +.ror: + pop dx ! return address + cmp ax,2 + jne 1f + pop ax + pop cx + ror ax,cl + push ax + jmp dx +1: + cmp ax,4 + jne 9f + pop cx + jcxz 2f + neg cx + add cx,32 + pop ax + pop bx +3: + sar bx,1 + rcr ax,1 + loop 3b + push bx + push ax +2: + jmp dx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/sar2.s b/mach/i86/libem/sar2.s new file mode 100644 index 00000000..8a317de4 --- /dev/null +++ b/mach/i86/libem/sar2.s @@ -0,0 +1,22 @@ +.define .sar2 + +.sar2: + ! $Header$ + pop bx ! return address + ! si, descriptor address + ! ax, index + ! di, base address + sub ax,(si) + mov cx,4(si) + imul cx + add di,ax + sar cx,1 + jnb 1f + pop ax + stosb + jmp bx +1: + mov si,sp + rep movs + mov sp,si + jmp bx diff --git a/mach/i86/libem/sbi.s b/mach/i86/libem/sbi.s new file mode 100644 index 00000000..018f399f --- /dev/null +++ b/mach/i86/libem/sbi.s @@ -0,0 +1,27 @@ +.define .sbi + + ! $Header$ + ! #bytes in cx , top of stack in ax +.sbi: + pop bx ! return subress + cmp cx,2 + jne 1f + pop cx + sub ax,cx + neg ax + jmp bx +1: + cmp cx,4 + jne 9f + pop dx + pop cx + sub cx,ax + mov ax,cx + pop cx + sbc cx,dx + push cx + jmp bx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/set.s b/mach/i86/libem/set.s new file mode 100644 index 00000000..0c5dabd8 --- /dev/null +++ b/mach/i86/libem/set.s @@ -0,0 +1,35 @@ +.define .set + + ! $Header$ + ! #bytes in cx + ! bit # in ax +.set: + pop bx ! return address + xor dx,dx +!ifdef create set + mov di,sp + sub di,cx +1: + push dx + cmp sp,di + ja 1b +!endif + mov di,8 + div di + cmp ax,cx + jae 2f + mov di,sp + add di,ax + mov si,dx + movb dl,bits(si) + orb (di),dl + jmp bx +2: + push bx + mov ax,ESET + push ax + jmp .trp + + .data +bits: + .byte 1,2,4,8,16,32,64,128 diff --git a/mach/i86/libem/sli.s b/mach/i86/libem/sli.s new file mode 100644 index 00000000..3d57008b --- /dev/null +++ b/mach/i86/libem/sli.s @@ -0,0 +1,32 @@ +.define .sli + + ! $Header$ + ! #bytes in ax +.sli: + pop dx ! return address + cmp ax,2 + jne 1f + pop ax + pop cx + sal ax,cl + push ax + jmp dx +1: + cmp ax,4 + jne 9f + pop cx + jcxz 2f + pop ax + pop bx +3: + sal ax,1 + rcl bx,1 + loop 3b + push bx + push ax +2: + jmp dx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/sri.s b/mach/i86/libem/sri.s new file mode 100644 index 00000000..9cd97357 --- /dev/null +++ b/mach/i86/libem/sri.s @@ -0,0 +1,32 @@ +.define .sri + + ! $Header$ + ! #bytes in ax +.sri: + pop dx ! return address + cmp ax,2 + jne 1f + pop ax + pop cx + sar ax,cl + push ax + jmp dx +1: + cmp ax,4 + jne 9f + pop cx + jcxz 2f + pop ax + pop bx +3: + sar bx,1 + rcr ax,1 + loop 3b + push bx + push ax +2: + jmp dx +9: + mov ax,EODDZ + push ax + jmp .trp diff --git a/mach/i86/libem/sti.s b/mach/i86/libem/sti.s new file mode 100644 index 00000000..9e2fcc67 --- /dev/null +++ b/mach/i86/libem/sti.s @@ -0,0 +1,17 @@ +.define .sti + + ! $Header$ + ! #bytes in cx + ! destination address in di +.sti: + pop bx ! return address + sar cx,1 + jnb 1f + pop ax + stosb + jmp bx +1: + mov si,sp + rep movs + mov sp,si + jmp bx diff --git a/mach/i86/libem/stop.s b/mach/i86/libem/stop.s new file mode 100644 index 00000000..5aeaf51f --- /dev/null +++ b/mach/i86/libem/stop.s @@ -0,0 +1,4 @@ +.define .stop +.stop: + ! $Header$ + int 3 diff --git a/mach/i86/libem/strhp.s b/mach/i86/libem/strhp.s new file mode 100644 index 00000000..e5e11bf8 --- /dev/null +++ b/mach/i86/libem/strhp.s @@ -0,0 +1,19 @@ +.define .strhp + +.strhp: + ! $Header$ + pop bx + pop ax + mov (.reghp),ax + cmp ax,(.limhp) + jb 1f + add ax,02000 + and ax,~0777 + mov (.limhp),ax + cmp ax,sp + jae 2f +1: + jmp bx +2: + mov ax,EHEAP + jmp .fat diff --git a/mach/i86/libem/tail.s b/mach/i86/libem/tail.s new file mode 100644 index 00000000..702f47f3 --- /dev/null +++ b/mach/i86/libem/tail.s @@ -0,0 +1,16 @@ +.define endtext,enddata,endbss +.define _end,_etext,_edata + + ! $Header$ + .text + .align 2 +endtext: +_etext: + .data + .align 2 +enddata: +_edata: + .bss + .align 2 +_end: +endbss: diff --git a/mach/i86/libem/trp.s b/mach/i86/libem/trp.s new file mode 100644 index 00000000..7f95dc28 --- /dev/null +++ b/mach/i86/libem/trp.s @@ -0,0 +1,15 @@ +.define .trp + + ! $Header$ + ! ax is trap number +.trp: + xor bx,bx + xchg bx,(.trppc) + test bx,bx + jz 2f + push ax + call bx + pop ax + ret +2: + call .stop diff --git a/mach/i86/libem/unknown.s b/mach/i86/libem/unknown.s new file mode 100644 index 00000000..2da916e2 --- /dev/null +++ b/mach/i86/libem/unknown.s @@ -0,0 +1,7 @@ +.define .unknown + +.unknown: + ! $Header$ + mov ax,EILLINS + push ax + jmp .fat diff --git a/mach/i86/libem/xor.s b/mach/i86/libem/xor.s new file mode 100644 index 00000000..913d3429 --- /dev/null +++ b/mach/i86/libem/xor.s @@ -0,0 +1,15 @@ +.define .xor + + ! $Header$ + ! #bytes in cx +.xor: + pop bx ! return address + mov di,sp + add di,cx + sar cx,1 +1: + pop ax + xor ax,(di) + stos + loop 1b + jmp bx diff --git a/mach/i86/libpc/Makefile b/mach/i86/libpc/Makefile new file mode 100644 index 00000000..5c669cf0 --- /dev/null +++ b/mach/i86/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/i86/libpc/compmodule b/mach/i86/libpc/compmodule new file mode 100755 index 00000000..2bcf66ca --- /dev/null +++ b/mach/i86/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?ack} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/i86/libsys/head_em.s b/mach/i86/libsys/head_em.s new file mode 100644 index 00000000..fd45fde9 --- /dev/null +++ b/mach/i86/libsys/head_em.s @@ -0,0 +1,75 @@ +.define begtext,begdata,begbss +.define hol0,.reghp,.limhp,.trppc,.ignmask +.define ERANGE,ESET,EHEAP,ECASE,EILLINS + +ERANGE = 1 +ESET = 2 +EIDIVZ = 6 +EHEAP = 17 +EILLINS = 18 +EODDZ = 19 +ECASE = 20 + +base = 0x01C0 +topmem = 0xFFF0 + + .org topmem-16 +.extern __n_line +maxmem: +__n_line: + .space 16 + .errnz __n_line-0xFFE0 + + .base base + + .text +begtext: + cld + xor ax,ax + mov ss,ax + mov ds,ax + mov es,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,envp + push ax + mov ax,argv + push ax + mov ax,1 + push ax + call _m_a_i_n + call .stop +.diverr: + push ax + mov ax,EIDIVZ + call .error + pop ax + iret + + .data +begdata: +hol0: + .word 0,0 + .word 0,0 +argv: + .word 3f +envp: + .word 0 +3: + .asciz "PROGRAM" +.reghp: + .word endbss +.limhp: + .word endbss +.ignmask: + .word 0 +.trppc: + .word 0 + + .bss +begbss: diff --git a/mach/i86/ncg/Makefile b/mach/i86/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/i86/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/install b/mach/install new file mode 100755 index 00000000..ed04d7a0 --- /dev/null +++ b/mach/install @@ -0,0 +1,20 @@ +case $# in +1) DEST="$1" ;; +2) DEST="$2" ;; +*) echo $0 [source] destination ;; +esac +MACH=`(cd .. ; basename \`pwd\`)` +mkdir ../../../lib/$MACH >/dev/null 2>&1 +if cp "$1" ../../../lib/${MACH}/$DEST >/dev/null 2>&1 || + { rm -f ../../../lib/${MACH}/$DEST >/dev/null 2>&1 && + cp "$1" ../../../lib/${MACH}/$DEST >/dev/null 2>&1 + } +then + if (ar t ../../../lib/${MACH}/$DEST | grep __.SYMDEF ) >/dev/null 2>&1 + then + ranlib ../../../lib/${MACH}/$DEST + fi + exit 0 +else + echo Sorry, can not create "lib/${MACH}/$DEST". +fi diff --git a/mach/m68020/ncg/Makefile b/mach/m68020/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/m68020/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/m68k2/Action b/mach/m68k2/Action new file mode 100644 index 00000000..6fee7dd1 --- /dev/null +++ b/mach/m68k2/Action @@ -0,0 +1,29 @@ +name "Motorola 68000 assembler" +dir as +end +name "Motorola 68000 2-4 backend" +dir cg +end +name "Motorola 68000 interpreters" +system m68* +dir int +end +name "Motorola 68000 2-4 download program(s)" +failure "Sorry, the m68k? conversion program has to be translated on the target machine" +dir dl +end +name "Motorola 68000 2-4 C libraries" +dir libcc +end +name "Motorola 68000 2-4 EM library" +dir libem +end +name "Motorola 68000 2-4 Pascal library" +dir libpc +end +name "Motorola 68000 2-4 System library" +dir libsys +end +name "Motorola 68000 2-4 Basic library" +dir libbc +end diff --git a/mach/m68k2/README b/mach/m68k2/README new file mode 100644 index 00000000..18d5c6e2 --- /dev/null +++ b/mach/m68k2/README @@ -0,0 +1,68 @@ +The m68k2 back end is an EM code generator for the +Motorola MC68000. It defines an integer to be 16 bits +and a pointer to be 32 bits. +At present it does not support floating point operations. +(All EM floating point instructions are translated to the +68000 "trap" instruction.) +The m68k2 back end generates code for the ACK 68000 assembler/linker. +(The mnemonics recognized by this assembler can be found in +"as/mach3.c"). As this assembler/linker does not define an +object (.o) format, it can only link assembly files. Consequently, +all library modules are stored as assembly files. + +Some parts of the back end are system dependent, i.e. they depend +on the kind of target 68000 system. + - The way to do a Unix system call may vary from system to system. + For every system call you need to have an assembly routine that + passes the arguments and the system call number to Unix. + These routines should be put in the library file "lib/tail_mon". + The distribution contains a tail_mon file tailored for + UniSoft Unix (see directory "libsys"). + Beware that several Unix systems (e.g. UniSoft Unix) use 4-byte + integers, whereas the m68k2 back end produces code for 2-byte + integers. In this case all system calls having an "int" parameter + should convert their parameters to "long"s. + - Most systems require some sort of "test for enough stack space" + at the beginning of every procedure, to get around the "back up" + problem. E.g. UniSoft Unix requires a "tst.b N(sp)" instruction + This instruction is generated by the routines "prolog()" and + "save" in "cg/mach.c". + - The output of the ACK 68000 assembler/linker is an a.out file that + has a different format as an a.out file on your system. (As most + 68000 systems have different a.out formats, there is no such thing + as "the" 68000 a.out format). So a program is needed to convert the + ACK a.out format (i.e. a series of "emitrecs" as defined in + "as/frame.c") to your a.out format (as defined in + "/usr/include/a.out.h"). The 1-page program "dl/cv.c" does + the job for UniSoft Unix. It probably need only be slightly + modified for your system. Note that the program + generates no text or bss segments, but only a data segment. + If your target 68000 does not run Unix, but is e.g. a stand alone + 68000, you will need a program to download the ACK a.out file. + The program "dl/dl.c" produces Intel Hex format on standard output + from an a.out file. + - The EM runtime start-off ("libem/head_em.s") may have to be modified. + It should call the procedure _m_a_i_n with parameters (argc,argv,envp). + Usually, Unix will put these on top of the stack before starting + the program. Note, however, that for 4-byte systems Unix will provide + a 4-byte argc, while _m_a_i_n expects a 2-byte argc; so the value + must be shortened to 2 bytes. + The head_em also does a brk() system call to allocate the bss. + (The size of the bss cannot be obtained from an ACK a.out file). + + +The m68k2 code generator translates most EM instructions in line. +For some complex EM instructions it uses assembly routines (stored in the +library "libem/libem_s.a"). + +The generated code does not check for array bound errors, overflow in +arithmetic operations or division by zero (the latter will cause a hardware +trap). + +The code generator has the following register conventions: + a7: stack pointer + a6: local base pointer + a0,a1,d0,d1,d2: scratch registers + (d0 is also used for 2/4 bytes function results; + d0 and d1 are used for 8 bytes function results) + a2-a5,d3-d7: register variables. diff --git a/mach/m68k2/cg/mach.c b/mach/m68k2/cg/mach.c new file mode 100644 index 00000000..2b539e4d --- /dev/null +++ b/mach/m68k2/cg/mach.c @@ -0,0 +1,223 @@ +#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 == 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,".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 */ +}; diff --git a/mach/m68k2/cg/mach.h b/mach/m68k2/cg/mach.h new file mode 100644 index 00000000..62a2e1fd --- /dev/null +++ b/mach/m68k2/cg/mach.h @@ -0,0 +1,28 @@ +#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 + diff --git a/mach/m68k2/cg/table b/mach/m68k2/cg/table new file mode 100644 index 00000000..068d2faa --- /dev/null +++ b/mach/m68k2/cg/table @@ -0,0 +1,2752 @@ +"$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+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 < 128 | nocoercions: DATA_ALT1 | + remove(ALL) + "cmp.b #$1,%[1]" + "beq $2" | | | +... | DATA_ALT STACK | + "cmp #$1,%[1]" + "beq $2" | | | +loc bne $1 >= 0 && $1 < 128 | 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)") diff --git a/mach/m68k2/dl/Makefile b/mach/m68k2/dl/Makefile new file mode 100644 index 00000000..ea070d4f --- /dev/null +++ b/mach/m68k2/dl/Makefile @@ -0,0 +1,21 @@ +CFLAGS=-O + +cv: cv.o + $(CC) -o cv -n cv.o + +install: ins_cv +ins_cv: cv + ../../install cv + +cmp: cmp_cv +cmp_cv: cv + -../../compare cv + +opr: + make pr | opr + +pr: + @pr `pwd`/cv.c + +clean: + -rm -f *.o *.old cv diff --git a/mach/m68k2/dl/cv.c b/mach/m68k2/dl/cv.c new file mode 100644 index 00000000..0fa9c30a --- /dev/null +++ b/mach/m68k2/dl/cv.c @@ -0,0 +1,71 @@ +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 +#include + +/* + * 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; +} + + diff --git a/mach/m68k2/dl/dl.c b/mach/m68k2/dl/dl.c new file mode 100644 index 00000000..91b44c64 --- /dev/null +++ b/mach/m68k2/dl/dl.c @@ -0,0 +1,106 @@ +static char rcsid[] = "$Header$"; +#define MAXBYTE 24 +#include +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); + } diff --git a/mach/m68k2/libbc/Makefile b/mach/m68k2/libbc/Makefile new file mode 100644 index 00000000..f3e9eef2 --- /dev/null +++ b/mach/m68k2/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=m68k2" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/m68k2/libbc/compmodule b/mach/m68k2/libbc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k2/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k2/libcc/Makefile b/mach/m68k2/libcc/Makefile new file mode 100644 index 00000000..8f20caf8 --- /dev/null +++ b/mach/m68k2/libcc/Makefile @@ -0,0 +1,37 @@ +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 diff --git a/mach/m68k2/libcc/compmodule b/mach/m68k2/libcc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k2/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k2/libem/LIST b/mach/m68k2/libem/LIST new file mode 100644 index 00000000..47778703 --- /dev/null +++ b/mach/m68k2/libem/LIST @@ -0,0 +1,34 @@ +libem_s.a +ara.s +cvf.s +cii.s +cmi.s +cmp.s +cmu.s +csa.s +csb.s +cuu.s +exg.s +inn.s +los.s +rck.s +ret.s +set.s +sts.s +nop.s +mon.s +dvi.s +dvu.s +mli.s +mlu.s +shp.s +sig.s +cms.s +gto.s +fat.s +trp.s +dia.s +printf.s +lxl.s +lxa.s +lpb.s diff --git a/mach/m68k2/libem/Makefile b/mach/m68k2/libem/Makefile new file mode 100644 index 00000000..1af8fa3b --- /dev/null +++ b/mach/m68k2/libem/Makefile @@ -0,0 +1,19 @@ +install: + ../../install head_em.s head_em + ../../install libem_s.a tail_em.rt + ../../install end.s end_em.s + +cmp: + -../../compare head_em.s head_em + -../../compare libem_s.a tail_em.rt + -../../compare end.s end_em.s + +clean : + +opr : + make pr | opr + +pr: + @pr `pwd`/head_em.s + @arch pv libem_s.a | pr -h `pwd`/libem_s.a + @pr `pwd`/end.s diff --git a/mach/m68k2/libem/READ_ME b/mach/m68k2/libem/READ_ME new file mode 100644 index 00000000..f0e7d9a7 --- /dev/null +++ b/mach/m68k2/libem/READ_ME @@ -0,0 +1,5 @@ +The original EM library routines saved all registers +(including scratch registers) in global data; hence they +were not reentrant. +The new routines do not save registers d0,d1,d2,a0 and a1. +They are reentrant. diff --git a/mach/m68k2/libem/ara.s b/mach/m68k2/libem/ara.s new file mode 100644 index 00000000..3c3f179a --- /dev/null +++ b/mach/m68k2/libem/ara.s @@ -0,0 +1,83 @@ +.define .sar +.define .lar +.define .aar + + !register usage: + ! a0 : descriptor address + ! d0 : index + ! a1 : base address + .text +.aar: + move.l (sp)+,d2 ! return address + move.l (sp)+,a0 + move.w (sp)+,d0 + move.l (sp)+,a1 + sub (a0),d0 ! index - lower bound : relative index + !chk 2(a0),d0 + !blt 9f + !cmp 2(a0),d0 + !bgt 9f + mulu 4(a0),d0 ! total # bytes + add d0,a1 ! address of element + move.l a1,-(sp) + move.l d2,-(sp) + rts + + +.lar: + move.l (sp)+,d2 ! return address + move.l (sp)+,a0 + move.w (sp)+,d0 + move.l (sp)+,a1 + sub (a0),d0 + !chk 2(a0),d0 + !blt 9f + !cmp 2(a0),d0 + !bgt 9f + move 4(a0),d1 + mulu d1,d0 + add d0,a1 + add d1,a1 + asr #1,d1 + bne 3f + clr d1 + move.b -(a1),d1 + move d1,-(sp) + bra 4f +3: + move -(a1),-(sp) + sub #1,d1 + bgt 3b +4: + move.l d2,-(sp) + rts + + +!9: + !move.w #EARRAY,-(sp) + !jmp .fat +.sar: + move.l (sp)+,d2 + move.l (sp)+,a0 + move.w (sp)+,d0 + move.l (sp)+,a1 + sub (a0),d0 + !chk 2(a0),d0 + !blt 9b + !cmp 2(a0),d0 + !bgt 9b + move 4(a0),d1 + mulu d1,d0 + add d0,a1 + asr #1,d1 + bne 3f + move (sp)+,d1 + move.b d1,(a1) + bra 4f +3: + move (sp)+,(a1)+ + sub #1,d1 + bgt 3b +4: + move.l d2,-(sp) + rts diff --git a/mach/m68k2/libem/cii.s b/mach/m68k2/libem/cii.s new file mode 100644 index 00000000..045d7c72 --- /dev/null +++ b/mach/m68k2/libem/cii.s @@ -0,0 +1,21 @@ +.define .cii + + .text +.cii: + 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: + jmp (a0) diff --git a/mach/m68k2/libem/cmi.s b/mach/m68k2/libem/cmi.s new file mode 100644 index 00000000..dd5e554c --- /dev/null +++ b/mach/m68k2/libem/cmi.s @@ -0,0 +1,18 @@ +.define .cmi, .cmi_ + + ! NUM == 4 + ! result in d1 + .text +.cmi: +.cmi_: + move.l (sp)+,a0 + move.l #1,d1 + move.l (sp)+,d0 + cmp.l (sp)+,d0 + bne 1f + clr d1 + 1: + ble 2f + neg d1 + 2: + jmp (a0) diff --git a/mach/m68k2/libem/cmp.s b/mach/m68k2/libem/cmp.s new file mode 100644 index 00000000..f2d962f9 --- /dev/null +++ b/mach/m68k2/libem/cmp.s @@ -0,0 +1,15 @@ +.define .cmp + + .text +.cmp: + move.l (sp)+,a0 ! return address + move.l #1,d1 + move.l (sp)+,d0 + cmp.l (sp)+,d0 + bne 1f + clr d1 + 1: + bcs 2f + neg d1 + 2: + jmp (a0) diff --git a/mach/m68k2/libem/cms.s b/mach/m68k2/libem/cms.s new file mode 100644 index 00000000..1ff61a85 --- /dev/null +++ b/mach/m68k2/libem/cms.s @@ -0,0 +1,23 @@ +.define .cms + + ! d0 contains set size + + .text +.cms: + move.l (sp)+,d2 ! return address + move.l sp,a0 + move.l sp,a1 + add d0,a1 + move.w d0,d1 + asr #1,d0 +1: + cmp (a0)+,(a1)+ + bne 2f + sub #1,d0 + bgt 1b +2: + asl #1,d1 + add d1,sp + move.w d0,-(sp) + move.l d2,-(sp) + rts diff --git a/mach/m68k2/libem/cmu.s b/mach/m68k2/libem/cmu.s new file mode 100644 index 00000000..624e2cb6 --- /dev/null +++ b/mach/m68k2/libem/cmu.s @@ -0,0 +1,27 @@ +.define .cmu + + ! d0 : # bytes of 1 block + .text +.cmu: + move.l (sp)+,d2 ! reta + move.l sp,a0 ! top block + move.l sp,a1 + move.l d2,-(sp) + add d0,a1 ! lower block + move d0,d2 + asr #1,d0 + move.l #1,d1 ! greater +1: + cmp (a0)+,(a1)+ + bne 2f + sub #1,d0 + bgt 1b + clr d1 ! equal +2: + bcc 3f + neg d1 ! less +3: + move.l (sp)+,a0 + asl #1,d2 + add d2,sp ! new sp + jmp (a0) diff --git a/mach/m68k2/libem/compmodule b/mach/m68k2/libem/compmodule new file mode 100755 index 00000000..eb1ccef3 --- /dev/null +++ b/mach/m68k2/libem/compmodule @@ -0,0 +1,4 @@ +if m68k2 -c $1 1>&2 +then echo `basename $1 $2`.s +else exit 1 +fi diff --git a/mach/m68k2/libem/csa.s b/mach/m68k2/libem/csa.s new file mode 100644 index 00000000..9d3e036f --- /dev/null +++ b/mach/m68k2/libem/csa.s @@ -0,0 +1,26 @@ +.define .csa + + .text +.csa: + move.l (sp)+,a0 ! case descriptor + move (sp)+,d0 ! index + move.l (a0)+,a1 ! default address + sub (a0)+,d0 ! index - lower bound + blt 1f + cmp (a0)+,d0 ! rel. index <-> upper - lower bound + bgt 1f + asl #2,d0 + add d0,a0 + move.l (a0),d1 ! test jump address + move.l d1,d0 + beq 1f + move.l d1,a1 + bra 3f +1: + move.l a1,d0 ! test default jump address + beq 2f +3: + jmp (a1) +2: + move.w #ECASE,-(sp) + jmp .fat diff --git a/mach/m68k2/libem/csb.s b/mach/m68k2/libem/csb.s new file mode 100644 index 00000000..c36ecf00 --- /dev/null +++ b/mach/m68k2/libem/csb.s @@ -0,0 +1,24 @@ +.define .csb + + .text +.csb: + move.l (sp)+,a0 ! case descriptor + move (sp)+,d0 ! index + move.l (a0)+,a1 ! default jump address + move.w (a0)+,d1 ! # entries + beq 2f +1: + cmp (a0)+,d0 + beq 3f + tst.l (a0)+ ! skip jump address + sub #1,d1 + bgt 1b +2: + move.l a1,d1 ! default jump address + bne 4f + move.w #ECASE,-(sp) + jmp .fat +3: + move.l (a0)+,a1 ! get jump address +4: + jmp (a1) diff --git a/mach/m68k2/libem/cuu.s b/mach/m68k2/libem/cuu.s new file mode 100644 index 00000000..d1db8f5c --- /dev/null +++ b/mach/m68k2/libem/cuu.s @@ -0,0 +1,21 @@ +.define .ciu +.define .cui +.define .cuu + + .text +.ciu: +.cui: +.cuu: + move.l (sp)+,a0 ! return address + move (sp)+,d0 ! destination size + sub (sp)+,d0 + bgt 1f + sub d0,sp + jmp (a0) +1: + asr #1,d0 +2: + clr -(sp) + sub #1,d0 + bgt 2b + jmp (a0) diff --git a/mach/m68k2/libem/cvf.s b/mach/m68k2/libem/cvf.s new file mode 100644 index 00000000..d0b081dd --- /dev/null +++ b/mach/m68k2/libem/cvf.s @@ -0,0 +1,15 @@ +.define .cfi,.cif,.cfu,.cuf,.cff + + .text + + ! this is a dummy float conversion routine +.cfi: +.cif: +.cfu: +.cuf: +.cff: + move.l (sp)+,a0 ! return address + move (sp)+,d0 ! destination size + sub (sp)+,d0 ! diff. in sizes + sub d0,sp + jmp (a0) diff --git a/mach/m68k2/libem/dia.s b/mach/m68k2/libem/dia.s new file mode 100644 index 00000000..849f29e2 --- /dev/null +++ b/mach/m68k2/libem/dia.s @@ -0,0 +1,37 @@ +.define .diagnos + +space = 040 +del = 0177 + + .text +.diagnos: + move.w hol0,-(sp) + move.l hol0+FILN_AD,d2 + beq 1f + move.l d2,a0 + move.l #40,d0 +3: + move.b (a0)+,d1 + beq 2f + cmp.b #del,d1 + bge 1f + cmp.b #space,d1 + blt 1f + sub #1,d0 + bgt 3b + clr.b (a1) +2: + move.l d2,-(sp) + pea fmt + jsr _printf + add #10,sp + jmp _printf + +1: + move.l #unknwn,d2 + bra 2b + + .data +fmt: .asciz "%s, line %d: " +unknwn: .asciz "unknown file" +.align 2 diff --git a/mach/m68k2/libem/dvi.s b/mach/m68k2/libem/dvi.s new file mode 100644 index 00000000..508f6670 --- /dev/null +++ b/mach/m68k2/libem/dvi.s @@ -0,0 +1,38 @@ +.define .dvi + + ! signed long divide + .text +.dvi: + move.l (sp)+,a0 ! return address + move.l (sp)+,d0 + move.l (sp)+,d1 + move.l d3,-(sp) ! save d3 and d4 + move.l d4,-(sp) + clr.l d4 + tst.l d0 ! divisor + bpl 1f + neg.l d0 + not d4 +1: + tst.l d1 ! dividend + bpl 2f + neg.l d1 + not d4 + swap d4 + not d4 + swap d4 +2: + move.l d1,-(sp) + move.l d0,-(sp) + jsr .dvu + tst d4 + beq 5f + neg.l d1 ! quotient +5: + tst.l d4 + bpl 6f + neg.l d2 ! remainder +6: + move.l (sp)+,d4 ! restore d4 and d3 + move.l (sp)+,d3 + jmp (a0) diff --git a/mach/m68k2/libem/dvu.s b/mach/m68k2/libem/dvu.s new file mode 100644 index 00000000..2c3dea8d --- /dev/null +++ b/mach/m68k2/libem/dvu.s @@ -0,0 +1,34 @@ +.define .dvu + + ! unsigned long divide + ! register usage: + ! : d0 divisor + ! d1 dividend + ! exit : d1 quotient + ! d2 remainder + .text +.dvu: + move.l (sp)+,a1 ! return address + move.l (sp)+,d0 + move.l (sp)+,d1 + move.l d3,-(sp) ! save d3 + tst.l d0 + bne 0f + move.l (sp)+,d3 + move.w #EIDIVZ,-(sp) + jsr .trp +0: + clr.l d2 + move.l #32,d3 +3: + lsl.l #1,d1 + roxl.l #1,d2 + cmp.l d0,d2 + blt 4f + sub.l d0,d2 + add #1,d1 +4: + sub #1,d3 + bgt 3b + move.l (sp)+,d3 + jmp (a1) diff --git a/mach/m68k2/libem/end.s b/mach/m68k2/libem/end.s new file mode 100644 index 00000000..e05364bd --- /dev/null +++ b/mach/m68k2/libem/end.s @@ -0,0 +1,14 @@ +.define endtext,enddata,endbss,_etext,_edata,_end + + .text + .align 2 +endtext: +_etext: + .data + .align 2 +enddata: +_edata: + .bss + .align 2 +endbss: +_end: diff --git a/mach/m68k2/libem/exg.s b/mach/m68k2/libem/exg.s new file mode 100644 index 00000000..042f80fb --- /dev/null +++ b/mach/m68k2/libem/exg.s @@ -0,0 +1,23 @@ +.define .exg + + ! d0 : exchange size in bytes + .text +.exg: + move.l (sp)+,d2 ! return address + move.l sp,a1 + sub.w d0,sp + move.l sp,a0 + move.w d0,d1 +1: + move.w (a1)+,(a0)+ + sub #1,d0 + bgt 1b + move.l sp,a1 + asr #1,d1 +1: + move.w (a1)+,(a0)+ + sub #1,d1 + bgt 1b + move.l a1,sp + move.l d2,-(sp) + rts diff --git a/mach/m68k2/libem/fat.s b/mach/m68k2/libem/fat.s new file mode 100644 index 00000000..fe2e0782 --- /dev/null +++ b/mach/m68k2/libem/fat.s @@ -0,0 +1,6 @@ +.define .fat + + .text +.fat: + jsr .trp + jmp EXIT diff --git a/mach/m68k2/libem/gto.s b/mach/m68k2/libem/gto.s new file mode 100644 index 00000000..c78ca22a --- /dev/null +++ b/mach/m68k2/libem/gto.s @@ -0,0 +1,75 @@ +.define .gto +.extern .gto + +.gto: + ! nonlocal goto + ! the argument on the stack is a pointer to a GTO-descriptor containing: + ! - the new local base + ! - the new stackpointer + ! - the new program counter + ! + ! The main task of the GTO instruction is to restore the registers + ! used for local variables. It uses a word stored in each stackframe, + ! indicating how many data -and address registers the procedure of + ! that stackframe has. + + move.l (sp)+,a0 + add.l #8,a0 ! a0 now points to new local base entry + ! of the descriptor + cmp.l (a0),a6 ! GTO within same procedure? + beq noregs + move.l d0,savd0 ! gto may not destroy the return area + move.l d1,savd1 +1: + tst.l (a6) + beq err + unlk a6 + move.w (sp)+,d0 ! word indicating which regs. were saved + jsr restr + cmp.l (a0),a6 + bne 1b + move.l savd0,d0 + move.l savd1,d1 +noregs: + move.l -4(a0),sp + move.l -8(a0),a0 ! new program counter + jmp (a0) +err: + move.w #EBADGTO,-(sp) + jmp .fat + +restr: + ! restore the registers. Note that scratch register a0 may + ! not be changed here. d0 contains (8*#addr.regs + #data regs.) + ! note that registers are assigned in the order d7,d6 .. and + ! a5,a4... + + move.l (sp)+,d2 ! return address; can't use a0 here + move.w d0,d1 + and.l #7,d0 ! #data registers + asl.l #1,d0 ! * 2 + lea etabd,a1 + sub.l d0,a1 + jmp (a1) + move.l (sp)+,d3 + move.l (sp)+,d4 + move.l (sp)+,d5 + move.l (sp)+,d6 + move.l (sp)+,d7 +etabd: + and.l #070,d1 + asr.l #2,d1 ! # address registers + lea etaba,a1 + sub.l d1,a1 + jmp (a1) + move.l (sp)+,a2 + move.l (sp)+,a3 + move.l (sp)+,a4 + move.l (sp)+,a5 +etaba: + move.l d2,a1 + jmp (a1) ! return +.data +savd0: .long 0 +savd1: .long 0 +.text diff --git a/mach/m68k2/libem/inn.s b/mach/m68k2/libem/inn.s new file mode 100644 index 00000000..79d057c5 --- /dev/null +++ b/mach/m68k2/libem/inn.s @@ -0,0 +1,29 @@ +.define .inn + +! d0 : set size in bytes +! d1 : bitnumber + + .text +.inn: + move.l (sp)+,d2 ! return address + move.w (sp)+,d1 + move.l sp,a1 + add d0,a1 + move.l sp,a0 + move.l d2,-(sp) + move d1,d2 + asr #3,d2 + bchg #0,d2 + cmp d0,d2 + bcc 1f + add d2,a0 + btst d1,(a0) + beq 1f + move.l #1,d0 + bra 2f +1: + clr d0 +2: + move.l (sp)+,a0 + move.l a1,sp + jmp (a0) diff --git a/mach/m68k2/libem/los.s b/mach/m68k2/libem/los.s new file mode 100644 index 00000000..5bc40cc8 --- /dev/null +++ b/mach/m68k2/libem/los.s @@ -0,0 +1,24 @@ +.define .los + + ! d0 : # bytes + ! a0 : source address + .text +.los: + move.l (sp)+,a1 + move.w (sp)+,d0 + move.l (sp)+,a0 + cmp #1,d0 + bne 1f + clr d0 + move.b (a0),d0 + move.w d0,-(sp) + bra 3f +1: + add d0,a0 + asr #1,d0 +2: + move -(a0),-(sp) + sub #1,d0 + bgt 2b +3: + jmp (a1) diff --git a/mach/m68k2/libem/lpb.s b/mach/m68k2/libem/lpb.s new file mode 100644 index 00000000..32567735 --- /dev/null +++ b/mach/m68k2/libem/lpb.s @@ -0,0 +1,18 @@ +.define .lpb +.extern .lpb +.lpb: + ! convert local to argument base + ! should not destroy register d2 (used by lxa/lxl) + + move.l (sp)+,a1 ! return address + move.l (sp)+,a0 ! local base + move.w 4(a0),d0 ! register save word + move.w d0,d1 + and.l #7,d0 ! #data registers + and.l #070,d1 + asr.l #3,d1 ! #address registers + add.w d1,d0 + asl.l #2,d0 ! 4 * #registers + add.w #10,d0 ! reg. save word, lb, pc + add.l d0,a0 + jmp (a1) diff --git a/mach/m68k2/libem/lxa.s b/mach/m68k2/libem/lxa.s new file mode 100644 index 00000000..ff0df426 --- /dev/null +++ b/mach/m68k2/libem/lxa.s @@ -0,0 +1,18 @@ +.define .lxa +.extern .lxa +.lxa: + ! #levels (>= 0) on stack + + move.l (sp)+,a0 ! return address + move.w (sp)+,d2 + move.l a0,-(sp) + move.l a6,a0 +1: + move.l a0,-(sp) + jsr .lpb + sub #1,d2 + blt 2f + move.l (a0),a0 + bra 1b +2: + rts diff --git a/mach/m68k2/libem/lxl.s b/mach/m68k2/libem/lxl.s new file mode 100644 index 00000000..7ab2354e --- /dev/null +++ b/mach/m68k2/libem/lxl.s @@ -0,0 +1,16 @@ +.define .lxl +.extern .lxl +.lxl: + ! #levels on stack (> 0) + + move.l (sp)+,a0 ! return address + move.w (sp)+,d2 ! d2 is not destroyed by .lpb + move.l a0,-(sp) + sub.w #1,d2 + move.l a6,a0 +1: + move.l a0,-(sp) + jsr .lpb + move.l (a0),a0 + dbf d2,1b + rts ! result in a0 diff --git a/mach/m68k2/libem/mli.s b/mach/m68k2/libem/mli.s new file mode 100644 index 00000000..fdf9242c --- /dev/null +++ b/mach/m68k2/libem/mli.s @@ -0,0 +1,30 @@ +.define .mli + + + .text +.mli: + move.l (sp)+,a0 + move.l (sp)+,d1 + move.l (sp)+,d0 + move.l d5,-(sp) + clr d5 + tst.l d0 + bpl 1f + neg.l d0 + not d5 +1: + tst.l d1 + bpl 2f + neg.l d1 + not d5 +2: + move.l d0,-(sp) + move.l d1,-(sp) + jsr .mlu + tst d5 + beq 3f + neg.l d1 + negx.l d0 +3: + move.l (sp)+,d5 + jmp (a0) diff --git a/mach/m68k2/libem/mlu.s b/mach/m68k2/libem/mlu.s new file mode 100644 index 00000000..b8522da4 --- /dev/null +++ b/mach/m68k2/libem/mlu.s @@ -0,0 +1,37 @@ +.define .mlu + + ! entry : d0 multiplicand + ! d1 multiplier + ! exit : d0 high order result + ! d1 low order result + + .text +.mlu: + move.l (sp)+,a1 + move.l (sp)+,d1 + move.l (sp)+,d0 + movem.l d3/d4/d6,-(sp) + move.l d1,d3 + move.l d1,d2 + swap d2 + move.l d2,d4 + mulu d0,d1 + mulu d0,d2 + swap d0 + mulu d0,d3 + mulu d4,d0 + clr.l d6 + swap d1 + add d2,d1 + addx.l d6,d0 + add d3,d1 + addx.l d6,d0 + swap d1 + clr d2 + clr d3 + swap d2 + swap d3 + add.l d2,d0 + add.l d3,d0 + movem.l (sp)+,d3/d4/d6 + jmp (a1) diff --git a/mach/m68k2/libem/mon.s b/mach/m68k2/libem/mon.s new file mode 100644 index 00000000..dabe65a9 --- /dev/null +++ b/mach/m68k2/libem/mon.s @@ -0,0 +1,12 @@ +.define .mon + .text +.mon: + move.l (sp)+,a0 + pea fmt + jsr .diagnos + add #6,sp + jmp EXIT + + .data +fmt: .asciz "system call %d not implemented" +.align 2 diff --git a/mach/m68k2/libem/nop.s b/mach/m68k2/libem/nop.s new file mode 100644 index 00000000..f7dd9db1 --- /dev/null +++ b/mach/m68k2/libem/nop.s @@ -0,0 +1,13 @@ +.define .nop + + .text +.nop: + move.w hol0,-(sp) + pea fmt + jsr .diagnos + add #6,sp + rts + + .data +fmt: .asciz "test %d\n" +.align 2 diff --git a/mach/m68k2/libem/printf.s b/mach/m68k2/libem/printf.s new file mode 100644 index 00000000..cc79a696 --- /dev/null +++ b/mach/m68k2/libem/printf.s @@ -0,0 +1,185 @@ +.define _printn +.define _printf +.text +_putchar: + move.w #1,-(sp) + pea 7(sp) + move.w #1,-(sp) + jsr _write + add.l #8,sp + rts +_printf: + link a6,#-12 +.data +_12: + .short 28786 + .short 26990 + .short 29798 + .short 11875 + .short 0 +.text + pea 8+4(a6) + move.l (sp)+,-6(a6) +I004: + move.l 8+0(a6),-(sp) + move.l (sp),-(sp) + move.l (sp)+,a0 + add #1,a0 + move.l a0,-(sp) + move.l (sp)+,8+0(a6) + move.l (sp)+,a0 + clr d0 + move.b (a0),d0 + move.w d0,-(sp) + move.w (sp),-(sp) + move.w (sp)+,-2(a6) + move.w #37,-(sp) + move.w (sp)+,d0 + cmp (sp)+,d0 + beq I005 + move.w -2(a6),-(sp) + tst (sp)+ + beq I002 + move.w -2(a6),-(sp) + jsr _putchar + add #2,sp + jmp I004 +I005: + move.l 8+0(a6),-(sp) + move.l (sp),-(sp) + move.l (sp)+,a0 + add #1,a0 + move.l a0,-(sp) + move.l (sp)+,8+0(a6) + move.l (sp)+,a0 + clr d0 + move.b (a0),d0 + move.w d0,-(sp) + move.w (sp)+,-2(a6) + move.w -2(a6),-(sp) + move.w #100,-(sp) + move.w (sp)+,d0 + cmp (sp)+,d0 + beq I008 + move.w -2(a6),-(sp) + move.w #117,-(sp) + move.w (sp)+,d0 + cmp (sp)+,d0 + bne I007 +I008: + move.l -6(a6),-(sp) + move.l (sp)+,a0 + add #2,a0 + move.l a0,-(sp) + move.l (sp),-(sp) + move.l (sp)+,-6(a6) + move.l (sp)+,a0 + move.w -2(a0),-(sp) + move.w (sp)+,-8(a6) + move.w -2(a6),-(sp) + move.w #100,-(sp) + move.w (sp)+,d0 + cmp (sp)+,d0 + bne I009 + move.w -8(a6),-(sp) + tst (sp)+ + bge I009 + move.w #0,-(sp) + move.w -8(a6),-(sp) + move.w (sp)+,d0 + move.w (sp)+,d1 + sub d0,d1 + move.w d1,-(sp) + move.w (sp)+,-8(a6) + move.w #45,-(sp) + jsr _putchar + add #2,sp +I009: + move.w -8(a6),-(sp) + jsr _printn + add #2,sp + jmp I004 +I007: + move.w -2(a6),-(sp) + move.w #115,-(sp) + move.w (sp)+,d0 + cmp (sp)+,d0 + bne I004 + move.l -6(a6),-(sp) + move.l (sp)+,a0 + add #4,a0 + move.l a0,-(sp) + move.l (sp),-(sp) + move.l (sp)+,-6(a6) + move.l (sp)+,a0 + move.l -4(a0),-(sp) + move.l (sp)+,-12(a6) +I00c: + move.l -12(a6),-(sp) + move.l (sp),-(sp) + move.l (sp)+,a0 + add #1,a0 + move.l a0,-(sp) + move.l (sp)+,-12(a6) + move.l (sp)+,a0 + clr d0 + move.b (a0),d0 + move.w d0,-(sp) + move.w (sp),-(sp) + move.w (sp)+,-2(a6) + tst (sp)+ + beq I004 + move.w -2(a6),-(sp) + jsr _putchar + add #2,sp + jmp I00c +I002: + unlk a6 + rts +_printn: + link a6,#-2 +.data +_15: + .short 12337 + .short 12851 + .short 13365 + .short 13879 + .short 14393 + .short 0 +.text + move.w 8+0(a6),-(sp) + move.w #10,-(sp) + move.w (sp)+,d0 + clr.l d1 + move.w (sp)+,d1 + divu d0,d1 + move.w d1,-(sp) + move.w (sp),-(sp) + move.w (sp)+,-2(a6) + tst (sp)+ + beq I013 + move.w -2(a6),-(sp) + jsr _printn + add #2,sp +I013: + pea _15 + move.w 8+0(a6),-(sp) + move.w #10,-(sp) + move.w (sp)+,d0 + clr.l d1 + move.w (sp)+,d1 + divu d0,d1 + swap d1 + move.w d1,-(sp) + move.w (sp)+,d0 + ext.l d0 + add.l (sp)+,d0 + move.l d0,-(sp) + move.l (sp)+,a0 + clr d0 + move.b (a0),d0 + move.w d0,-(sp) + jsr _putchar + add #2,sp + unlk a6 + rts diff --git a/mach/m68k2/libem/rck.s b/mach/m68k2/libem/rck.s new file mode 100644 index 00000000..52af333a --- /dev/null +++ b/mach/m68k2/libem/rck.s @@ -0,0 +1,16 @@ +.define .rck + + .text +.rck: + move.l (sp)+,a1 + move.l (sp)+,a0 ! descriptor address + move.w (sp),d0 + cmp (a0),d0 + blt 1f + cmp 2(a0),d0 + ble 2f +1: + move.w #ERANGE,-(sp) + jsr .trp +2: + jmp (a1) diff --git a/mach/m68k2/libem/ret.s b/mach/m68k2/libem/ret.s new file mode 100644 index 00000000..a1b394de --- /dev/null +++ b/mach/m68k2/libem/ret.s @@ -0,0 +1,25 @@ +.define .ret + + .text +.ret: + beq 3f + cmp #2,d0 + bne 1f + move (sp)+,d0 + bra 3f +1: + cmp #4,d0 + bne 2f + move.l (sp)+,d0 + bra 3f +2: + cmp #8,d0 + bne 4f + move.l (sp)+,d0 + move.l (sp)+,d1 +3: + unlk a6 + rts +4: + move.w #EILLINS,-(sp) + jmp .fat diff --git a/mach/m68k2/libem/set.s b/mach/m68k2/libem/set.s new file mode 100644 index 00000000..7d32c69d --- /dev/null +++ b/mach/m68k2/libem/set.s @@ -0,0 +1,27 @@ +.define .set + + ! d0 : setsize in bytes + ! d1 : bitnumber + .text +.set: + move.l (sp)+,a0 + move.w (sp)+,d1 + move.w d0,d2 + asr #1,d2 +1: + clr -(sp) + sub #1,d2 + bgt 1b + move.l sp,a1 ! set base + move.w d1,d2 + asr #3,d2 + bchg #0,d2 + cmp d0,d2 + bcs 1f + move.w #ESET,-(sp) + move.l a0,-(sp) + jmp .trp +1: + add d2,a1 + bset d1,(a1) + jmp (a0) diff --git a/mach/m68k2/libem/shp.s b/mach/m68k2/libem/shp.s new file mode 100644 index 00000000..88421e45 --- /dev/null +++ b/mach/m68k2/libem/shp.s @@ -0,0 +1,24 @@ +.define .strhp + + .text +.strhp: + move.l (sp)+,a0 + move.l (sp)+,d0 ! heap pointer + move.l d0,.reghp + cmp.l .limhp,d0 + bmi 1f + add.l #0x400,d0 + and.l #~0x3ff,d0 + move.l d0,.limhp + move.l a0,-(sp) + move.l d0,-(sp) + jsr _brk + tst.l (sp)+ + move.l (sp)+,a0 + tst.w d0 + bne 2f +1: + jmp (a0) +2: + move.w #EHEAP,-(sp) + jmp .fat diff --git a/mach/m68k2/libem/sig.s b/mach/m68k2/libem/sig.s new file mode 100644 index 00000000..3fa3e0bc --- /dev/null +++ b/mach/m68k2/libem/sig.s @@ -0,0 +1,9 @@ +.define .sig + + .text +.sig: + move.l (sp)+,a0 + move.l (sp)+,a1 ! trap pc + move.l .trppc,-(sp) + move.l a1,.trppc + jmp (a0) diff --git a/mach/m68k2/libem/sts.s b/mach/m68k2/libem/sts.s new file mode 100644 index 00000000..937c9304 --- /dev/null +++ b/mach/m68k2/libem/sts.s @@ -0,0 +1,22 @@ +.define .sts + + ! d0 : # bytes + ! a0 : destination address + .text +.sts: + move.l (sp)+,a1 + move.w (sp)+,d0 + move.l (sp)+,a0 + cmp #1,d0 + bne 1f + move.w (sp)+,d0 + move.b d0,(a0) + bra 3f +1: + asr #1,d0 +2: + move.w (sp)+,(a0)+ + sub #1,d0 + bgt 2b +3: + jmp (a1) diff --git a/mach/m68k2/libem/trp.s b/mach/m68k2/libem/trp.s new file mode 100644 index 00000000..36045db4 --- /dev/null +++ b/mach/m68k2/libem/trp.s @@ -0,0 +1,36 @@ +.define .trp + + .text +.trp: + move.l (sp)+,a1 ! return address + move.w (sp)+,d0 ! error number + move.l a1,-(sp) + move.w d0,-(sp) + cmp #16,d0 + bcc 1f + cmp #8,d0 + bcc 4f + btst d0,.trpim + bra 5f +4: + btst d0,.trpim+1 +5: + bne 3f +1: + move.l .trppc,a0 + move.l a0,d0 + beq 9f + clr.l .trppc + jsr (a0) +3: + add #2,sp + rts +9: + pea fmt + jsr .diagnos + jmp EXIT + + .data +.rettrp: .long 0 +fmt: .asciz "trap %d called\n" +.align 2 diff --git a/mach/m68k2/libpc/Makefile b/mach/m68k2/libpc/Makefile new file mode 100644 index 00000000..37a8e880 --- /dev/null +++ b/mach/m68k2/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/m68k2/libpc/compmodule b/mach/m68k2/libpc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k2/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k2/libsys/LIST b/mach/m68k2/libsys/LIST new file mode 100644 index 00000000..4fccdc16 --- /dev/null +++ b/mach/m68k2/libsys/LIST @@ -0,0 +1,45 @@ +tail_mon.a +exit.s +_exit.s +access.s +alarm.s +chdir.s +chmod.s +chroot.s +close.s +creat.s +execl.s +execve.s +fork.s +getegid.s +getgid.s +getpid.s +getuid.s +stty.s +gtty.s +ioctl.s +kill.s +link.s +lseek.s +mknod.s +mount.s +nice.s +open.s +pause.s +read.s +setgid.s +setuid.s +stat.s +stime.s +sync.s +time.s +times.s +umount.s +unlink.s +write.s +brk.s +wait.s +fstat.s +signal.s +call.s +cleanup.s diff --git a/mach/m68k2/libsys/Makefile b/mach/m68k2/libsys/Makefile new file mode 100644 index 00000000..5cc6f2ca --- /dev/null +++ b/mach/m68k2/libsys/Makefile @@ -0,0 +1,11 @@ +# $Header$ +install: + ../../install tail_mon.a tail_mon + +clean : + +opr : + make pr | opr + +pr: + @ar pv tail_mon.a diff --git a/mach/m68k2/libsys/_exit.s b/mach/m68k2/libsys/_exit.s new file mode 100644 index 00000000..398c9390 --- /dev/null +++ b/mach/m68k2/libsys/_exit.s @@ -0,0 +1,6 @@ +.define __exit +.extern __exit +.text +__exit: move.w #0x1,d0 + move.w 4(sp),a0 + trap #0 diff --git a/mach/m68k2/libsys/access.s b/mach/m68k2/libsys/access.s new file mode 100644 index 00000000..fdceffbf --- /dev/null +++ b/mach/m68k2/libsys/access.s @@ -0,0 +1,8 @@ +.define _access +.extern _access +.text +_access: move.w #0x21,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k2/libsys/alarm.s b/mach/m68k2/libsys/alarm.s new file mode 100644 index 00000000..98781a70 --- /dev/null +++ b/mach/m68k2/libsys/alarm.s @@ -0,0 +1,9 @@ +.define _alarm +.extern _alarm +.text +_alarm: clr.l d0 + move.w 4(sp),d0 + move.l d0,a0 + move.w #0x1B,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/brk.s b/mach/m68k2/libsys/brk.s new file mode 100644 index 00000000..0d33d073 --- /dev/null +++ b/mach/m68k2/libsys/brk.s @@ -0,0 +1,26 @@ +.define _brk +.define _sbrk +.extern _brk +.extern _sbrk +.text +_sbrk: move.l nd,a0 + add.w 4(sp),a0 + move.w #0x11,d0 + trap #0 + bcs lcerror + move.l nd,d0 + move.l d0,a0 + add.w 4(sp),a0 + move.l a0,nd + rts +lcerror: jmp cerror +_brk: move.w #0x11,d0 + move.l 4(sp),a0 + trap #0 + bcs lcerror + move.l 4(sp),nd + clr.l d0 + rts +.data +nd: .long endbss +.text diff --git a/mach/m68k2/libsys/call.s b/mach/m68k2/libsys/call.s new file mode 100644 index 00000000..846fb779 --- /dev/null +++ b/mach/m68k2/libsys/call.s @@ -0,0 +1,28 @@ +.define call +.define callc +.define calle +.define cerror +.define _errno +.extern call +.extern callc +.extern calle +.extern cerror +.extern _errno +.text +call: trap #0 + bcs cerror + rts +callc: + trap #0 + bcs cerror + clr.l d0 + rts +calle: + trap #0 +cerror: + move.w d0,_errno + move.l #-1,d0 + rts +.bss +_errno: .space 4 +.text diff --git a/mach/m68k2/libsys/chdir.s b/mach/m68k2/libsys/chdir.s new file mode 100644 index 00000000..d03224ae --- /dev/null +++ b/mach/m68k2/libsys/chdir.s @@ -0,0 +1,6 @@ +.define _chdir +.extern _chdir +.text +_chdir: move.w #0xC,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/chmod.s b/mach/m68k2/libsys/chmod.s new file mode 100644 index 00000000..6c86e3a2 --- /dev/null +++ b/mach/m68k2/libsys/chmod.s @@ -0,0 +1,8 @@ +.define _chmod +.extern _chmod +.text +_chmod: move.w #0xF,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k2/libsys/chroot.s b/mach/m68k2/libsys/chroot.s new file mode 100644 index 00000000..ebf9f6a4 --- /dev/null +++ b/mach/m68k2/libsys/chroot.s @@ -0,0 +1,6 @@ +.define _chroot +.extern _chroot +.text +_chroot: move.w #0x3D,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/cleanup.s b/mach/m68k2/libsys/cleanup.s new file mode 100644 index 00000000..7df1860b --- /dev/null +++ b/mach/m68k2/libsys/cleanup.s @@ -0,0 +1,8 @@ +.define __cleanup +.extern __cleanup +.text +__cleanup: +tst.b -40(sp) +link a6,#-0 +unlk a6 +rts diff --git a/mach/m68k2/libsys/close.s b/mach/m68k2/libsys/close.s new file mode 100644 index 00000000..add7e701 --- /dev/null +++ b/mach/m68k2/libsys/close.s @@ -0,0 +1,6 @@ +.define _close +.extern _close +.text +_close: move.w #0x6,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/creat.s b/mach/m68k2/libsys/creat.s new file mode 100644 index 00000000..73e7db84 --- /dev/null +++ b/mach/m68k2/libsys/creat.s @@ -0,0 +1,8 @@ +.define _creat +.extern _creat +.text +_creat: move.w #0x8,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp call diff --git a/mach/m68k2/libsys/execl.s b/mach/m68k2/libsys/execl.s new file mode 100644 index 00000000..21e03dc9 --- /dev/null +++ b/mach/m68k2/libsys/execl.s @@ -0,0 +1,11 @@ +.define _execl +.extern _execl +_execl: link a6,#0 + tst.b -132(sp) + move.l _environ,-(sp) + pea 12(sp) + move.l 8(a6),-(sp) + jsr _execve + add.l #0xC,sp + unlk a6 + rts diff --git a/mach/m68k2/libsys/execve.s b/mach/m68k2/libsys/execve.s new file mode 100644 index 00000000..2b2de5f8 --- /dev/null +++ b/mach/m68k2/libsys/execve.s @@ -0,0 +1,8 @@ +.define _execve +.extern _execve +.text +_execve: move.w #0x3B,d0 + move.l 4(sp),a0 + move.l 8(sp),d1 + move.l 12(sp),a1 + jmp calle diff --git a/mach/m68k2/libsys/exit.s b/mach/m68k2/libsys/exit.s new file mode 100644 index 00000000..d766750e --- /dev/null +++ b/mach/m68k2/libsys/exit.s @@ -0,0 +1,12 @@ +.define _exit +.extern _exit +.text +_exit: +tst.b -40(sp) +link a6,#-0 +jsr __cleanup +move.w 8(a6),-(sp) +jsr __exit +add.l #2,sp +unlk a6 +rts diff --git a/mach/m68k2/libsys/fork.s b/mach/m68k2/libsys/fork.s new file mode 100644 index 00000000..0401e631 --- /dev/null +++ b/mach/m68k2/libsys/fork.s @@ -0,0 +1,13 @@ +.define _fork +.extern _fork +.text +_fork: move.w #0x2,d0 + trap #0 + bra 1f + bcc 2f + jmp cerror +1: + !move.l d0,p_uid + clr.l d0 +2: + rts diff --git a/mach/m68k2/libsys/fstat.s b/mach/m68k2/libsys/fstat.s new file mode 100644 index 00000000..1dd3d66c --- /dev/null +++ b/mach/m68k2/libsys/fstat.s @@ -0,0 +1,6 @@ +.define _fstat +.extern _fstat +_fstat: move.w #0x1C,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + jmp callc diff --git a/mach/m68k2/libsys/getegid.s b/mach/m68k2/libsys/getegid.s new file mode 100644 index 00000000..b4da40c1 --- /dev/null +++ b/mach/m68k2/libsys/getegid.s @@ -0,0 +1,7 @@ +.define _getegid +.extern _getegid +.text +_getegid: move.w #0x2F,d0 + trap #0 + move.l d1,d0 + rts diff --git a/mach/m68k2/libsys/getgid.s b/mach/m68k2/libsys/getgid.s new file mode 100644 index 00000000..3ef4def3 --- /dev/null +++ b/mach/m68k2/libsys/getgid.s @@ -0,0 +1,6 @@ +.define _getgid +.extern _getgid +.text +_getgid: move.w #0x2F,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/getpid.s b/mach/m68k2/libsys/getpid.s new file mode 100644 index 00000000..1bf2aba7 --- /dev/null +++ b/mach/m68k2/libsys/getpid.s @@ -0,0 +1,6 @@ +.define _getpid +.extern _getpid +.text +_getpid: move.w #0x14,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/getuid.s b/mach/m68k2/libsys/getuid.s new file mode 100644 index 00000000..d0e15a1b --- /dev/null +++ b/mach/m68k2/libsys/getuid.s @@ -0,0 +1,6 @@ +.define _getuid +.extern _getuid +.text +_getuid: move.w #0x18,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/gtty.s b/mach/m68k2/libsys/gtty.s new file mode 100644 index 00000000..ee9f096c --- /dev/null +++ b/mach/m68k2/libsys/gtty.s @@ -0,0 +1,13 @@ +.define _gtty +.extern _gtty +.text +_gtty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29704,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/m68k2/libsys/head_em.s b/mach/m68k2/libsys/head_em.s new file mode 100644 index 00000000..7c7eb12b --- /dev/null +++ b/mach/m68k2/libsys/head_em.s @@ -0,0 +1,86 @@ +.define CERASE,CKILL,CSTOP,CSTART +.define .lino,.filn + +.define F_DUM,EXIT + +.define begtext,begdata,begbss +.define EARRAY,ERANGE,ESET,EIDIVZ,EHEAP,EILLINS,ECASE,EBADGTO +.define hol0,.reghp,.limhp,.trpim,.trppc +.define LINO_AD,FILN_AD + +! EM runtime start-off for the Bleasdale 68000 system + + +CERASE = 010 +CKILL = 030 +CSTART = 021 +CSTOP = 023 +F_DUM = 0 + + +LINO_AD = 0 +FILN_AD = 4 + +EARRAY = 0 +ERANGE = 1 +ESET = 2 +EIDIVZ = 6 +EHEAP = 17 +EILLINS = 18 +ECASE = 20 +EBADGTO = 27 + +.base 0x20000 + .text +begtext: + ! Bleasdale puts the argument and environment vectors + ! themselves on top of the stack, instead of POINTERS + ! to these vectors. We get things right here. + move.l 4(sp),a0 + clr.l -4(a0) + move.l sp,a0 + sub.l #8,sp + move.l (a0),(sp) + add.l #4,a0 + move.l a0,4(sp) +1: + tst.l (a0)+ + bne 1b + move.l 4(sp),a1 + cmp.l (a1),a0 + blt 2f + sub.l #4,a0 +2: + move.l a0,8(sp) + + ! Now the stack contains an argc (4 bytes), argv-pointer and + ! envp pointer. + + add.l #2,sp !convert argc from 4-byte to 2-byte + pea endbss + jsr _brk + add.l #4,sp + jsr _m_a_i_n + add #010,sp +EXIT: + jsr __exit + + .data +begdata: +hol0: +.lino: + .short 0,0 ! lino +.filn: + .long 0 ! filn +.reghp: + .long endbss +.limhp: + .long endbss +.trppc: + .long 0 +.trpim: + .short 0 + + + .bss +begbss: diff --git a/mach/m68k2/libsys/ioctl.s b/mach/m68k2/libsys/ioctl.s new file mode 100644 index 00000000..75d16214 --- /dev/null +++ b/mach/m68k2/libsys/ioctl.s @@ -0,0 +1,9 @@ +.define _ioctl +.extern _ioctl +.text +_ioctl: move.w #0x36,d0 + move.w 4(sp),a0 + move.w 6(sp),d1 + ext.l d1 + move.l 8(sp),a1 + jmp callc diff --git a/mach/m68k2/libsys/kill.s b/mach/m68k2/libsys/kill.s new file mode 100644 index 00000000..c5c4038c --- /dev/null +++ b/mach/m68k2/libsys/kill.s @@ -0,0 +1,8 @@ +.define _kill +.extern _kill +.text +_kill: move.w #0x25,d0 + move.w 4(sp),a0 + move.w 6(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k2/libsys/link.s b/mach/m68k2/libsys/link.s new file mode 100644 index 00000000..161ca6d1 --- /dev/null +++ b/mach/m68k2/libsys/link.s @@ -0,0 +1,8 @@ +.define _link +.extern _link +.text +_link: move.w #0x9,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k2/libsys/lseek.s b/mach/m68k2/libsys/lseek.s new file mode 100644 index 00000000..96f670e7 --- /dev/null +++ b/mach/m68k2/libsys/lseek.s @@ -0,0 +1,8 @@ +.define _lseek +.extern _lseek +.text +_lseek: move.w #0x13,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k2/libsys/mknod.s b/mach/m68k2/libsys/mknod.s new file mode 100644 index 00000000..21d86ad0 --- /dev/null +++ b/mach/m68k2/libsys/mknod.s @@ -0,0 +1,9 @@ +.define _mknod +.extern _mknod +.text +_mknod: move.w #0xE,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + move.w 10(sp),a1 + jmp callc diff --git a/mach/m68k2/libsys/mount.s b/mach/m68k2/libsys/mount.s new file mode 100644 index 00000000..b7d37737 --- /dev/null +++ b/mach/m68k2/libsys/mount.s @@ -0,0 +1,9 @@ + +.define _mount +.extern _mount +.text +_mount: move.w #0x15,d0 + move.l 4(sp),a0 + move.l 8(sp),d1 + move.l 12(sp),a1 + jmp callc diff --git a/mach/m68k2/libsys/nice.s b/mach/m68k2/libsys/nice.s new file mode 100644 index 00000000..4929617b --- /dev/null +++ b/mach/m68k2/libsys/nice.s @@ -0,0 +1,6 @@ +.define _nice +.extern _nice +.text +_nice: move.w #0x22,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/open.s b/mach/m68k2/libsys/open.s new file mode 100644 index 00000000..04b3b505 --- /dev/null +++ b/mach/m68k2/libsys/open.s @@ -0,0 +1,8 @@ +.define _open +.extern _open +.text +_open: move.w #0x5,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp call diff --git a/mach/m68k2/libsys/pause.s b/mach/m68k2/libsys/pause.s new file mode 100644 index 00000000..53b99d73 --- /dev/null +++ b/mach/m68k2/libsys/pause.s @@ -0,0 +1,6 @@ +.define _pause +.extern _pause +.text +_pause: move.w #0x1D,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/read.s b/mach/m68k2/libsys/read.s new file mode 100644 index 00000000..a5e0449a --- /dev/null +++ b/mach/m68k2/libsys/read.s @@ -0,0 +1,8 @@ +.define _read +.extern _read +.text +_read: move.w #0x3,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k2/libsys/setgid.s b/mach/m68k2/libsys/setgid.s new file mode 100644 index 00000000..5ad03004 --- /dev/null +++ b/mach/m68k2/libsys/setgid.s @@ -0,0 +1,6 @@ +.define _setgid +.extern _setgid +.text +_setgid: move.w #0x2E,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/setuid.s b/mach/m68k2/libsys/setuid.s new file mode 100644 index 00000000..94cc45ef --- /dev/null +++ b/mach/m68k2/libsys/setuid.s @@ -0,0 +1,6 @@ +.define _setuid +.extern _setuid +.text +_setuid: move.w #0x17,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/signal.s b/mach/m68k2/libsys/signal.s new file mode 100644 index 00000000..8f18c1f8 --- /dev/null +++ b/mach/m68k2/libsys/signal.s @@ -0,0 +1,49 @@ +.define _signal +.extern _signal +NSIG=32 +_signal: + move.w 4(sp), d0 + ext.l d0 + cmp.l #NSIG,d0 + bcc 1f + move.l 6(sp),d1 + move.l d0,a0 + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a1 + move.l d1,(a0) + beq 2f + btst #0,d1 + bne 2f + move.l #enter,d1 +2: + move.l d0,a0 + move.w #0x30,d0 + trap #0 + bcs 3f + btst #0,d0 + bne 4f + move.l a1,d0 +4: + rts +1: + move.l #22,d0 +3: + jmp cerror + +enter: + movem.l d0/d1/a0/a1,-(sp) + move.l 16(sp),a0 + move.l a0,-(sp) + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a0 + jsr (a0) + add.l #4,sp + movem.l (sp)+,d0/d1/a0/a1 + add.l #4,sp + rtr +.bss +dvect: .space 4*NSIG diff --git a/mach/m68k2/libsys/stat.s b/mach/m68k2/libsys/stat.s new file mode 100644 index 00000000..304c38b1 --- /dev/null +++ b/mach/m68k2/libsys/stat.s @@ -0,0 +1,8 @@ +.define _stat +.extern _stat +.text +_stat: move.w #0x12,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k2/libsys/stime.s b/mach/m68k2/libsys/stime.s new file mode 100644 index 00000000..bac6386d --- /dev/null +++ b/mach/m68k2/libsys/stime.s @@ -0,0 +1,11 @@ +.define _stime +.extern _stime +.text +_stime: move.w #0x19,d0 + move.l 4(sp),a0 + move.l (a0),a0 + trap #0 + bcs 1f + rts +1: + jmp cerror diff --git a/mach/m68k2/libsys/stty.s b/mach/m68k2/libsys/stty.s new file mode 100644 index 00000000..46a497cd --- /dev/null +++ b/mach/m68k2/libsys/stty.s @@ -0,0 +1,13 @@ +.define _stty +.extern _stty +.text +_stty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29705,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/m68k2/libsys/sync.s b/mach/m68k2/libsys/sync.s new file mode 100644 index 00000000..3c38a8ad --- /dev/null +++ b/mach/m68k2/libsys/sync.s @@ -0,0 +1,6 @@ +.define _sync +.extern _sync +.text +_sync: move.w #0x24,d0 + trap #0 + rts diff --git a/mach/m68k2/libsys/time.s b/mach/m68k2/libsys/time.s new file mode 100644 index 00000000..87b9d8bd --- /dev/null +++ b/mach/m68k2/libsys/time.s @@ -0,0 +1,11 @@ +.define _time +.extern _time +.text +_time: move.w #0xD,d0 + trap #0 + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.l d0,(a0) +1: + rts diff --git a/mach/m68k2/libsys/times.s b/mach/m68k2/libsys/times.s new file mode 100644 index 00000000..002f63be --- /dev/null +++ b/mach/m68k2/libsys/times.s @@ -0,0 +1,7 @@ +.define _times +.extern _times +.text +_times: move.w #0x2B,d0 + move.w 4(sp),a0 + trap #0 + rts diff --git a/mach/m68k2/libsys/umount.s b/mach/m68k2/libsys/umount.s new file mode 100644 index 00000000..59354ee9 --- /dev/null +++ b/mach/m68k2/libsys/umount.s @@ -0,0 +1,6 @@ +.define _umount +.extern _umount +.text +_umount: move.w #0x16,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/unlink.s b/mach/m68k2/libsys/unlink.s new file mode 100644 index 00000000..99e856a5 --- /dev/null +++ b/mach/m68k2/libsys/unlink.s @@ -0,0 +1,6 @@ +.define _unlink +.extern _unlink +.text +_unlink: move.w #0xA,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k2/libsys/wait.s b/mach/m68k2/libsys/wait.s new file mode 100644 index 00000000..a0ea1a5e --- /dev/null +++ b/mach/m68k2/libsys/wait.s @@ -0,0 +1,12 @@ +.define _wait +.extern _wait +_wait: move.w #0x7,d0 + move.l 4(sp),a0 + trap #0 + bcs cerror + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.w d1,(a0) +1: + rts diff --git a/mach/m68k2/libsys/write.s b/mach/m68k2/libsys/write.s new file mode 100644 index 00000000..192d7adb --- /dev/null +++ b/mach/m68k2/libsys/write.s @@ -0,0 +1,8 @@ +.define _write +.extern _write +.text +_write: move.w #0x4,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k2/ncg/Makefile b/mach/m68k2/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/m68k2/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/m68k4/Action b/mach/m68k4/Action new file mode 100644 index 00000000..d0b3e384 --- /dev/null +++ b/mach/m68k4/Action @@ -0,0 +1,13 @@ +name "M68000 4-4 backend" +dir cg +end +lib +name "M68000 4-4 C libraries" +dir libcc +end +name "M68000 4-4 EM library" +dir libem +end +name "M68000 4-4 Pascal library" +dir libpc +end diff --git a/mach/m68k4/libbc/Makefile b/mach/m68k4/libbc/Makefile new file mode 100644 index 00000000..6428b15d --- /dev/null +++ b/mach/m68k4/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=m68k4" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/m68k4/libbc/compmodule b/mach/m68k4/libbc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k4/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k4/libcc/Makefile b/mach/m68k4/libcc/Makefile new file mode 100644 index 00000000..c7f69bea --- /dev/null +++ b/mach/m68k4/libcc/Makefile @@ -0,0 +1,37 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=m68k4" "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 diff --git a/mach/m68k4/libcc/compmodule b/mach/m68k4/libcc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k4/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k4/libem/LIST b/mach/m68k4/libem/LIST new file mode 100644 index 00000000..04206407 --- /dev/null +++ b/mach/m68k4/libem/LIST @@ -0,0 +1,33 @@ +tail_em.rt +ari.s +ara.s +cvf.s +cii.s +cmi.s +cmp.s +cmu.s +csa.s +csb.s +cuu.s +exg.s +inn.s +lfr.s +los.s +rck.s +ret.s +set.s +sts.s +nop.s +mon.s +dvi.s +mli.s +mlu.s +shp.s +sig.s +cms.s +fat.s +trp.s +dia.s +printf.s +dvu.s +sav.s diff --git a/mach/m68k4/libem/aciaio.s b/mach/m68k4/libem/aciaio.s new file mode 100644 index 00000000..eabc9a63 --- /dev/null +++ b/mach/m68k4/libem/aciaio.s @@ -0,0 +1,33 @@ +.define .outch1,.outch2,.inch1,.inch2 + + ! a0,d4 used + ! character in d1 + + .text +.inch1: + move.l #acia1,a0 + bra .inch +.inch2: + move.l #acia2,a0 +.inch: + move.b (a0),d1 + asr #1,d1 + bcc .inch + move.b 2(a0),d1 + and #0x7f,d1 + rts + +.outch1: + move.l #acia1,a0 + bra .outch +.outch2: + move.l #acia2,a0 +.outch: + move.b (a0),d4 + asr #2,d4 + bcc .outch + move.b d1,2(a0) + rts + + +.align 2 diff --git a/mach/m68k4/libem/ara.s b/mach/m68k4/libem/ara.s new file mode 100644 index 00000000..24869056 --- /dev/null +++ b/mach/m68k4/libem/ara.s @@ -0,0 +1,103 @@ +.define .sar +.define .lar +.define .aar + + !register usage: + ! a0 : descriptor address + ! d0 : index + ! a1 : base address + .text +.aar: + movem.l d0/d1/a0/a1,.savreg + move.l (sp)+,.retara ! return address + move.l (sp)+,a0 ! descriptor address + move.l (sp)+,d0 ! index + move.l (sp)+,a1 ! base address + sub.l (a0),d0 ! index - lower bound : relative index + move.l 8(a0),-(sp) ! # bytes / element + move.l d0,-(sp) + jsr .mlu + add.l d1,a1 ! address of element + move.l a1,-(sp) ! returned on stack + move.l .retara,-(sp) + movem.l d0/d1/a0/a1,.savreg + rts + + +.lar: + ! register usage: like .aar + ! d2 : # bytes / element + + movem.l d0/d1/d2/a0/a1,.savreg + move.l (sp)+,.retara ! return address + move.l (sp)+,a0 + move.l (sp)+,d0 + move.l (sp)+,a1 + sub.l (a0),d0 + move.l 8(a0),d2 ! # bytes / element + move.l d0,-(sp) + move.l d2,-(sp) + jsr .mlu + add.l d1,a1 ! address of element + add.l d2,a1 ! a1++ because of predecrement + clr.l d1 !?nodig? + asr #1,d2 + bne 3f + move.b -(a1),d1 ! 1 byte element + move.l d1,-(sp) + bra 5f +3: + asr #1,d2 + bne 4f + move.w -(a1),d1 ! 2 byte element + move.l d1,-(sp) + bra 5f +4: + sub.l #1,d2 +1: + move.l -(a1),-(sp) ! 4n byte element (n = 1,2,...) + dbf d2,1b +5: + move.l .retara,-(sp) + movem.l .savreg,d0/d1/d2/a0/a1 + rts + + +.sar: + !register usage: same as lar + + movem.l d0/d1/a0/a1,.savreg + move.l (sp)+,.retara + move.l (sp)+,a0 + move.l (sp)+,d0 + move.l (sp)+,a1 + sub.l (a0),d0 + move.l 8(a0),d2 ! # bytes / element + move.l d0,-(sp) + move.l d2,-(sp) + jsr .mlu + add.l d1,a1 + clr.l d1 !?nodig? + asr #1,d2 + bne 3f + move.l (sp)+,d1 + move.b d1,(a1) ! 1 byte element + bra 4f +3: + asr #1,d2 + bne 5f + move.l (sp)+,d1 + move.w d1,(a1) ! 2 byte element + bra 4f +5: + sub.l #1,d2 +1: + move.l (sp)+,(a1)+ ! 4n byte element (n = 1,2,...) + dbf d2,1b +4: + move.l .retara,-(sp) + movem.l .savreg,d0/d1/a0/a1 + rts +.data +.retara: .long 0 +.align 2 diff --git a/mach/m68k4/libem/ari.s b/mach/m68k4/libem/ari.s new file mode 100644 index 00000000..19d64260 --- /dev/null +++ b/mach/m68k4/libem/ari.s @@ -0,0 +1,36 @@ +.define .sari +.define .lari +.define .aari + + .text +.aari: + move.l (sp)+,.retari ! return address + cmp.l #4, (sp)+ ! size of descriptor elements + bne 9f + jsr .aar + move.l .retari,-(sp) + rts + + +.lari: + move.l (sp)+,.retari ! return address + cmp.l #4, (sp)+ ! size of descriptor elements + bne 9f + jsr .lar + move.l .retari,-(sp) + rts +9: + move.w #EILLINS,-(sp) + jmp .fat + + +.sari: + move.l (sp)+,.retari ! return address + cmp.l #4, (sp)+ ! size of descriptor elements + bne 9b + jsr .sar + move.l .retari,-(sp) + rts +.data +.retari: .long 0 +.align 2 diff --git a/mach/m68k4/libem/cii.s b/mach/m68k4/libem/cii.s new file mode 100644 index 00000000..fc827aa5 --- /dev/null +++ b/mach/m68k4/libem/cii.s @@ -0,0 +1,24 @@ +.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) + dbf d0,2b +3: + move.l a0,-(sp) + movem.l .savreg,a0/d0/d1 + rts +.align 2 diff --git a/mach/m68k4/libem/cmi.s b/mach/m68k4/libem/cmi.s new file mode 100644 index 00000000..79616ba5 --- /dev/null +++ b/mach/m68k4/libem/cmi.s @@ -0,0 +1,22 @@ +.define .cmi, .cmi_ + + ! NUM == 4 + ! result in d1 + .text +.cmi: +.cmi_: + move.l (sp)+,.savret + move.l d0,.savd0 + move.l #1,d1 + move.l (sp)+,d0 + cmp.l (sp)+,d0 + bne 1f + clr.l d1 + 1: + ble 2f + neg.l d1 + 2: + move.l .savd0,d0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/cmp.s b/mach/m68k4/libem/cmp.s new file mode 100644 index 00000000..61bdabba --- /dev/null +++ b/mach/m68k4/libem/cmp.s @@ -0,0 +1,19 @@ +.define .cmp + + .text +.cmp: + move.l (sp)+,.savret ! return address + move.l d0,.savd0 + move.l #1,d1 + move.l (sp)+,d0 + cmp.l (sp)+,d0 + bne 1f + clr.l d1 + 1: + bcs 2f + neg.l d1 + 2: + move.l .savd0,d0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/cms.s b/mach/m68k4/libem/cms.s new file mode 100644 index 00000000..7b67d0fe --- /dev/null +++ b/mach/m68k4/libem/cms.s @@ -0,0 +1,22 @@ +.define .cms + + ! d0 contains set size + + .text +.cms: + move.l (sp)+,a2 ! return address + move.l sp,a0 + move.l sp,a1 + add d0,a1 + move.w d0,d1 + asr #1,d0 +1: + cmp (a0)+,(a1)+ + bne 2f + dbf d0,1b +2: + asl #1,d1 + add d1,sp + move.l d0,-(sp) + jmp (a2) +.align 2 diff --git a/mach/m68k4/libem/cmu.s b/mach/m68k4/libem/cmu.s new file mode 100644 index 00000000..b69ef89c --- /dev/null +++ b/mach/m68k4/libem/cmu.s @@ -0,0 +1,29 @@ +.define .cmu + + ! d0 : # bytes of 1 block + .text +.cmu: + movem.l d2/a0/a1/a2,.savreg + move.l (sp)+,a2 ! reta + move.l sp,a0 ! top block + move.l sp,a1 + add.l d0,a1 ! lower block + move.l d0,d2 + asr.l #2,d0 + sub.l #1,d0 + move.l #1,d1 ! greater +1: + cmp.l (a0)+,(a1)+ + bne 2f + dbf d0,1b + clr.l d1 ! equal +2: + bcc 3f + neg.l d1 ! less +3: + asl.l #1,d2 + add.l d2,sp ! new sp + move.l a2,-(sp) + movem.l .savreg,d2/a0/a1/a2 + rts +.align 2 diff --git a/mach/m68k4/libem/csa.s b/mach/m68k4/libem/csa.s new file mode 100644 index 00000000..3f81ce1c --- /dev/null +++ b/mach/m68k4/libem/csa.s @@ -0,0 +1,29 @@ +.define .csa + + .text +.csa: + movem.l d0/a0/a1/a2,.savreg + move.l (sp)+,a0 ! case descriptor + move.l (sp)+,d0 ! index + move.l (a0)+,a1 ! default address + sub.l (a0)+,d0 ! index - lower bound + blt 1f + cmp.l (a0)+,d0 ! rel. index <-> upper - lower bound + bgt 1f + asl.l #2,d0 + add.l d0,a0 + move.l (a0),d0 ! test jump address + beq 1f + move.l d0,-(sp) + bra 3f +1: + move.l a1,d0 ! test default jump address + beq 2f + move.l a1,-(sp) ! jump address +3: + movem.l .savreg,d0/a0/a1/a2 + rts ! not a real rts +2: + move.w #ECASE,-(sp) + jmp .fat +.align 2 diff --git a/mach/m68k4/libem/csb.s b/mach/m68k4/libem/csb.s new file mode 100644 index 00000000..88ed8043 --- /dev/null +++ b/mach/m68k4/libem/csb.s @@ -0,0 +1,28 @@ +.define .csb + + .text +.csb: + movem.l d0/d1/a0/a1,.savreg + move.l (sp)+,a0 ! case descriptor + move.l (sp)+,d0 ! index + move.l (a0)+,a1 ! default jump address + move.l (a0)+,d1 ! # entries + beq 2f + sub.l #1,d1 +1: + cmp.l (a0)+,d0 + beq 3f + tst.l (a0)+ ! skip jump address + dbf d1,1b +2: + move.l a1,d1 ! default jump address + bne 4f + move.l #ECASE,-(sp) + jmp .fat +3: + move.l (a0)+,a1 ! get jump address +4: + move.l a1,-(sp) + movem.l .savreg,d0/d1/a0/a1 + rts +.align 2 diff --git a/mach/m68k4/libem/cuu.s b/mach/m68k4/libem/cuu.s new file mode 100644 index 00000000..3e56221e --- /dev/null +++ b/mach/m68k4/libem/cuu.s @@ -0,0 +1,21 @@ +.define .ciu +.define .cui +.define .cuu + + .text +.ciu: +.cui: +.cuu: + move.l (sp)+,a0 ! return address + move (sp)+,d0 ! destination size + sub (sp)+,d0 + bgt 1f + sub d0,sp + jmp (a0) +1: + asr #1,d0 +2: + clr -(sp) + dbf d0,2b + jmp (a0) +.align 2 diff --git a/mach/m68k4/libem/cvf.s b/mach/m68k4/libem/cvf.s new file mode 100644 index 00000000..59cc742b --- /dev/null +++ b/mach/m68k4/libem/cvf.s @@ -0,0 +1,16 @@ +.define .cfi,.cif,.cfu,.cuf,.cff + + .text + + ! this is a dummy float conversion routine +.cfi: +.cif: +.cfu: +.cuf: +.cff: + move.l (sp)+,a0 ! return address + move (sp)+,d0 ! destination size + sub (sp)+,d0 ! diff. in sizes + sub d0,sp + jmp (a0) +.align 2 diff --git a/mach/m68k4/libem/dia.s b/mach/m68k4/libem/dia.s new file mode 100644 index 00000000..a9d7a0bd --- /dev/null +++ b/mach/m68k4/libem/dia.s @@ -0,0 +1,37 @@ +.define .diagnos + +space = 040 +del = 0177 + + .text +.diagnos: + move.l hol0,-(sp) + move.l hol0+FILN_AD,d2 + beq 1f + move.l d2,a0 + move.l #40,d0 +3: + move.b (a0)+,d1 + beq 2f + cmp.b #del,d1 + bge 1f + cmp.b #space,d1 + blt 1f + sub #1,d0 + bgt 3b + clr.b (a1) +2: + move.l d2,-(sp) + pea fmt + jsr _printf + add #12,sp + jmp _printf + +1: + move.l #unknwn,d2 + bra 2b + + .data +fmt: .asciz "%s, line %d: " +unknwn: .asciz "unknown file" +.align 2 diff --git a/mach/m68k4/libem/dvi.s b/mach/m68k4/libem/dvi.s new file mode 100644 index 00000000..fc74fb4d --- /dev/null +++ b/mach/m68k4/libem/dvi.s @@ -0,0 +1,42 @@ +.define .dvi + + ! signed long divide + .text +.dvi: + movem.l d0/d4,.savdvi + move.l (sp)+,.retdvi + move.l (sp)+,d0 + move.l (sp)+,d1 + clr.l d4 + tst.l d0 ! divisor + bpl 1f + neg.l d0 + not d4 +1: + tst.l d1 ! dividend + bpl 2f + neg.l d1 + not d4 + swap d4 + not d4 + swap d4 +2: + move.l d1,-(sp) + move.l d0,-(sp) + jsr .dvu + tst d4 + beq 5f + neg.l d1 ! quotient +5: + tst.l d4 + bpl 6f + neg.l d2 ! remainder +6: + movem.l .savdvi,d0/d4 + move.l .retdvi,-(sp) + rts +.data +.savdvi: .space 12 +.retdvi: .long 0 +.text +.align 2 diff --git a/mach/m68k4/libem/dvu.s b/mach/m68k4/libem/dvu.s new file mode 100644 index 00000000..9f595d6f --- /dev/null +++ b/mach/m68k4/libem/dvu.s @@ -0,0 +1,34 @@ +.define .dvu + + ! unsigned long divide + ! register usage: + ! : d0 divisor + ! d1 dividend + ! exit : d1 quotient + ! d2 remainder + .text +.dvu: + movem.l d0/d3,.savreg + move.l (sp)+,.savret + move.l (sp)+,d0 + move.l (sp)+,d1 + tst.l d0 + bne 0f + move.w #EIDIVZ,-(sp) + jsr .trp +0: + clr.l d2 + move.l #31,d3 +3: + lsl.l #1,d1 + roxl.l #1,d2 + cmp.l d0,d2 + blt 4f + sub.l d0,d2 + add #1,d1 +4: + dbf d3,3b + movem.l .savreg,d0/d3 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/exg.s b/mach/m68k4/libem/exg.s new file mode 100644 index 00000000..0107f799 --- /dev/null +++ b/mach/m68k4/libem/exg.s @@ -0,0 +1,26 @@ +.define .exg + + ! d0 : exchange size in bytes + .text +.exg: + move.l (sp)+,.savret + movem.l d1/a1/a2,.savreg + move.l sp,a1 + sub.l d0,sp + move.l sp,a2 + asr #1,d0 + move.l d0,d1 +1: + move.l (a1)+,(a2)+ + sub #1,d0 + bgt 1b + move.l sp,a1 + asr #1,d1 +1: + move.l (a1)+,(a2)+ + sub #1,d1 + bgt 1b + move.l a1,sp + movem.l .savreg,d1/a1/a2 + move.l .savret,-(sp) + rts diff --git a/mach/m68k4/libem/fat.s b/mach/m68k4/libem/fat.s new file mode 100644 index 00000000..e6fbbb03 --- /dev/null +++ b/mach/m68k4/libem/fat.s @@ -0,0 +1,7 @@ +.define .fat + + .text +.fat: + jsr .trp + jmp EXIT +.align 2 diff --git a/mach/m68k4/libem/inn.s b/mach/m68k4/libem/inn.s new file mode 100644 index 00000000..83e1c925 --- /dev/null +++ b/mach/m68k4/libem/inn.s @@ -0,0 +1,31 @@ +.define .inn + +! d0 : set size in bytes +! d1 : bitnumber + + .text +.inn: + movem.l d1/d2/a0/a1,.savreg + move.l (sp)+,.savret + move.l (sp)+,d1 + move.l sp,a1 + add.l d0,a1 + move.l sp,a0 + move.l d1,d2 + asr.l #4,d2 + !bchg.l #0,d2 + cmp.l d0,d2 + bcc 1f + add.l d2,a0 + move.l (a0),d2 + btst d1,d2 !eigenlijk .l + beq 1f + move.l #1,d0 + bra 2f +1: + clr.l d0 +2: + move.l a1,sp + movem.l .savreg,d1/d2/a0/a1 + move.l .savret,-(sp) + rts diff --git a/mach/m68k4/libem/lfr.s b/mach/m68k4/libem/lfr.s new file mode 100644 index 00000000..51c06697 --- /dev/null +++ b/mach/m68k4/libem/lfr.s @@ -0,0 +1,25 @@ +.define .lfr + + .text +.lfr: + move.l (sp)+,a0 + cmp #2,d7 + bne 1f + move d0,-(sp) + bra 3f +1: + cmp #4,d7 + bne 2f + move.l d0,-(sp) + bra 3f +2: + cmp #8,d7 + bne 4f + move.l d1,-(sp) + move.l d0,-(sp) +3: + jmp(a0) +4: + move.w #EILLINS,-(sp) + jmp .fat +.align 2 diff --git a/mach/m68k4/libem/los.s b/mach/m68k4/libem/los.s new file mode 100644 index 00000000..c15dc814 --- /dev/null +++ b/mach/m68k4/libem/los.s @@ -0,0 +1,36 @@ +.define .los + + ! d0 : # bytes + ! a0 : source address + .text +.los: + movem.l d0/a0,.savreg + move.l (sp)+,.savret + move.l (sp)+,d0 + move.l (sp)+,a0 + cmp.l #1,d0 + bne 1f + clr.l d0 !1 byte + move.b (a0),d0 + move.l d0,-(sp) + bra 3f +1: + cmp.l #2,d0 + bne 2f + clr.l d0 !2 bytes + add.l #2,a0 + move.w (a0),d0 + move.l d0,-(sp) + bra 3f +2: + add.l d0,a0 !>=4 bytes + asr.l #2,d0 + +4: move.l -(a0),-(sp) + sub.l #1,d0 + bgt 4b +3: + movem.l .savreg,d0/a0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/mli.s b/mach/m68k4/libem/mli.s new file mode 100644 index 00000000..fe2e0ddc --- /dev/null +++ b/mach/m68k4/libem/mli.s @@ -0,0 +1,36 @@ +.define .mli + + + .text +.mli: + move.l d5,.savmli + move.l (sp)+,.retmli + move.l (sp)+,d1 + move.l (sp)+,d0 + clr d5 + tst.l d0 + bpl 1f + neg.l d0 + not d5 +1: + tst.l d1 + bpl 2f + neg.l d1 + not d5 +2: + move.l d0,-(sp) + move.l d1,-(sp) + jsr .mlu + tst d5 + beq 3f + neg.l d1 + negx.l d0 +3: + move.l .savmli,d5 + move.l .retmli,-(sp) + rts +.data +.savmli: .long 0 +.retmli: .long 0 +.text +.align 2 diff --git a/mach/m68k4/libem/mlu.s b/mach/m68k4/libem/mlu.s new file mode 100644 index 00000000..0235ec26 --- /dev/null +++ b/mach/m68k4/libem/mlu.s @@ -0,0 +1,47 @@ +.define .mlu + + ! entry : d0 multiplicand + ! d1 multiplier + ! exit : d0 high order result + ! d1 low order result + + .text +.mlu: + move.l (sp)+,.savret + move.l (sp)+,d1 + move.l (sp)+,d0 + cmp.l #32768,d0 + bgt 1f + cmp.l #32768,d1 + bls 2f +1: movem.l d2/d3/d4/d6,.savreg + move.l d1,d3 + move.l d1,d2 + swap d2 + move.l d2,d4 + mulu d0,d1 + mulu d0,d2 + swap d0 + mulu d0,d3 + mulu d4,d0 + clr.l d6 + swap d1 + add d2,d1 + addx.l d6,d0 + add d3,d1 + addx.l d6,d0 + swap d1 + clr d2 + clr d3 + swap d2 + swap d3 + add.l d2,d0 + add.l d3,d0 + movem.l .savreg,d2/d3/d4/d6 + move.l .savret,-(sp) + rts +2: mulu d0,d1 + clr d0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/mon.s b/mach/m68k4/libem/mon.s new file mode 100644 index 00000000..dabe65a9 --- /dev/null +++ b/mach/m68k4/libem/mon.s @@ -0,0 +1,12 @@ +.define .mon + .text +.mon: + move.l (sp)+,a0 + pea fmt + jsr .diagnos + add #6,sp + jmp EXIT + + .data +fmt: .asciz "system call %d not implemented" +.align 2 diff --git a/mach/m68k4/libem/nop.s b/mach/m68k4/libem/nop.s new file mode 100644 index 00000000..9b8f3dd8 --- /dev/null +++ b/mach/m68k4/libem/nop.s @@ -0,0 +1,13 @@ +.define .nop + + .text +.nop: + move.l hol0,-(sp) + pea fmt + jsr .diagnos + add.l #8,sp + rts + + .data +fmt: .asciz "test %d\n" +.align 2 diff --git a/mach/m68k4/libem/printf.s b/mach/m68k4/libem/printf.s new file mode 100644 index 00000000..7f886230 --- /dev/null +++ b/mach/m68k4/libem/printf.s @@ -0,0 +1,77 @@ +.define _printf +.define _putchar +.define _getal +.define _char +.bss +_getal: + .space 12 +_char: + .space 1 +.data +sav: + .long 0 +.text +_printf: + movem.l d0/d1/d2/a0/a1/a2/a3/a4/a5/a6,.savreg + move.l (sp)+,sav !return address + move.l sp,a6 !a6 <- address of arguments + move.l (a6)+,a5 !a5 <- address of format + clr.l d0 !d0 <- char to be printed +next: move.b (a5)+,d0 + beq out + cmp.b #'%',d0 + beq procnt +put: move.l d0,-(sp) + jsr _putchar !argument is long en op de stack + tst.l (sp)+ + jmp next + +procnt: move.b (a5)+,d0 + cmp.b #'d',d0 !NOTE: %d means unsigned. + beq digit + cmp.b #'s',d0 + beq string + cmp.b #'%',d0 !second % has to be printed. + beq put + tst.b -(a5) !normal char should be printed + jmp next + +string: move.l (a6)+,a2 !a2 <- address of string +sloop: move.b (a2)+,d0 + beq next + move.l d0,-(sp) + jsr _putchar !argument is long en op de stack + tst.l (sp)+ + jmp sloop + +digit: move.l (a6)+,d1 !d1 <- integer + move.l #_getal+12,a3 !a3 <- ptr to last part of buf + move.b #0,-(a3) !stringterminator +dloop: move.l d1,-(sp) + move.l #10,-(sp) + jsr .dvu !d1 <- quotient d2 <- remainder + add.l #'0',d2 + move.b d2,-(a3) + tst.l d1 !if quotient = 0 then ready + bne dloop + move.l a3,a2 + jmp sloop !print digitstring. + +out: + move.l sav,-(sp) + movem.l .savreg,d0/d1/d2/a0/a1/a2/a3/a4/a5/a6 + rts + + +_putchar: + movem.l d0,.savreg + move.l 4(sp),d0 + move.b d0,_char + move.l #1,-(sp) + move.l #_char,-(sp) + move.l #1,-(sp) + jsr _write + add.l #12,sp + movem.l .savreg,d0 + rts +.align 2 diff --git a/mach/m68k4/libem/rck.s b/mach/m68k4/libem/rck.s new file mode 100644 index 00000000..6d935e86 --- /dev/null +++ b/mach/m68k4/libem/rck.s @@ -0,0 +1,20 @@ +.define .rck + + .text +.rck: + movem.l d0/a0,.savreg + move.l (sp)+,.savret + move.l (sp)+,a0 ! descriptor address + move.l (sp),d0 + cmp.l (a0),d0 + blt 1f + cmp.l 2(a0),d0 + ble 2f +1: + move.l #ERANGE,-(sp) + jsr .trp +2: + movem.l .savreg,d0/a0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/ret.s b/mach/m68k4/libem/ret.s new file mode 100644 index 00000000..ba5c2f03 --- /dev/null +++ b/mach/m68k4/libem/ret.s @@ -0,0 +1,26 @@ +.define .ret + + .text +.ret: + beq 3f + cmp #2,d0 + bne 1f + move (sp)+,d0 + bra 3f +1: + cmp #4,d0 + bne 2f + move.l (sp)+,d0 + bra 3f +2: + cmp #8,d0 + bne 4f + move.l (sp)+,d0 + move.l (sp)+,d1 +3: + unlk a6 + rts +4: + move.w #EILLINS,-(sp) + jmp .fat +.align 2 diff --git a/mach/m68k4/libem/sav.s b/mach/m68k4/libem/sav.s new file mode 100644 index 00000000..5f29178c --- /dev/null +++ b/mach/m68k4/libem/sav.s @@ -0,0 +1,13 @@ +.define .savd0 +.define .savret +.define .savreg + +.data +.savd0: + .long 0 +.savret: + .long 0 +.savreg: + .space 128 +.text +.align 2 diff --git a/mach/m68k4/libem/set.s b/mach/m68k4/libem/set.s new file mode 100644 index 00000000..c5c6038b --- /dev/null +++ b/mach/m68k4/libem/set.s @@ -0,0 +1,32 @@ +.define .set + + ! d0 : setsize in bytes + ! d1 : bitnumber + .text +.set: + movem.l d1/d2/a1,.savreg + move.l (sp)+,.savret + move.l (sp)+,d1 + move.l d0,d2 + asr.l #2,d2 +1: + clr.l -(sp) !create empty set + sub.l #1,d2 + bgt 1b + move.l sp,a1 ! set base + move.l d1,d2 + asr.l #4,d2 + !bchg #0,d2 + cmp.l d0,d2 + bcs 1f + move.w #ESET,-(sp) + move.l .savret,-(sp) + jmp .trp +1: + add.l d2,a1 + move.l (a1),d2 + bset d1,d2 + move.l d2,(a1) + movem.l .savreg,d1/d2/a1 + move.l .savret,-(sp) + rts diff --git a/mach/m68k4/libem/shp.s b/mach/m68k4/libem/shp.s new file mode 100644 index 00000000..2e60f1b0 --- /dev/null +++ b/mach/m68k4/libem/shp.s @@ -0,0 +1,23 @@ +.define .strhp + + .text +.strhp: + move.l d0,.savreg + move.l (sp)+,.savret + move.l (sp)+,d0 ! heap pointer + move.l d0,.reghp + cmp.l .limhp,d0 + blt 1f + add.l #0x400,d0 + and.l #~0x3ff,d0 + move.l d0,.limhp + cmp.l d0,sp + ble 2f +1: + move.l .savreg,d0 + move.l .savret,-(sp) + rts +2: + move.w #EHEAP,-(sp) + jmp .fat +.align 2 diff --git a/mach/m68k4/libem/sig.s b/mach/m68k4/libem/sig.s new file mode 100644 index 00000000..491d0cf5 --- /dev/null +++ b/mach/m68k4/libem/sig.s @@ -0,0 +1,13 @@ +.define .sig + + .text +.sig: + movem.l a1/a2,.savreg + move.l (sp)+,.savret + move.l (sp)+,a1 ! trap pc + move.l .trppc,-(sp) + move.l a1,.trppc + movem.l .savreg,a1/a2 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/sts.s b/mach/m68k4/libem/sts.s new file mode 100644 index 00000000..17d78807 --- /dev/null +++ b/mach/m68k4/libem/sts.s @@ -0,0 +1,33 @@ +.define .sts + + ! d0 : # bytes + ! a0 : destination address + .text +.sts: + movem.l d0/a0,.savreg + move.l (sp)+,.savret + move.l (sp)+,d0 + move.l (sp)+,a0 + cmp #1,d0 + bne 1f + move.l (sp)+,d0 + move.b d0,(a0) + bra 4f + +1: cmp #2,d0 + bne 2f + move.l (sp)+,d0 + add.l #2,a0 + move.w d0,(a0) + bra 4f +2: + asr #2,d0 + sub.l #1,d0 +3: + move.l (sp)+,(a0)+ + dbf d0,3b +4: + movem.l .savreg,d0/a0 + move.l .savret,-(sp) + rts +.align 2 diff --git a/mach/m68k4/libem/sys1.s b/mach/m68k4/libem/sys1.s new file mode 100644 index 00000000..99cd6304 --- /dev/null +++ b/mach/m68k4/libem/sys1.s @@ -0,0 +1,58 @@ +.extern _errno +.data +_errno: +.extern _lseek +.short 0 +.text +_lseek: +link a6,#-0 +.data +_13: +.short 29561 +.short 29489 +.short 11875 +.short 0 +.text +move.l #_13,.filn +move.w #8,.lino +move.w #0,-(sp) +move.w #0,-(sp) +move.l (sp)+,d0 +unlk a6 +rts +.extern _close +_close: +link a6,#-0 +move.l #_13,.filn +move.w #12,.lino +move.w #0,-(sp) +move.w (sp)+,d0 +unlk a6 +rts +.extern _ioctl +_ioctl: +link a6,#-0 +move.l #_13,.filn +move.w #18,.lino +move.w #0,-(sp) +move.w (sp)+,d0 +unlk a6 +rts +.extern _read +_read: +link a6,#-0 +move.l #_13,.filn +move.w #24,.lino +move.w #-1,-(sp) +move.w (sp)+,d0 +unlk a6 +rts +.extern _open +_open: +link a6,#-0 +move.l #_13,.filn +move.w #30,.lino +move.w #-1,-(sp) +move.w (sp)+,d0 +unlk a6 +rts diff --git a/mach/m68k4/libem/sys2.s b/mach/m68k4/libem/sys2.s new file mode 100644 index 00000000..fce0ee6e --- /dev/null +++ b/mach/m68k4/libem/sys2.s @@ -0,0 +1,7 @@ +.extern _exit +! Fake system call for 68000 running MACSBUG + +.text + +_exit: + jmp 0x0200f6 diff --git a/mach/m68k4/libem/trp.s b/mach/m68k4/libem/trp.s new file mode 100644 index 00000000..1d5b4e90 --- /dev/null +++ b/mach/m68k4/libem/trp.s @@ -0,0 +1,29 @@ +.define .trp + + .text +.trp: + move.l (sp)+,a2 ! return address + move.w (sp)+,d0 ! error number + move.l a2,-(sp) + move.w d0,-(sp) + cmp #16,d0 + bcc 1f + btst d0,.trpim + bne 3f +1: + move.l .trppc,a0 + move.l a0,d0 + beq 9f + clr.l .trppc + jsr (a0) +3: + add #2,sp + rts +9: + pea fmt + jsr .diagnos + jmp EXIT + + .data +fmt: .asciz "trap %d called\n" +.align 2 diff --git a/mach/m68k4/libpc/Makefile b/mach/m68k4/libpc/Makefile new file mode 100644 index 00000000..9f45d5d2 --- /dev/null +++ b/mach/m68k4/libpc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=m68k4" "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 diff --git a/mach/m68k4/libpc/compmodule b/mach/m68k4/libpc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/m68k4/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/m68k4/libsys/LIST b/mach/m68k4/libsys/LIST new file mode 100644 index 00000000..4fccdc16 --- /dev/null +++ b/mach/m68k4/libsys/LIST @@ -0,0 +1,45 @@ +tail_mon.a +exit.s +_exit.s +access.s +alarm.s +chdir.s +chmod.s +chroot.s +close.s +creat.s +execl.s +execve.s +fork.s +getegid.s +getgid.s +getpid.s +getuid.s +stty.s +gtty.s +ioctl.s +kill.s +link.s +lseek.s +mknod.s +mount.s +nice.s +open.s +pause.s +read.s +setgid.s +setuid.s +stat.s +stime.s +sync.s +time.s +times.s +umount.s +unlink.s +write.s +brk.s +wait.s +fstat.s +signal.s +call.s +cleanup.s diff --git a/mach/m68k4/libsys/Makefile b/mach/m68k4/libsys/Makefile new file mode 100644 index 00000000..5cc6f2ca --- /dev/null +++ b/mach/m68k4/libsys/Makefile @@ -0,0 +1,11 @@ +# $Header$ +install: + ../../install tail_mon.a tail_mon + +clean : + +opr : + make pr | opr + +pr: + @ar pv tail_mon.a diff --git a/mach/m68k4/libsys/_exit.s b/mach/m68k4/libsys/_exit.s new file mode 100644 index 00000000..398c9390 --- /dev/null +++ b/mach/m68k4/libsys/_exit.s @@ -0,0 +1,6 @@ +.define __exit +.extern __exit +.text +__exit: move.w #0x1,d0 + move.w 4(sp),a0 + trap #0 diff --git a/mach/m68k4/libsys/access.s b/mach/m68k4/libsys/access.s new file mode 100644 index 00000000..fdceffbf --- /dev/null +++ b/mach/m68k4/libsys/access.s @@ -0,0 +1,8 @@ +.define _access +.extern _access +.text +_access: move.w #0x21,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k4/libsys/alarm.s b/mach/m68k4/libsys/alarm.s new file mode 100644 index 00000000..98781a70 --- /dev/null +++ b/mach/m68k4/libsys/alarm.s @@ -0,0 +1,9 @@ +.define _alarm +.extern _alarm +.text +_alarm: clr.l d0 + move.w 4(sp),d0 + move.l d0,a0 + move.w #0x1B,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/brk.s b/mach/m68k4/libsys/brk.s new file mode 100644 index 00000000..0d33d073 --- /dev/null +++ b/mach/m68k4/libsys/brk.s @@ -0,0 +1,26 @@ +.define _brk +.define _sbrk +.extern _brk +.extern _sbrk +.text +_sbrk: move.l nd,a0 + add.w 4(sp),a0 + move.w #0x11,d0 + trap #0 + bcs lcerror + move.l nd,d0 + move.l d0,a0 + add.w 4(sp),a0 + move.l a0,nd + rts +lcerror: jmp cerror +_brk: move.w #0x11,d0 + move.l 4(sp),a0 + trap #0 + bcs lcerror + move.l 4(sp),nd + clr.l d0 + rts +.data +nd: .long endbss +.text diff --git a/mach/m68k4/libsys/call.s b/mach/m68k4/libsys/call.s new file mode 100644 index 00000000..846fb779 --- /dev/null +++ b/mach/m68k4/libsys/call.s @@ -0,0 +1,28 @@ +.define call +.define callc +.define calle +.define cerror +.define _errno +.extern call +.extern callc +.extern calle +.extern cerror +.extern _errno +.text +call: trap #0 + bcs cerror + rts +callc: + trap #0 + bcs cerror + clr.l d0 + rts +calle: + trap #0 +cerror: + move.w d0,_errno + move.l #-1,d0 + rts +.bss +_errno: .space 4 +.text diff --git a/mach/m68k4/libsys/chdir.s b/mach/m68k4/libsys/chdir.s new file mode 100644 index 00000000..d03224ae --- /dev/null +++ b/mach/m68k4/libsys/chdir.s @@ -0,0 +1,6 @@ +.define _chdir +.extern _chdir +.text +_chdir: move.w #0xC,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/chmod.s b/mach/m68k4/libsys/chmod.s new file mode 100644 index 00000000..6c86e3a2 --- /dev/null +++ b/mach/m68k4/libsys/chmod.s @@ -0,0 +1,8 @@ +.define _chmod +.extern _chmod +.text +_chmod: move.w #0xF,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k4/libsys/chroot.s b/mach/m68k4/libsys/chroot.s new file mode 100644 index 00000000..ebf9f6a4 --- /dev/null +++ b/mach/m68k4/libsys/chroot.s @@ -0,0 +1,6 @@ +.define _chroot +.extern _chroot +.text +_chroot: move.w #0x3D,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/cleanup.s b/mach/m68k4/libsys/cleanup.s new file mode 100644 index 00000000..7df1860b --- /dev/null +++ b/mach/m68k4/libsys/cleanup.s @@ -0,0 +1,8 @@ +.define __cleanup +.extern __cleanup +.text +__cleanup: +tst.b -40(sp) +link a6,#-0 +unlk a6 +rts diff --git a/mach/m68k4/libsys/close.s b/mach/m68k4/libsys/close.s new file mode 100644 index 00000000..add7e701 --- /dev/null +++ b/mach/m68k4/libsys/close.s @@ -0,0 +1,6 @@ +.define _close +.extern _close +.text +_close: move.w #0x6,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/creat.s b/mach/m68k4/libsys/creat.s new file mode 100644 index 00000000..73e7db84 --- /dev/null +++ b/mach/m68k4/libsys/creat.s @@ -0,0 +1,8 @@ +.define _creat +.extern _creat +.text +_creat: move.w #0x8,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp call diff --git a/mach/m68k4/libsys/execl.s b/mach/m68k4/libsys/execl.s new file mode 100644 index 00000000..21e03dc9 --- /dev/null +++ b/mach/m68k4/libsys/execl.s @@ -0,0 +1,11 @@ +.define _execl +.extern _execl +_execl: link a6,#0 + tst.b -132(sp) + move.l _environ,-(sp) + pea 12(sp) + move.l 8(a6),-(sp) + jsr _execve + add.l #0xC,sp + unlk a6 + rts diff --git a/mach/m68k4/libsys/execve.s b/mach/m68k4/libsys/execve.s new file mode 100644 index 00000000..2b2de5f8 --- /dev/null +++ b/mach/m68k4/libsys/execve.s @@ -0,0 +1,8 @@ +.define _execve +.extern _execve +.text +_execve: move.w #0x3B,d0 + move.l 4(sp),a0 + move.l 8(sp),d1 + move.l 12(sp),a1 + jmp calle diff --git a/mach/m68k4/libsys/exit.s b/mach/m68k4/libsys/exit.s new file mode 100644 index 00000000..d766750e --- /dev/null +++ b/mach/m68k4/libsys/exit.s @@ -0,0 +1,12 @@ +.define _exit +.extern _exit +.text +_exit: +tst.b -40(sp) +link a6,#-0 +jsr __cleanup +move.w 8(a6),-(sp) +jsr __exit +add.l #2,sp +unlk a6 +rts diff --git a/mach/m68k4/libsys/fork.s b/mach/m68k4/libsys/fork.s new file mode 100644 index 00000000..0401e631 --- /dev/null +++ b/mach/m68k4/libsys/fork.s @@ -0,0 +1,13 @@ +.define _fork +.extern _fork +.text +_fork: move.w #0x2,d0 + trap #0 + bra 1f + bcc 2f + jmp cerror +1: + !move.l d0,p_uid + clr.l d0 +2: + rts diff --git a/mach/m68k4/libsys/fstat.s b/mach/m68k4/libsys/fstat.s new file mode 100644 index 00000000..1dd3d66c --- /dev/null +++ b/mach/m68k4/libsys/fstat.s @@ -0,0 +1,6 @@ +.define _fstat +.extern _fstat +_fstat: move.w #0x1C,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + jmp callc diff --git a/mach/m68k4/libsys/getegid.s b/mach/m68k4/libsys/getegid.s new file mode 100644 index 00000000..b4da40c1 --- /dev/null +++ b/mach/m68k4/libsys/getegid.s @@ -0,0 +1,7 @@ +.define _getegid +.extern _getegid +.text +_getegid: move.w #0x2F,d0 + trap #0 + move.l d1,d0 + rts diff --git a/mach/m68k4/libsys/getgid.s b/mach/m68k4/libsys/getgid.s new file mode 100644 index 00000000..3ef4def3 --- /dev/null +++ b/mach/m68k4/libsys/getgid.s @@ -0,0 +1,6 @@ +.define _getgid +.extern _getgid +.text +_getgid: move.w #0x2F,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/getpid.s b/mach/m68k4/libsys/getpid.s new file mode 100644 index 00000000..1bf2aba7 --- /dev/null +++ b/mach/m68k4/libsys/getpid.s @@ -0,0 +1,6 @@ +.define _getpid +.extern _getpid +.text +_getpid: move.w #0x14,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/getuid.s b/mach/m68k4/libsys/getuid.s new file mode 100644 index 00000000..d0e15a1b --- /dev/null +++ b/mach/m68k4/libsys/getuid.s @@ -0,0 +1,6 @@ +.define _getuid +.extern _getuid +.text +_getuid: move.w #0x18,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/gtty.s b/mach/m68k4/libsys/gtty.s new file mode 100644 index 00000000..ee9f096c --- /dev/null +++ b/mach/m68k4/libsys/gtty.s @@ -0,0 +1,13 @@ +.define _gtty +.extern _gtty +.text +_gtty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29704,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/m68k4/libsys/ioctl.s b/mach/m68k4/libsys/ioctl.s new file mode 100644 index 00000000..75d16214 --- /dev/null +++ b/mach/m68k4/libsys/ioctl.s @@ -0,0 +1,9 @@ +.define _ioctl +.extern _ioctl +.text +_ioctl: move.w #0x36,d0 + move.w 4(sp),a0 + move.w 6(sp),d1 + ext.l d1 + move.l 8(sp),a1 + jmp callc diff --git a/mach/m68k4/libsys/kill.s b/mach/m68k4/libsys/kill.s new file mode 100644 index 00000000..c5c4038c --- /dev/null +++ b/mach/m68k4/libsys/kill.s @@ -0,0 +1,8 @@ +.define _kill +.extern _kill +.text +_kill: move.w #0x25,d0 + move.w 4(sp),a0 + move.w 6(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k4/libsys/link.s b/mach/m68k4/libsys/link.s new file mode 100644 index 00000000..161ca6d1 --- /dev/null +++ b/mach/m68k4/libsys/link.s @@ -0,0 +1,8 @@ +.define _link +.extern _link +.text +_link: move.w #0x9,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k4/libsys/lseek.s b/mach/m68k4/libsys/lseek.s new file mode 100644 index 00000000..96f670e7 --- /dev/null +++ b/mach/m68k4/libsys/lseek.s @@ -0,0 +1,8 @@ +.define _lseek +.extern _lseek +.text +_lseek: move.w #0x13,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k4/libsys/mknod.s b/mach/m68k4/libsys/mknod.s new file mode 100644 index 00000000..21d86ad0 --- /dev/null +++ b/mach/m68k4/libsys/mknod.s @@ -0,0 +1,9 @@ +.define _mknod +.extern _mknod +.text +_mknod: move.w #0xE,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + move.w 10(sp),a1 + jmp callc diff --git a/mach/m68k4/libsys/mount.s b/mach/m68k4/libsys/mount.s new file mode 100644 index 00000000..b7d37737 --- /dev/null +++ b/mach/m68k4/libsys/mount.s @@ -0,0 +1,9 @@ + +.define _mount +.extern _mount +.text +_mount: move.w #0x15,d0 + move.l 4(sp),a0 + move.l 8(sp),d1 + move.l 12(sp),a1 + jmp callc diff --git a/mach/m68k4/libsys/nice.s b/mach/m68k4/libsys/nice.s new file mode 100644 index 00000000..4929617b --- /dev/null +++ b/mach/m68k4/libsys/nice.s @@ -0,0 +1,6 @@ +.define _nice +.extern _nice +.text +_nice: move.w #0x22,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/open.s b/mach/m68k4/libsys/open.s new file mode 100644 index 00000000..04b3b505 --- /dev/null +++ b/mach/m68k4/libsys/open.s @@ -0,0 +1,8 @@ +.define _open +.extern _open +.text +_open: move.w #0x5,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp call diff --git a/mach/m68k4/libsys/pause.s b/mach/m68k4/libsys/pause.s new file mode 100644 index 00000000..53b99d73 --- /dev/null +++ b/mach/m68k4/libsys/pause.s @@ -0,0 +1,6 @@ +.define _pause +.extern _pause +.text +_pause: move.w #0x1D,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/read.s b/mach/m68k4/libsys/read.s new file mode 100644 index 00000000..a5e0449a --- /dev/null +++ b/mach/m68k4/libsys/read.s @@ -0,0 +1,8 @@ +.define _read +.extern _read +.text +_read: move.w #0x3,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k4/libsys/setgid.s b/mach/m68k4/libsys/setgid.s new file mode 100644 index 00000000..5ad03004 --- /dev/null +++ b/mach/m68k4/libsys/setgid.s @@ -0,0 +1,6 @@ +.define _setgid +.extern _setgid +.text +_setgid: move.w #0x2E,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/setuid.s b/mach/m68k4/libsys/setuid.s new file mode 100644 index 00000000..94cc45ef --- /dev/null +++ b/mach/m68k4/libsys/setuid.s @@ -0,0 +1,6 @@ +.define _setuid +.extern _setuid +.text +_setuid: move.w #0x17,d0 + move.w 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/signal.s b/mach/m68k4/libsys/signal.s new file mode 100644 index 00000000..8f18c1f8 --- /dev/null +++ b/mach/m68k4/libsys/signal.s @@ -0,0 +1,49 @@ +.define _signal +.extern _signal +NSIG=32 +_signal: + move.w 4(sp), d0 + ext.l d0 + cmp.l #NSIG,d0 + bcc 1f + move.l 6(sp),d1 + move.l d0,a0 + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a1 + move.l d1,(a0) + beq 2f + btst #0,d1 + bne 2f + move.l #enter,d1 +2: + move.l d0,a0 + move.w #0x30,d0 + trap #0 + bcs 3f + btst #0,d0 + bne 4f + move.l a1,d0 +4: + rts +1: + move.l #22,d0 +3: + jmp cerror + +enter: + movem.l d0/d1/a0/a1,-(sp) + move.l 16(sp),a0 + move.l a0,-(sp) + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a0 + jsr (a0) + add.l #4,sp + movem.l (sp)+,d0/d1/a0/a1 + add.l #4,sp + rtr +.bss +dvect: .space 4*NSIG diff --git a/mach/m68k4/libsys/stat.s b/mach/m68k4/libsys/stat.s new file mode 100644 index 00000000..304c38b1 --- /dev/null +++ b/mach/m68k4/libsys/stat.s @@ -0,0 +1,8 @@ +.define _stat +.extern _stat +.text +_stat: move.w #0x12,d0 + move.l 4(sp),a0 + move.w 8(sp),d1 + ext.l d1 + jmp callc diff --git a/mach/m68k4/libsys/stime.s b/mach/m68k4/libsys/stime.s new file mode 100644 index 00000000..bac6386d --- /dev/null +++ b/mach/m68k4/libsys/stime.s @@ -0,0 +1,11 @@ +.define _stime +.extern _stime +.text +_stime: move.w #0x19,d0 + move.l 4(sp),a0 + move.l (a0),a0 + trap #0 + bcs 1f + rts +1: + jmp cerror diff --git a/mach/m68k4/libsys/stty.s b/mach/m68k4/libsys/stty.s new file mode 100644 index 00000000..46a497cd --- /dev/null +++ b/mach/m68k4/libsys/stty.s @@ -0,0 +1,13 @@ +.define _stty +.extern _stty +.text +_stty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29705,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/m68k4/libsys/sync.s b/mach/m68k4/libsys/sync.s new file mode 100644 index 00000000..3c38a8ad --- /dev/null +++ b/mach/m68k4/libsys/sync.s @@ -0,0 +1,6 @@ +.define _sync +.extern _sync +.text +_sync: move.w #0x24,d0 + trap #0 + rts diff --git a/mach/m68k4/libsys/time.s b/mach/m68k4/libsys/time.s new file mode 100644 index 00000000..87b9d8bd --- /dev/null +++ b/mach/m68k4/libsys/time.s @@ -0,0 +1,11 @@ +.define _time +.extern _time +.text +_time: move.w #0xD,d0 + trap #0 + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.l d0,(a0) +1: + rts diff --git a/mach/m68k4/libsys/times.s b/mach/m68k4/libsys/times.s new file mode 100644 index 00000000..002f63be --- /dev/null +++ b/mach/m68k4/libsys/times.s @@ -0,0 +1,7 @@ +.define _times +.extern _times +.text +_times: move.w #0x2B,d0 + move.w 4(sp),a0 + trap #0 + rts diff --git a/mach/m68k4/libsys/umount.s b/mach/m68k4/libsys/umount.s new file mode 100644 index 00000000..59354ee9 --- /dev/null +++ b/mach/m68k4/libsys/umount.s @@ -0,0 +1,6 @@ +.define _umount +.extern _umount +.text +_umount: move.w #0x16,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/unlink.s b/mach/m68k4/libsys/unlink.s new file mode 100644 index 00000000..99e856a5 --- /dev/null +++ b/mach/m68k4/libsys/unlink.s @@ -0,0 +1,6 @@ +.define _unlink +.extern _unlink +.text +_unlink: move.w #0xA,d0 + move.l 4(sp),a0 + jmp callc diff --git a/mach/m68k4/libsys/wait.s b/mach/m68k4/libsys/wait.s new file mode 100644 index 00000000..a0ea1a5e --- /dev/null +++ b/mach/m68k4/libsys/wait.s @@ -0,0 +1,12 @@ +.define _wait +.extern _wait +_wait: move.w #0x7,d0 + move.l 4(sp),a0 + trap #0 + bcs cerror + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.w d1,(a0) +1: + rts diff --git a/mach/m68k4/libsys/write.s b/mach/m68k4/libsys/write.s new file mode 100644 index 00000000..192d7adb --- /dev/null +++ b/mach/m68k4/libsys/write.s @@ -0,0 +1,8 @@ +.define _write +.extern _write +.text +_write: move.w #0x4,d0 + move.w 4(sp),a0 + move.l 6(sp),d1 + move.w 10(sp),a1 + jmp call diff --git a/mach/m68k4/ncg/Makefile b/mach/m68k4/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/m68k4/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/mantra/int/Makefile b/mach/mantra/int/Makefile new file mode 100644 index 00000000..a46b92ce --- /dev/null +++ b/mach/mantra/int/Makefile @@ -0,0 +1,51 @@ +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 + +install: em2tl + rm -f ../../../bin/em + cp em2tl ../../../bin/em + +cmp: em2tl + cmp em2tl ../../../bin/em + +clean: + rm -f em2tl *.s temp.c + +opr: + make pr | opr + +pr: + @pr `pwd`/makefile `pwd`/prep + @pr `pwd`/header `pwd/deffile `pwd`/$P? diff --git a/mach/mantra/int/copyright b/mach/mantra/int/copyright new file mode 100644 index 00000000..850f114c --- /dev/null +++ b/mach/mantra/int/copyright @@ -0,0 +1,77 @@ +! (c) copyright 1984 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 diff --git a/mach/mantra/int/deffile b/mach/mantra/int/deffile new file mode 100644 index 00000000..ea62078b --- /dev/null +++ b/mach/mantra/int/deffile @@ -0,0 +1,87 @@ +#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) +#define locptr cmp.l sp,a0 ;\ + bcc 6f +#define heaptr cmp.l hp,a0 ;\ + bhi 7f ;\ + cmp.l tblmax,a0 ;\ + bcc 6f +#define extptr cmp.l globmax,a0 ;\ + bcc 7f ;\ + cmp.l a6,a0 ;\ + bcc 6f + diff --git a/mach/mantra/int/em.c b/mach/mantra/int/em.c new file mode 100644 index 00000000..c62b007e --- /dev/null +++ b/mach/mantra/int/em.c @@ -0,0 +1,132 @@ +/* + * (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 +#include +#include + +char rcs_id[] = "$Header$" ; + +#define MAGIC 07255 + +struct header { + short h_magic; /* Magic number */ + short h_flags; /* See below for defines */ + short h_unresolved; /* Cannot run if nonzero */ + short h_version; /* Check for VERSION */ + short h_wsize; + short h_psize; + short h_unused[2]; /* left over */ +} header; + +#define TEST 001 +#define PROFILE 002 +#define FLOW 004 +#define COUNT 010 + +char *defargv[] = { + "em", + "e.out", + 0 +}; + +char interpret[BUFSIZ]; +char flags[5]; +char tflg,fflg,cflg,pflg; + +main(argc,argv) char **argv; { + char *file; + int fildes; + + while (argc>1 && (argv[1][0]=='-' || argv[1][0]=='+')) { + switch(argv[1][1]) { + case 't': tflg=argv[1][0]; break; + case 'c': cflg=argv[1][0]; break; + case 'f': fflg=argv[1][0]; break; + case 'p': pflg=argv[1][0]; break; + default: + fprintf(stderr,"Bad flag %c\n",argv[1][1]); + exit(-1); + } + argv[1] = argv[0]; + argc--;argv++; + } + if (argc==1) + argv= defargv; + file=argv[1]; + if ((fildes=open(file,0))<0) { + perror(file); + exit(8) ; + } + header.h_magic= r2b(fildes,file) ; + header.h_flags= r2b(fildes,file) ; + header.h_unresolved= r2b(fildes,file) ; + header.h_version= r2b(fildes,file) ; + header.h_wsize= r2b(fildes,file) ; + header.h_psize= r2b(fildes,file) ; + header.h_unused[0]= r2b(fildes,file) ; + header.h_unused[1]= r2b(fildes,file) ; + if (header.h_magic != MAGIC) { + fprintf(stderr,"%s not in correct format\n",file); + exit(-1); + } + if (header.h_version != VERSION) { + fprintf(stderr,"%s obsolete, recompile\n",file); + exit(-1); + } + if (header.h_unresolved != 0) { + fprintf(stderr, + "%s has unresolved references, cannot run it\n",file); + exit(-1); + } + /* + if ( header.h_psize!=EM_PSIZE) { + fprintf(stderr, + "%s cannot be interpreted on this machine\n",file); + exit(-1); + } + */ + if (tflg) + flags[0] = tflg=='+' ? 't' : '-'; + else + flags[0]= header.h_flags&TEST ? 't' : '-'; + if (fflg) + flags[1] = fflg=='+' ? 'f' : '-'; + else + flags[1]= header.h_flags&FLOW ? 'f' : '-'; + if (cflg) + flags[2] = cflg=='+' ? 'c' : '-'; + else + flags[2]= header.h_flags&COUNT ? 'c' : '-'; + if (pflg) + flags[3] = pflg=='+' ? 'p' : '-'; + else + flags[3]= header.h_flags&PROFILE ? 'p' : '-'; + sprintf(interpret,"%s/lib/int%d%d/em_%s", + EM_DIR,header.h_wsize,header.h_psize,flags); + execv(interpret,argv); + fprintf(stderr,"Interpreter %s not available\n",interpret); +} + +r2b(fildes,file) char *file ; { + char rd2[2] ; + if ( read(fildes,rd2,sizeof rd2)!=sizeof rd2) { + fprintf(stderr,"%s too short\n",file); + exit(-1); + } + return (rd2[0]&0xFF) | ( (rd2[1]&0xFF)<<8 ) ; +} diff --git a/mach/mantra/int/header b/mach/mantra/int/header new file mode 100644 index 00000000..ff0fa03e --- /dev/null +++ b/mach/mantra/int/header @@ -0,0 +1,8 @@ +!definitions +!#define lword +!#define FLTRAP +#define opfreq 0 +#define last 1 +#define test 1 +#define count 0 +#define flow 0 diff --git a/mach/mantra/int/mloop0 b/mach/mantra/int/mloop0 new file mode 100644 index 00000000..e3541a69 --- /dev/null +++ b/mach/mantra/int/mloop0 @@ -0,0 +1,505 @@ +!--------------------------------------------------------------------------- +! 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 #126,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 + 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 maxcount + .define firstp + .define globmax + .define tblmax + .define ml + .define argc + + .text diff --git a/mach/mantra/int/mloop1 b/mach/mantra/int/mloop1 new file mode 100644 index 00000000..e22bb6c1 --- /dev/null +++ b/mach/mantra/int/mloop1 @@ -0,0 +1,489 @@ +!------------------------------------------------------------------------------- +! 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. +! For escape1 and escape2 in timeinf the full decoding is listed . +! In timeinf1 and timeinf2 only a rough estimate is given for the +! processor state cycles needed to execute the instruction and to return +! from it . +!------------------------------------------------------------------------------ + +#if prof + + .data +#ifdef lword +timeinf: +.long 32 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 37 ; .long 37 +.long 37 ; .long 37 ; .long 134 ; .long 00 +.long 42 ; .long 00 ; .long 56 ; .long 40 +.long 40 ; .long 42 ; .long 42 ; .long 42 +.long 42 ; .long 38 ; .long 38 ; .long 38 +.long 38 ; .long 38 ; .long 42 ; .long 71 +.long 52 ; .long 52 ; .long 52 ; .long 52 +.long 118 ; .long 52 ; .long 52 ; .long 55 +.long 45 ; .long 45 ; .long 36 ; .long 43 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 231 ; .long 231 ; .long 231 ; .long 231 +.long 233 ; .long 00 ; .long 00 ; .long 75 +.long 00 ; .long 58 ; .long 00 ; .long 54 +.long 91 ; .long 113 ; .long 116 ; .long 38 +.long 59 ; .long 59 ; .long 36 ; .long 00 +.long 1100 ; .long 77; .long 32 ; .long 66 +.long 51 ; .long 45 ; .long 49 ; .long 49 +.long 53 ; .long 127 ; .long 52 ; .long 152 +.long 54 ; .long 57 ; .long 57 ; .long 57 +.long 57 ; .long 57 ; .long 57 ; .long 57 +.long 72 ; .long 61 ; .long 34 ; .long 37 +.long 59 ; .long 51 ; .long 58 ; .long 178 +.long 48 ; .long 83 ; .long 66 ; .long 50 +.long 66 ; .long 63 ; .long 88 ; .long 140 +.long 60 ; .long 62 ; .long 44 ; .long 44 +.long 66 ; .long 49 ; .long 41 ; .long 52 +.long 36 ; .long 38 ; .long 42 ; .long 69 +.long 63 ; .long 63 ; .long 63 ; .long 63 +.long 63 ; .long 66 ; .long 54 ; .long 59 +.long 59 ; .long 59 ; .long 57 ; .long 276 +.long 44 ; .long 75 ; .long 91 ; .long 107 +.long 123 ; .long 193 ; .long 68 ; .long 68 +.long 38 ; .long 38 ; .long 38 ; .long 38 +.long 38 ; .long 38 ; .long 38 ; .long 38 +.long 38 ; .long 38 ; .long 38 ; .long 38 +.long 50 ; .long 50 ; .long 58 ; .long 38 +.long 64 ; .long 00 ; .long 205 ; .long 00 +.long 64 ; .long 79 ; .long 112 ; .long 171 +.long 1094 ; .long 136 ; .long 00 ; .long 38 +.long 00 ; .long 66 ; .long 144 ; .long 60 +.long 62 ; .long 57 ; .long 71 ; .long 54 +.long 61 ; .long 61 ; .long 72 ; .long 47 +.long 54 ; .long 60 ; .long 46 ; .long 58 +.long 73 ; .long 88; .long 103 ; .long 181 +.long 68 ; .long 73 ; .long 38 ; .long 38 +.long 38 ; .long 38 ; .long 38 ; .long 38 +.long 38 ; .long 54 ; .long 47 ; .long 47 +.long 47 ; .long 47 ; .long 56 ; .long 47 +.long 50 ; .long 91 ; .long 47 ; .long 47 +.long 47 ; .long 47 ; .long 47 ; .long 51 +.long 71 ; .long 54 ; .long 38 ; .long 38 +.long 54 ; .long 73 ; .long 63 ; .long 99 + +timeinf1: +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 58 +.long 63 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 +.long 40 ; .long 40 ; .long 40 ; .long 40 + +timeinf2: +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 ; .long 29 +.long 29 ; .long 29 ; .long 29 +#else +timeinf: +.long 30 ; .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 75 ; .long 105 ; .long 106 ; .long 34 +.long 53 ; .long 54 ; .long 32 ; .long 00 +.long 146 ; .long 77; .long 30 ; .long 61 +.long 47 ; .long 43 ; .long 43 ; .long 43 +.long 49 ; .long 104 ; .long 36 ; .long 121 +.long 54 ; .long 56 ; .long 56 ; .long 56 +.long 56 ; .long 56 ; .long 56 ; .long 56 +.long 72 ; .long 61 ; .long 34 ; .long 37 +.long 58 ; .long 50 ; .long 57 ; .long 160 +.long 40 ; .long 73 ; .long 56 ; .long 42 +.long 56 ; .long 59 ; .long 80 ; .long 111 +.long 54 ; .long 56 ; .long 40 ; .long 40 +.long 66 ; .long 49 ; .long 41 ; .long 50 +.long 32 ; .long 36 ; .long 38 ; .long 63 +.long 57 ; .long 57 ; .long 57 ; .long 57 +.long 57 ; .long 62 ; .long 48 ; .long 53 +.long 53 ; .long 53 ; .long 53 ; .long 227 +.long 42 ; .long 69 ; .long 83 ; .long 97 +.long 111 ; .long 160 ; .long 62 ; .long 62 +.long 34 ; .long 34 ; .long 34 ; .long 34 +.long 34 ; .long 34 ; .long 34 ; .long 34 +.long 34 ; .long 34 ; .long 34 ; .long 34 +.long 45 ; .long 45 ; .long 58 ; .long 38 +.long 64 ; .long 00 ; .long 71 ; .long 200 +.long 56 ; .long 79 ; .long 103 ; .long 156 +.long 148 ; .long 121 ; .long 00 ; .long 34 +.long 38 ; .long 57 ; .long 128 ; .long 55 +.long 57 ; .long 50 ; .long 66 ; .long 49 +.long 56 ; .long 56 ; .long 68 ; .long 43 +.long 50 ; .long 56 ; .long 46 ; .long 54 +.long 65 ; .long 76; .long 87 ; .long 138 +.long 63 ; .long 68 ; .long 34 ; .long 34 +.long 34 ; .long 34 ; .long 34 ; .long 34 +.long 34 ; .long 49 ; .long 41 ; .long 41 +.long 41 ; .long 41 ; .long 54 ; .long 45 +.long 48 ; .long 73 ; .long 45 ; .long 45 +.long 45 ; .long 45 ; .long 45 ; .long 49 +.long 66 ; .long 49 ; .long 34 ; .long 34 +.long 49 ; .long 68 ; .long 63 ; .long 99 + +timeinf1: +.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 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 35 ; .long 35 +.long 35 ; .long 35 ; .long 35 ; .long 49 +.long 54 ; .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 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 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 + +timeinf2: +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 ; .long 25 +.long 25 ; .long 25 ; .long 25 +#endif +#endif + .text diff --git a/mach/mantra/int/mloop2 b/mach/mantra/int/mloop2 new file mode 100644 index 00000000..b466d822 --- /dev/null +++ b/mach/mantra/int/mloop2 @@ -0,0 +1,488 @@ +!-------------------------------------------------------------------------- +! Load 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) +#ifdef lword + bmi 0f + clr.l -(sp) + bra 1f +0: move.l #-1,-(sp) +1: +#endif + jmp (a4) +ldc_q: +#ifdef lword + tst.l (sp) + bmi 0f + clr.l -(sp) + bra 1f +0: move.l #-1,-(sp) +1: +#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 + asl.w wmu,d0 + mov l0(a2,d0),-(sp) + jmp (a4) + +lol_w_1: move.l #-1,d0 + move.b (a3)+,d0 + asl.w wmu,d0 + mov 0(a2,d0),-(sp) + jmp (a4) +lol_pw: adroff + move.w (a1),d0 +5: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov l0(a0),-(sp) + jmp (a4) + +lol_nw: adroff + move.w (a1),d0 + ext.l d0 +2: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov (a0),-(sp) + jmp (a4) +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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov word(a0),-(sp) + mov (a0),-(sp) + jmp (a4) +ldl_pw: adroff + move.w (a1),d0 +5: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov l1(a0),-(sp) + mov l0(a0),-(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: asl.l wmu,d0 + add.l a6,d0 + move.l d0,a0 +#if test + extptr +7: bra e_badptr +6: +#endif + mov (a0),-(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 + add.l a6,d0 + move.l d0,a0 +#if test + extptr +7: bra e_badptr +6: +#endif + mov word(a0),-(sp) + mov (a0),-(sp) + jmp (a4) + +!------------------------------------------------------------------------------ +lil_0: move.l l0(a2),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov (a0),-(sp) + jmp (a4) +lil_1W: move.l l1(a2),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + move.l l0(a0),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + move.l (a0),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 wrd,d0 +1: move.l (sp)+,a0 + add.l d0,a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov (a0),-(sp) + jmp (a4) +lof_2W: move.l wrd+word,d0 ; bra 1b +lof_3W: move.l wrd+word+word,d0 ; bra 1b +lof_4W: move.l wrd+word+word+word,d0 ; bra 1b +ldf_l: adroff + move.w (a1),d0 + ext.l d0 +2: move.l (sp)+,a0 + add.l d0,a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov word(a0),-(sp) + mov (a0),-(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 +1: add.l #0+l0,d0 + bra 4f +lal_0: pea l0(a2) + jmp (a4) +lal_w0: clr.w d0 + move.b (a3)+,d0 + asl.l wmu,d0 + add.l #0+l0,d0 + bra 3f +lal_n: adroff + move.w (a1),d0 + ext.l d0 + bra 4f +lal_qn: move.l (sp)+,d0 +4: add.l a2,d0 + move.l d0,-(sp) + jmp (a4) +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 +1: add.l a6,d0 + move.l d0,-(sp) + jmp (a4) +lae_q: move.l (sp)+,d0 + bra 1b +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 + pea 0(a6,d0) + jmp (a4) + +!--------------------------------------------------------------------------- +lxl_1: move.l l0(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.l #1,d0 +2: move.l a2,a0 +3: move.l l0(a0),a0 +#if test + locptr +7: bra e_badptr +6: +#endif + 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 l0(a2) + jmp (a4) +1: sub.l #1,d0 +3: move.l a2,a0 +2: move.l l0(a0),a0 +#if test + locptr +7: bra e_badptr +6: +#endif + dbra d0,2b + pea l0(a0) + jmp (a4) + +!----------------------------------------------------------------------- + +loi_l: adroff + clr.l d1 + move.w (a1),d1 + bra 8f +loi_s0: move.l #0,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 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + sub.w #1,d0 +1: mov -(a0),-(sp) + dbra d0,1b + jmp (a4) +2: move.l (sp)+,a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + move.w (a0),d0 + mov d0,-(sp) + jmp (a4) +loi_1: move.l (sp)+,a0 + move.w d6,d0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 diff --git a/mach/mantra/int/mloop3 b/mach/mantra/int/mloop3 new file mode 100644 index 00000000..cdc52480 --- /dev/null +++ b/mach/mantra/int/mloop3 @@ -0,0 +1,294 @@ +!--------------------------------------------------------------------- +! STORE GROUP +!--------------------------------------------------------------------- + +stl_pw: adroff + move.w (a1),d0 +3: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov (sp)+,l0(a0) + 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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + jmp (a4) +stl_0: mov (sp)+,l0(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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + mov (sp)+,word(a0) + 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 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + mov (sp)+,l0(a0) + mov (sp)+,l1(a0) + jmp (a4) + +!------------------------------------------------------------------------ + +sde_q: move.l (sp)+,d0 + bra 1f +sde_l: adroff + move.w (a1),d0 +1: add.l a6,d0 + move.l d0,a0 +#if test + extptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + mov (sp)+,word(a0) + 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 + add.l a6,d0 + move.l d0,a0 +#if test + extptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + jmp (a4) + +!------------------------------------------------------------------------- + +stf_q: move.l (sp)+,a0 + bra 0f +stf_l: adroff + move.l #0,a0 + move.w (a1),a0 + bra 0f +stf_2W: move.l wrd+word,d0 ; move.l d0,a0 + bra 0f +stf_s0: clr.w d0 + move.b (a3)+,d0 + move.l d0,a0 + bra 0f +stf_1W: move.l wrd,d0 ; move.l d0,a0 +0: add.l (sp)+,a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + jmp (a4) +sdf_q: move.l (sp)+,a0 + bra 1f +sdf_l: adroff + move.l d6,a0 + move.w (a1),a0 +1: add.l (sp)+,a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0)+ + mov (sp)+,(a0) + jmp (a4) + + +!----------------------------------------------------------------------------- +sil_w0: move.w d6,d0 + move.b (a3)+,d0 +5: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + move.l l0(a0),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + mov (sp)+,(a0) + jmp (a4) +sil_w_1: move.l #-1,d0 + move.b (a3)+,d0 +2: asl.l wmu,d0 + add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + move.l (a0),a0 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + move.b word-1(sp),(a0) + 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 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif + 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 +#if test + locptr + heaptr + extptr +7: bra e_badptr +6: +#endif +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 + extend d0 + 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) diff --git a/mach/mantra/int/mloop4 b/mach/mantra/int/mloop4 new file mode 100644 index 00000000..cf1d1ee6 --- /dev/null +++ b/mach/mantra/int/mloop4 @@ -0,0 +1,263 @@ +!---------------------------------------------------------------------------- +! 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) +#if test + bvs 9f +#endif + 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 #0+l0,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 + locptr + heaptr + extptr +7: bra e_badptr +6: + comp und,(a0) ;bne 3f + bsr e_iund +3: +#endif + subt #1,(a0) +#if test + bvs 9f +#endif + 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 #0+l0,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 + +#if test +9: bsr e_iovfl !error routine for integer overflow + jmp (a4) +#endif + +!---------------------------------------------------------------------------- + +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 ; add.l a2,d0 + move.l d0,a0 +#if test + locptr +7: bra e_badptr +6: +#endif + cl (a0) + 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 ; add.l a2,d0 + move.l d0,a0 ; cl l0(a0) + 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 ; add.l a6,d0 + move.l d0,a0 +#if test + extptr +7: bra e_badptr +6: +#endif + cl (a0) + 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 ; move.l #0,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 + + diff --git a/mach/mantra/int/mloop5 b/mach/mantra/int/mloop5 new file mode 100644 index 00000000..80b54c44 --- /dev/null +++ b/mach/mantra/int/mloop5 @@ -0,0 +1,186 @@ +!-----------------------------------------------------------------------------. +! 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> temp.c +../../../lib/cpp -P temp.c >$2 diff --git a/mach/moon3/ncg/Makefile b/mach/moon3/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/moon3/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/ns/Action b/mach/ns/Action new file mode 100644 index 00000000..ba12d9fe --- /dev/null +++ b/mach/ns/Action @@ -0,0 +1,3 @@ +name "NS16032 assembler" +dir as +end diff --git a/mach/ns/ncg/Makefile b/mach/ns/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/ns/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/pdp/Action b/mach/pdp/Action new file mode 100644 index 00000000..fbe1967a --- /dev/null +++ b/mach/pdp/Action @@ -0,0 +1,26 @@ +name "PDP 11 assembler" +dir as +end +name "PDP 11 backend" +dir cg +end +name "PDP 11 interpreter" +system pdp* +dir int +end +name "PDP 11 C libraries" +system pdp* +dir libcc +end +name "PDP 11 EM library" +system pdp* +dir libem +end +name "PDP 11 Pascal library" +system pdp* +dir libpc +end +name "PDP 11 Basic library" +system pdp* +dir libbc +end diff --git a/mach/pdp/cg/Makefile b/mach/pdp/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/pdp/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/pdp/cg/mach.c b/mach/pdp/cg/mach.c new file mode 100644 index 00000000..24602f09 --- /dev/null +++ b/mach/pdp/cg/mach.c @@ -0,0 +1,243 @@ +#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;i6) { + 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=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 + +/* + * (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); +} diff --git a/mach/pdp/cg/table b/mach/pdp/cg/table new file mode 100644 index 00000000..8f645730 --- /dev/null +++ b/mach/pdp/cg/table @@ -0,0 +1,2849 @@ +"$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" ) diff --git a/mach/pdp/int/Makefile b/mach/pdp/int/Makefile new file mode 100644 index 00000000..cb8fcac4 --- /dev/null +++ b/mach/pdp/int/Makefile @@ -0,0 +1,48 @@ +INTS=em_t--- em_---- em_tf-- em_t-c- em_t--p +b=../../../lib/int22 + +all: $(INTS) eminform em + +em: em.c + cc -o em -I../../../h em.c + +eminform: eminform.s + as eminform.s;ld -i -o eminform a.out -lc + +em_t---: t+ f- c- p- em_int.s + as t+ f- c- p- em_int.s;ld -i -o em_t--- a.out -lc + +em_----: t- f- c- p- em_int.s + as t- f- c- p- em_int.s;ld -i -o em_---- a.out -lc + +em_tf--: t+ f+ c- p- em_int.s + as t+ f+ c- p- em_int.s;ld -i -o em_tf-- a.out -lc + +em_t-c-: t+ f- c+ p- em_int.s + as t+ f- c+ p- em_int.s;ld -i -o em_t-c- a.out -lc + +em_t--p: t+ f- c- p+ em_int.s + as t+ f- c- p+ em_int.s;ld -i -o em_t--p a.out -lc + +install: all + -mkdir $b + cp em_???? $b + cp em eminform ../../../bin + +cmp: all + cmp em_t--- $b/em_t--- + cmp em_---- $b/em_---- + cmp em_tf-- $b/em_tf-- + cmp em_t-c- $b/em_t-c- + cmp em_t--p $b/em_t--p + cmp em ../../../bin/em + cmp eminform ../../../bin/eminform + +clean: + -rm -f *.o *.old a.out em eminform $(INTS) + +opr: + make pr | opr + +pr: + @pr em.c em_int.s eminform.s diff --git a/mach/pdp/int/README b/mach/pdp/int/README new file mode 100644 index 00000000..2677deb4 --- /dev/null +++ b/mach/pdp/int/README @@ -0,0 +1,19 @@ +In this directory is a complete interpreter for EM-code on a +PDP 11, written in Unix assembly language. +The interpreter is split up in 7 files, em.v1 up to em.v7. +There exist assembler options .test .opfreq .flow .count .prof +and .last. +.test tests undefined integers, bad arrays etcetera +.opfreq makes a table of the usage of othe em-opcodes +.flow makes a table of the used lines +.count makes a count table of the used lines +.prof estimates the amount of time spent on each source line +.last gives a table of the last executed lines and files +The interpreter writes its runtime information on a file +em_runinf, which is converted to human readable files +em_last, em_opfreq, em_profile, em_flow and em_count by +the program eminform, for which we also have an assembler +source in this directory. +Because the size of the interpreter just exceeds 8k, it is +advisible to have either .prof or .test turned off on a machine +without separate I and D when a large user program is running. diff --git a/mach/pdp/int/c+ b/mach/pdp/int/c+ new file mode 100644 index 00000000..56c4c1d9 --- /dev/null +++ b/mach/pdp/int/c+ @@ -0,0 +1 @@ +.count = 1 diff --git a/mach/pdp/int/c- b/mach/pdp/int/c- new file mode 100644 index 00000000..f8b8e6ca --- /dev/null +++ b/mach/pdp/int/c- @@ -0,0 +1 @@ +.count = 0 diff --git a/mach/pdp/int/em.c b/mach/pdp/int/em.c new file mode 100644 index 00000000..c62b007e --- /dev/null +++ b/mach/pdp/int/em.c @@ -0,0 +1,132 @@ +/* + * (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 +#include +#include + +char rcs_id[] = "$Header$" ; + +#define MAGIC 07255 + +struct header { + short h_magic; /* Magic number */ + short h_flags; /* See below for defines */ + short h_unresolved; /* Cannot run if nonzero */ + short h_version; /* Check for VERSION */ + short h_wsize; + short h_psize; + short h_unused[2]; /* left over */ +} header; + +#define TEST 001 +#define PROFILE 002 +#define FLOW 004 +#define COUNT 010 + +char *defargv[] = { + "em", + "e.out", + 0 +}; + +char interpret[BUFSIZ]; +char flags[5]; +char tflg,fflg,cflg,pflg; + +main(argc,argv) char **argv; { + char *file; + int fildes; + + while (argc>1 && (argv[1][0]=='-' || argv[1][0]=='+')) { + switch(argv[1][1]) { + case 't': tflg=argv[1][0]; break; + case 'c': cflg=argv[1][0]; break; + case 'f': fflg=argv[1][0]; break; + case 'p': pflg=argv[1][0]; break; + default: + fprintf(stderr,"Bad flag %c\n",argv[1][1]); + exit(-1); + } + argv[1] = argv[0]; + argc--;argv++; + } + if (argc==1) + argv= defargv; + file=argv[1]; + if ((fildes=open(file,0))<0) { + perror(file); + exit(8) ; + } + header.h_magic= r2b(fildes,file) ; + header.h_flags= r2b(fildes,file) ; + header.h_unresolved= r2b(fildes,file) ; + header.h_version= r2b(fildes,file) ; + header.h_wsize= r2b(fildes,file) ; + header.h_psize= r2b(fildes,file) ; + header.h_unused[0]= r2b(fildes,file) ; + header.h_unused[1]= r2b(fildes,file) ; + if (header.h_magic != MAGIC) { + fprintf(stderr,"%s not in correct format\n",file); + exit(-1); + } + if (header.h_version != VERSION) { + fprintf(stderr,"%s obsolete, recompile\n",file); + exit(-1); + } + if (header.h_unresolved != 0) { + fprintf(stderr, + "%s has unresolved references, cannot run it\n",file); + exit(-1); + } + /* + if ( header.h_psize!=EM_PSIZE) { + fprintf(stderr, + "%s cannot be interpreted on this machine\n",file); + exit(-1); + } + */ + if (tflg) + flags[0] = tflg=='+' ? 't' : '-'; + else + flags[0]= header.h_flags&TEST ? 't' : '-'; + if (fflg) + flags[1] = fflg=='+' ? 'f' : '-'; + else + flags[1]= header.h_flags&FLOW ? 'f' : '-'; + if (cflg) + flags[2] = cflg=='+' ? 'c' : '-'; + else + flags[2]= header.h_flags&COUNT ? 'c' : '-'; + if (pflg) + flags[3] = pflg=='+' ? 'p' : '-'; + else + flags[3]= header.h_flags&PROFILE ? 'p' : '-'; + sprintf(interpret,"%s/lib/int%d%d/em_%s", + EM_DIR,header.h_wsize,header.h_psize,flags); + execv(interpret,argv); + fprintf(stderr,"Interpreter %s not available\n",interpret); +} + +r2b(fildes,file) char *file ; { + char rd2[2] ; + if ( read(fildes,rd2,sizeof rd2)!=sizeof rd2) { + fprintf(stderr,"%s too short\n",file); + exit(-1); + } + return (rd2[0]&0xFF) | ( (rd2[1]&0xFF)<<8 ) ; +} diff --git a/mach/pdp/int/em_int.s b/mach/pdp/int/em_int.s new file mode 100644 index 00000000..d80367a1 --- /dev/null +++ b/mach/pdp/int/em_int.s @@ -0,0 +1,3793 @@ +/ +/ (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 +/ +/ +/------------------------------------------------------------------------------ +/ +/ This is an interpreter for EM programs with no virtual memory +/ which is adapted from an EM1 interpreter by Hans van Staveren +/ by Evert Wattel +/ Vrije Universiteit +/ Amsterdam +/ +/ Memory layout: +/ +/ interpreter em-text pd global tables heap unused stack +/ __________________________________________________________________ +/ | | | | | | | | | | +/ | | | | | | | | | | +/ | 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: flow, count and profile tables +/ 6: EM heap area +/ 7: EM local data and stack +/ 8: Arguments to interpreter +/ +/ Assembly time flags: +/ .test : controls checking for undefined variables,nil pointers, +/ array indices, etc.... +/ .prof : controls generation of a runtime profile +/ .opfreq: controls runtime frequency count per opcode +/ .flow : controls generation of a flow bitmap +/ .count : controls generation of a flow count +/ .last : controls generation of file with last 16 +/ consecutive blocks of lines executed +/ +/ Register layout: +/ pcx = EM programcounter +/ lb = EM base-address +/ nxt = address of start of interpreter loop +/ +/ The general structure of this interpreter is as follows: +/ The opcode byte of the instruction is placed in r0 +/ with sign-extension and multiplied by 2. +/ If .opfreq is nonzero each occurence of each opcode is counted. +/ Then, if .prof is nonzero an estimation of the time required +/ to execute the instruction is added to a counter associated +/ with the source-line number. This estimation is roughly the +/ number of memory-cycles needed. At the end of this accounting +/ loprof points to the loword of the double precision counter. +/ This can be used by individual execution routines to add some +/ more to the counter depending on their operand. +/ +/ NOTE: This interpreter can be loaded in separate I and D space +/ +/ +/------------------------------------------------------------------------------ +/ Declaring of some constants +/------------------------------------------------------------------------------ + + nxt = r4 + pcx = r3 + lb = r2 + + statd = -8. + + unixextra= 1280. / extra memory asked by heap overflow + und = 100000 / undefined memory pattern + signext = 177400 / high bits for signextension + EINVAL = 22. / UNIX error code for bad signal + +/ Interpreter options + .float = 1 + .opfreq = 0 + .last = 1 + V7 = 1 + V6 = 0 + VPLUS = 0 + HARDWARE_FP = 1 +/------------------------------------------------------------------------------ +/ EM1 machine errors (in the range 0-63) +/------------------------------------------------------------------------------ + + 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. + +/------------------------------------------------------------------------------ +/ Declaring of some instructions unknown to the assembler +/------------------------------------------------------------------------------ + + next = 10407 / = mov nxt,pc; jump to decode loop + rti = 2 / return from interrupt + iot = 4 / force core dump + stst = 170300^tst / store floating point status + indir = 0 / for sys indir + exit = 1 + fork = 2 + read = 3 + write = 4 + open = 5 + close = 6 + creat = 8. + break = 17. + alarm = 27. + pause = 29. + sleep = 35. + signal = 48. + +/------------------------------------------------------------------------------ +/ External references +/------------------------------------------------------------------------------ + + .globl _end + +/ +/------------------------------------------------------------------------------ +/ Now the real program starts +/------------------------------------------------------------------------------ + +startoff: + mov sp,r0 + mov sp,ml + mov 02(sp),filb / pointer to argv in filb for error message + dec (r0) + mov (r0)+,argc / pass to userprogram later + bgt 0f / go for argument + mov $emfile,forward+2 / e.out is load file default + mov $forward+2,argv + br 1f +0: + tst (r0)+ / skip interpreter name + mov r0,argv / pass to userprogram later + mov (r0),forward+2 / argv filename to open call +1: +.if V7 + tst (r0)+ / increment r0 look for last arg + bne 1b + mov r0,environ +.endif + sys indir;forward + .data +forward: sys open;0;0 +emfile: +.even + .text + jes badarg + mov r0,saver0 / save filedescriptor + mov r0,r5 / duplicate filedescriptor + sys read;header;16. / skip first header + jes badarg / failed + mov r5,r0 / recall fildes + sys read;header;16. / read second header + jes badarg / failed + cmp r0,$16. / long enough ? + jne badarg / no. + mov $_end,r0 / Bottom em-text + mov r0,pb / program base + add txtsiz,r0 / reserve space for text + mov r0,pd / set up proc.descr base + mov nprocs, r3 / number of procs + ash $2,r3 / proc. descr is 4 bytes +.if .count +.prof + .flow + mul $3,r3 / or 12 bytes +.endif + add r3,r0 / reserve space + mov r0,eb / top of pd space + mov r0,r3 / base for data fill + + add szdata,r0 / size of external data + jcs toolarge / too much text and data + mov r0,globmax / maximum global + add $1280.,r0 / bit extra core for setup + mov r0,sybreak+2 / set up for core claim + sys indir;sybreak / ask for the core + jes toolarge / too much, sorry + + mov txtsiz,leescal+4 / set up for text read + mov pb,leescal+2 / start address text read + mov r5,r0 / file descriptor input + sys indir;leescal / read!! + .data +leescal: +1: sys read;0;0 / read call + .text +lblread: + + +/ hier is nu dus de tekst ingelezen. De sybreak voor de +/ tabellen en de data moet opnieuw gebeuren. + + +.if .last + mov $47.,r0 + mov $lasttab,r5 +3: clr (r5)+ + sob r0,3b + mov $-1,(r5) + sub $96.,r5 + mov r5,linused +.endif +lblfloat: +.if .float + sys signal;8.;sig8 / catch floating exception + ldfps $7600 + movf $50200,fr3 / load 2^32 in fr3 for conversion + / unsigned to float +.endif + + + sys signal;11.;sig11 / catch segmentation violation + sys signal;12.;sig12 / catch bad system calls + + / We make a 1024 buffer for reading in + / data descriptors. When the number of + / bytes in the buffer is less than 512 + / we read another block. Descriptors of + / more than 512 bytes are not allowed. + / This is no restriction since they do + / not fit in the descriptor format. +lblbuf: + + sub $02000,sp / new buffer bottom + tst (sp) / ask for core + mov sp,r4 / pointer in descriptor + mov saver0,r0 / recall fildes + clr r1 / clear registers for byte + clr r2 / format instruction and data + mov sp,r5 / copy + mov r5,leescal+2 / set up for read + mov $02000,leescal+4 / idem + sys indir;leescal / read + jes badarg / read failed + cmp $02000,r0 / not yet eof? + bgt 0f / eof encountered + + add $01000,r5 / buffer middle + mov r5,saver1 / save buffermiddle to compare + br datloop / start data initialization +0: add r0,r5 / now pointer at top of file + mov r5,saver1 / still set up for compare + + + + +datloop: + cmp r4,saver1 / descriptor over middle? + ble 9f / no? go ahead + jsr pc,blshift / yes? shift block down, read next + +9: dec ndatad / still data to initialize? + blt finito / no? go on + movb (r4)+,r1 / opcode descriptor + beq 0f / if 0 then go there + mov r3,r5 / copy data pointer + clr r2 / unsigned integer byte + bisb (r4)+,r2 / "ored" in for data size + asl r1 / make opcode even + mov datswi(r1),pc / main data swich + +.data +datswi: 0; dat1; dat2; dat3; dat4; dat5; dat6; dat6; dofloat +.text +dat3: asl r2 / multiply with 2 +dat2: 2: movb (r4)+,(r3)+ / copy byte from buffer to data + sob r2,2b / until r2 is 0 + br datloop / next datadescriptor + + +dat4: mov eb,r0 / external base should be added + br 2f / for data pointers + +dat5: mov pb,r0 / and program base for procedures + +2: movb (r4)+,(r3) / move in first byte of pointer + movb (r4)+,1(r3) / move in second byte of pointer + add r0,(r3)+ / add pointer base + sob r2,2b / jump back if there is more + br datloop / next data descriptor + +dat1: mov $und,(r3)+ / reserve words with undefineds + sob r2,2b / jump back if more + br datloop / next data descriptor + +0: mov r3,r1 / copy data pointer (odd register) + sub r5,r1 / subtract previous pointer + movb (r4)+,(r3) / copy first byte of operand + movb (r4)+,1(r3) / copy second byte + mul (r3),r1 / the number of bytes to copy +1: movb (r5)+,(r3)+ / is the product of the operand + sob r1,1b / and the number of bytes in the + br datloop / previous operation + +dat6: add r2,r3 / new data pointer, the old is + mov r3,r0 / still in r5 + asr r2 / divide by 2 + beq 6f / case 1 byte is special + sub $2,r0 / this is the least significant + / byte in PDP11-standard +2: movb (r4)+,(r0)+ / copy low byte + movb (r4)+,(r0) / copy high byte + sub $3,r0 / next lowest byte + sob r2,2b / jump if not ready + br datloop / next descriptor +6: movb (r4)+,(r5) / copy one byte + br datloop / next descriptor + +blshift: + mov saver1,r1 / bottom of top half + mov r1,r2 / set up bottom + sub $01000,r2 + mov $1000,r0 / number to copy + mov r0,leescal+4 / amount to read + sub r0,r4 / decrease pointer + asr r0 / 512 bytes is 256 words +3: mov (r1)+,(r2)+ / copy top half in bottom half + sob r0,3b + mov saver1,leescal+2 / set up for read +blockr: + mov saver0,r0 / filedescriptor + sys indir;leescal + jes badarg + clr r1 / clear registers which contain + clr r2 / descriptor bytes later + cmp $01000,r0 / look if eof is encountered + beq 3f / yes? go on + add r0,saver1 / no extra read necessary +3: rts pc + +finito: + cmp globmax,r3 / test if data size ok + jne badarg / load file error + mov eb,filb + add $4,filb + + + mov nprocs,r5 / set up for procdesc read + mov pd,r3 / proc descriptor base + asl r5 / multiply with 4 because + asl r5 / procdes is 4 bytes +1: mov saver1,r1 / look what is available + sub r4,r1 / in buffer to be read + add $3,r1 / let it be a multiple + bic $3,r1 / of four + sub r1,r5 / subtract what can be read + asr r1; asr r1; / divide by four +0: + movb (r4)+,(r3)+ / copy byte + movb (r4)+,(r3)+ / copy byte + movb (r4)+,(r3)+ / copy byte + movb (r4)+,(r3)+ / copy byte + add pb,-2(r3) / change em-address in pdp-address +.if .count + .prof + .flow + clr (r3)+ + clr (r3)+ + clr (r3)+ + clr (r3)+ +.endif + sob r1,0b / look if there is more + tst r5 / is there still a descriptor + ble 2f; / no? go on + jsr pc,blshift / yes? read again + br 1b + +2: + cmp eb,r3 / test if procdes is ok + jne badarg / load file error + mov saver0,r0 / fildes in r0 + sys close / close input load file + mov ml,sp / fresh stack + mov 2(sp),*filb +.if .flow + .count + .prof +/ |==================| +/ Here we fill the fields in the procedure | bytes for locals | +/ descriptor with table information. The |------------------| +/ procedure descriptor has six fields, | start address | +/ like described in this picture. We |------------------| +/ construct a linked list of the proc. | count pointer | +/ descriptors, such that the defined |------------------| +/ order of procedures is compatible | first line nr | +/ with the text order. Thereafter we |------------------| +/ scan the text for line information to | link next proc | +/ fill the countpointer and startline |------------------| +/ field. The link to the first proc. | current file name| +/ 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. + +makelink: + mov pd,r0 / first descriptor + mov r0,r3 / points to first proc + mov r0,r4 / pd in register + mov eb,r5 / eb in register + +0: mov r0,r1 / copy old descriptor bottom + add $12.,r0 / next descriptor + cmp r0,r5 / top of descriptor space + bhis 4f / ready? continue +1: cmp 2(r0),2(r1) / compare start addresses + bhis 2f / 2(r0) large? follow link + sub $12.,r1 / 2(r0) small? previous descriptor + cmp r1,r4 / is r1 smaller than pd? + bhis 1b / no? try again + mov r3,8.(r0) / yes? then r0 has small text address + mov r0,r3 / now r3 again points to first proc + br 0b / next descriptor + +2: mov 8.(r1),r2 / follow link to compare with 2(r0) + beq 3f / if 0 then no link defined + cmp 2(r0),2(r2) / compare start addresses + blo 3f / r0 between r1 and r2 + mov r2,r1 / r0 above r2, + br 2b / look again. + +3: mov r0,8.(r1) / link of r1 points to r0 + mov r2,8.(r0) / link of r0 points to r2 + br 0b / next descriptor + +4: mov r3,firstp / firstp links to first procedure + +procinf: + mov $1,maxcount / countptr for first proc + mov r3,r4 / points to first proc + +0: mov r3,-(sp) / stack current procedure + mov $-1,r1 / minimal line number 0177777 + clr r5 / maximum line number on 0 + mov 8.(r3),r4 / bottom address next descriptor + beq 6f / if 0 last procedure + mov 2(r4),r4 / top of current procedure + br 2f / start looking for lines +6: mov pd,r4 / top of last procedure +2: + mov 2(r3),r3 / start text address procedure +8: movb (r3)+,r2 / first opcode for scanning + cmp $-2,r2 / case escape + beq 1f / escape treated at label 1 + cmp $-106.,r2 / case lni + blt 7f / ordinary skip at label 7 + beq 2f / lni treated at label 2 + cmp $-108.,r2 / case lin.l + bgt 7f / ordinary skip at label 7 + beq 3f / lin.l at label 3 + clr r0 / lin.s0 treated here + bisb (r3)+,r0 / line number in r0 + br 4f / compares at label 4 +2: inc r0 / lni increases line number + br 4f / compares at label 4 +3: jsr pc,wrdoff / get 2 byte number +4: + cmp r1,r0 / look if r0 less than minimum + blo 5f / nothing to declare + mov r0,r1 / r0 new minimum +5: cmp r0,r5 / look if r0 more than maximum + blo 9f / nothing spectacular + mov r0,r5 / r0 new maximum + br 9f / line processed + +1: clr r2 + bisb (r3)+,r2 / escaped instruction opcode + add $128.,r2 / ready for table entry +7: movb skipdisp(r2),r2 / skip the required number of bytes + add r2,r3 + +9: cmp r3,r4 / still more text in this proc? + blt 8b / yes? again +filpd: + mov (sp)+,r3 / get bottom descriptor back + sub r1,r5 / number of lines encountered + bcs 9f / no lines then no file information + mov maxcount,4(r3) / this is the count pointer + mov r1,6(r3) / minimum line in descriptor + inc r5 + add r5,maxcount / this is the new maximum +9: mov 8.(r3),r3 / follow link to next procedure + bne 0b / restart +.data +.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; + +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; + +/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 + mov globmax,r3 / bottom of table space + mov r3,r5 / copy +.if .prof + mov r3,ltime / set up pointer to base +mov r3,hiprof +mov r3,loprof +add $2,loprof + mov maxcount,r0 / number of lines + inc r0 + asl r0 / four byter per prof count + asl r0 + add r0,r3 + mov r0,profsiz +.endif +.if .flow + mov r3,lflow / set up pointer to base + mov maxcount,r0 + ash $-3,r0 / divide by 8 + add $2,r0 + bic $1,r0 / Rounded up to an integral number of words + add r0,r3 + mov r0,flowsiz +.endif +.if .count + mov r3,lcount / set up pointer + mov maxcount,r0 + inc r0 + ash $2,r0 / multiply by 4 + add r0,r3 + mov r0,countsiz +.endif + mov r3,tblmax + cmp r3,sybreak+2 / core available for tables? + blos 2f + mov r3,sybreak+2 + sys indir;sybreak / ask for core +2: sub r5,r3 / this amount of space required + asr r3 +2: clr (r5)+ / clear table space + sob r3,2b +.endif +.if [1 - .count] * [1 - .flow] * [1 - .prof] + mov globmax,tblmax +.endif + + / start calling sequence here +calseq: + mov tblmax,hp + mov pd,r3 / top of em-text and top of stack + clr r2 / are dummy return values + mov environ,-(sp) / setup environment pointer + mov argv,-(sp) / setup argument pointer + mov *argv,*filb / setup first file message + mov argc,-(sp) / setup argument count + mov entry.,-(sp) / start procedure to call +precal: + mov $loop,r4 / main loop address in r4 + jbr cai.z / according to the cai + +noarg: mov r0,argv + mov $0f,r0; jbr rude_error +badarg: mov $1f,r0; jbr rude_error +toolarge:mov $2f,r0; jbr rude_error + + + .data +0: +1: +2: + .even + .text + + +dofloat: + jsr pc,atof + mov r5,r3 / restore r3 + / Assumed that the result is 8 + / bytes Recall r2 and move the + / amount of bytes asked for + clr r1 / restore for opcode + sub $8.,r2 / 8 bytes? + beq 1f / yes! later, 4 bytes next + movfo fr0,-(sp) / push result + mov (sp)+,(r3)+ / write result in data + mov (sp)+,(r3)+ / idem + jbr datloop / next loop +1: movf fr0,-(sp) / push result + mov (sp)+,(r3)+ / write result in data + mov (sp)+,(r3)+ / write result in data + mov (sp)+,(r3)+ / write result in data + mov (sp)+,(r3)+ / write result in data + jbr datloop +atof: + mov r2,-(sp) / save byte count + clr -(sp) + clrf fr0 + clr r2 +1: + movb (r4)+,r0 / get byte + cmp $' ,r0 + bge 1b + cmpb r0,$'+ + beq 1f + cmpb r0,$'- + bne 2f + inc (sp) +1: + movb (r4)+,r0 / get next byte +2: + sub $'0,r0 + cmp r0,$9. + bhi 2f + jsr pc,digit + br 1b + inc r2 + br 1b +2: + cmpb r0,$'.-'0 + bne 2f +1: + movb (r4)+,r0 / get next byte + sub $'0,r0 + cmp r0,$9. + bhi 2f + jsr pc,digit + dec r2 + br 1b +2: + cmpb r0,$'E-'0 + beq 3f + cmpb r0,$'e-'0 + bne 1f +3: + clr r3 + clr r1 + movb (r4)+,r0 / get next byte + cmpb r0,$'+ + beq 3f + cmpb r0,$'- + bne 5f + inc r3 +3: + movb (r4)+,r0 / get next byte +5: + sub $'0,r0 + cmp r0,$9. + bhi 3f + mul $10.,r1 + add r0,r1 + br 3b +3: + tst r3 + bne 3f + neg r1 +3: + sub r1,r2 +1: + movf $one,fr1 + movf $one,fr2 + mov r2,-(sp) + beq 2f + bgt 1f + neg r2 +1: + mulf $twohalf,fr1 + mulf $four,fr2 + sob r2,1b +2: + tst (sp)+ + bge 1f + divf fr1,fr0 + divf fr2,fr0 + br 2f +1: + mulf fr1,fr0 + mulf fr2,fr0 +2: + tst (sp)+ + beq 1f + negf fr0 +1: mov (sp)+,r2 + rts pc + + +digit: + cmpf $big,fr0 + cfcc + blt 1f + mulf $ten,fr0 + movif r0,fr1 + addf fr1,fr0 + rts pc +1: + add $2,(sp) + rts pc +/ +/ +one = 40200 +twohalf = 40440 +four = 40600 +ten = 41040 +big = 56200 +huge = 77777 + + +/------------------------------------------------------------------------------ +/------------------------------------------------------------------------------ +/ Main loop of interpreter starts here +/------------------------------------------------------------------------------ + +loop: + movb (pcx)+,r0 / pickup opcode + sign extend +9: asl r0 / opcode now -256 .. 254 & even + +.if .opfreq + mov r0,r1 + asl r1 / multiply by two again + add $1,counttab+514.(r1) / cannot be inc + adc counttab+512.(r1) / double precision counters +.endif +.if .prof + add timeinf(r0),*loprof + adc *hiprof / double precision +.endif + mov dispat(r0),pc / fast dispatch + +/------------------------------------------------------------------------------ +/ Two byte opcodes come here for decoding of second byte +/------------------------------------------------------------------------------ + +escape1: + clr r0 + bisb (pcx)+,r0 / fetch second byte no sign extend + asl r0 / 0 to 512 & even + cmp $0500,r0 / look for righ range + jlt e.illins + +.if .opfreq + mov r0,r1 + asl r1 / multiply by two again + add $1,counttab+1026.(r1) / cannot be inc + adc counttab+1024.(r1) / double precision counters +.endif +.if .prof + add time2inf(r0),*loprof + adc *hiprof / double precision +.endif + mov dispae1(r0),pc / fast dispatch + +/---------------------------------------------------------------------------- +escape2: + movb (pcx)+,r0 / fetch second byte and sign extend + jne e.illins + +.if .opfreq + add $1,counttab+1666. / cannot be inc + adc counttab+1664. / double precision counters +.endif + jbr loc.f / fast dispatch +/------------------------------------------------------------------------------ +/ dispatch tables, first the unescaped opcodes +/ +/ name convention is as follows: +/ each execution routine has as a name the name of the instruction +/ followed by a dot and a suffix. +/ suffix can be an integer (sometimes followed by a W), +/ an 's'or a 'w', followed by an integer, an 'l' ,a 'p' , +/ a 'n', sometimes followed by a 'w', or a 'z'. +/ loc.1 routine to execute loc 1 +/ zge.s0 routine to execute zge 0 thru 255 +/ lae.w1 routine to execute lae 1024 thru lae 2046 +/ lof.2W routine to execute lof 2*the word size +/ lol.pw routine to execute positive lol instructions +/ loe.l routine to execute all loe instructions +/ add.z routine to execute instruction without operand +/ or with operand on the stack. +/------------------------------------------------------------------------------ + .data + + + +lal.p; lal.n; lal.0; lal._1; lal.w0; lal.w_1; lal.w_2; lar.1W +ldc.0; lde.lw; lde.w0; ldl.0; ldl.w_1; lfr.1W; lfr.2W; lfr.s0 +lil.w_1; lil.w0; lil.0; lil.1W; lin.l; lin.s0; lni.z; loc.l +loc._1; loc.s0; loc.s_1; loe.lw; loe.w0; loe.w1; loe.w2; loe.w3 +loe.w4; lof.l; lof.1W; lof.2W; lof.3W; lof.4W; lof.s0; loi.l +loi.1; loi.1W; loi.2W; loi.3W; loi.4W; loi.s0; lol.pw; lol.nw +lol.0; lol.1W; lol.2W; lol.3W; lol._1W; lol._2W; lol._3W; lol._4W +lol._5W; lol._6W; lol._7W; lol._8W; lol.w0; lol.w_1; lxa.1; lxl.1 +lxl.2; mlf.s0; mli.1W; mli.2W; rck.1W; ret.0; ret.1W; ret.s0 +rmi.1W; sar.1W; sbf.s0; sbi.1W; sbi.2W; sdl.w_1; set.s0; sil.w_1 +sil.w0; sli.1W; ste.lw; ste.w0; ste.w1; ste.w2; stf.l; stf.1W +stf.2W; stf.s0; sti.1; sti.1W; sti.2W; sti.3W; sti.4W; sti.s0 +stl.pw; stl.nw; stl.0; stl.1W; stl._1W; stl._2W; stl._3W; stl._4W +stl._5W; stl.w_1; teq.z; tgt.z; tlt.z; tne.z; zeq.l; zeq.s0 +zeq.s1; zer.s0; zge.s0; zgt.s0; zle.s0; zlt.s0; zne.s0; zne.s_1 +zre.lw; zre.w0; zrl._1W; zrl._2W; zrl.w_1; zrl.nw; escape1; escape2 + + +dispat: / dispatch table for unescaped opcodes + + +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; aar.1W; adf.s0; adi.1W; adi.2W; adp.l ; adp.1 +adp.2; adp.s0; adp.s_1; ads.1W; and.1W; asp.1W; asp.2W; asp.3W +asp.4W; asp.5W; asp.w0; beq.l; beq.s0; bge.s0; bgt.s0; ble.s0 +blm.s0; blt.s0; bne.s0; bra.l; bra.s_1; bra.s_2; bra.s0; bra.s1 +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; cal.s0; cff.z; cif.z; cii.z +cmf.s0; cmi.1W; cmi.2W; cmp.z; cms.s0; csa.1W; csb.1W; dec.z +dee.w0; del.w_1; dup.1W; dvf.s0; dvi.1W; fil.l; inc.z; ine.lw +ine.w0; inl._1W; inl._2W; inl._3W; inl.w_1; inn.s0; ior.1W; ior.s0 +lae.l; lae.w0; lae.w1; lae.w2; lae.w3; lae.w4; lae.w5; lae.w6 + + + +/------------------------------------------------------------------------------ +/ now dispatch table for escaped opcodes +/------------------------------------------------------------------------------ + +dispae1: /dispatch escaped opcodes 1 + +aar.l; aar.z; adf.l; adf.z; adi.l; adi.z; ads.l; ads.z +adu.l; adu.z; and.l; and.z; asp.lw; ass.l; ass.z; bge.l +bgt.l; ble.l; blm.l; bls.l; bls.z; blt.l; bne.l; cai.z +cal.l; cfi.z; cfu.z; ciu.z; cmf.l; cmf.z; cmi.l; cmi.z +cms.l; cms.z; cmu.l; cmu.z; com.l; com.z; csa.l; csa.z +csb.l; csb.z; cuf.z; cui.z; cuu.z; dee.lw; del.pw; del.nw +dup.l; dus.l; dus.z; dvf.l; dvf.z; dvi.l; dvi.z; dvu.l +dvu.z; fef.l; fef.z; fif.l; fif.z; inl.pw; inl.nw; inn.l +inn.z; ior.l; ior.z; lar.l; lar.z; ldc.l; ldf.l; ldl.pw +ldl.nw; lfr.l; lil.pw; lil.nw; lim.z; los.l; los.z; lor.s0 +lpi.l; lxa.l; lxl.l; mlf.l; mlf.z; mli.l; mli.z; mlu.l +mlu.z; mon.z; ngf.l; ngf.z; ngi.l; ngi.z; nop.z; rck.l +rck.z; ret.l; rmi.l; rmi.z; rmu.l; rmu.z; rol.l; rol.z +ror.l; ror.z; rtt.z; sar.l; sar.z; sbf.l; sbf.z; sbi.l +sbi.z; sbs.l; sbs.z; sbu.l; sbu.z; sde.l; sdf.l; sdl.pw +sdl.nw; set.l; set.z; sig.z; sil.pw; sil.nw; sim.z; sli.l + + + + + + +sli.z; slu.l; slu.z; sri.l; sri.z; sru.l; sru.z; sti.l +sts.l; sts.z; str.s0; tge.z; tle.z; trp.z; xor.l; xor.z +zer.l; zer.z; zge.l; zgt.l; zle.l; zlt.l; zne.l; zrf.l +zrf.z; zrl.pw; dch.z; exg.s0; exg.l; exg.z; lpb.z; gto.l + +/------------------------------------------------------------------------------ +/ timeinf tables, first the unescaped opcodes +/ these tables are parallel to the tables dispat and dispae1 +/ Each entry contains a reasonable estimate of +/ the number of memory-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 memory-cycles needed to decode the instruction. +/ This number is currently 6. The number is computed for +/ the case that all check and runinf options are off. +/------------------------------------------------------------------------------ +.if .prof +23.; 23.; 12.; 12.; 18.; 17.; 19.; 61. +11.; 31.; 21.; 15.; 20.; 30.; 30.; 31. +20.; 18.; 18.; 19.; 29.; 18.; 13.; 20. +10.; 14.; 13.; 27.; 20.; 20.; 20.; 20. +20.; 23.; 16.; 16.; 16.; 16.; 17.; 38. +14.; 26.; 26.; 26.; 26.; 28.; 26.; 25. +11.; 11.; 11.; 11.; 11.; 11.; 11.; 11. +11.; 11.; 11.; 11.; 16.; 16.; 26.; 24. + +24.; 53.; 25.; 25.; 18.; 27.; 44.; 54. +30.; 59.; 53.; 21.; 28.; 19.; 51.; 18. +18.; 21.; 27.; 19.; 20.; 18.; 25.; 16. +16.; 15.; 12.; 24.; 24.; 24.; 24.; 25. +26.; 25.; 15.; 13.; 11.; 11.; 11.; 11. +11.; 16.; 14.; 14.; 14.; 14.; 20.; 16. +16.; 21.; 16.; 16.; 16.; 16.; 16.; 16. +26.; 16.; 10.; 10.; 15.; 24.; 10.; 40. + +timeinf: + + 9.; 10.; 10.; 10.; 10.; 10.; 10.; 10. +10.; 10.; 10.; 10.; 10.; 10.; 10.; 10. +10.; 10.; 10.; 10.; 10.; 10.; 10.; 10. +10.; 10.; 10.; 10.; 10.; 10.; 10.; 10. +10.; 10.; 48.; 53.; 21.; 28.; 20.; 10. +10.; 12.; 13.; 11.; 44.; 11.; 11.; 11. +11.; 11.; 27.; 21.; 17.; 17.; 17.; 17. +81.; 17.; 17.; 21.; 12.; 12.; 11.; 12. + +54.; 54.; 54.; 54.; 54.; 54.; 54.; 54. +54.; 54.; 54.; 54.; 54.; 54.; 54.; 54. +54.; 54.; 54.; 54.; 54.; 54.; 54.; 54. +54.; 54.; 54.; 54.; 54.; 41.; 49.; 37. +40.; 53.; 53.; 51.; 60.; 24.; 41.; 11. +20.; 19.; 10.; 53.; 30.; 29.; 11.; 30. +20.; 15.; 15.; 15.; 19.; 44.; 37.; 36. +25.; 19.; 19.; 19.; 19.; 19.; 19.; 19. + +/------------------------------------------------------------------------------ +/ time2inf table for escaped opcodes +/ cycles necessary for decoding is already accounted for in timeinf +/------------------------------------------------------------------------------ + +time2inf: + +57.; 46.; 61.; 50.; 37.; 26.; 30.; 19. +45.; 34.; 52.; 41.; 37.; 42.; 31.; 21. +21.; 21.; 91.; 108.; 97.; 21.; 21.; 53. +60.; 56.; 55.; 26.; 53.; 42.; 62.; 51. +72.; 61.; 72.; 61.; 38.; 27.; 40.; 29. +53.; 46.; 54.; 38.; 23.; 30.; 30.; 28. +36.; 45.; 34.; 61.; 50.; 39.; 28.; 44. +33.; 68.; 57.; 68.; 57.; 30.; 28.; 54. + +45.; 44.; 33.; 70.; 59.; 22.; 27.; 28. +29.; 37.; 28.; 27.; 11.; 47.; 40.; 21. +20.; 35.; 33.; 61.; 50.; 34.; 23.; 39. +28.; 500.; 47.; 36.; 41.; 30.; 100.; 38. +27.; 62.; 39.; 28.; 44.; 33.; 88.; 77. +92.; 81.; 32.; 68.; 57.; 61.; 50.; 37. +26.; 33.; 22.; 45.; 34.; 29.; 28.; 30. +28.; 61.; 52.; 16.; 28.; 27.; 11.; 30. + +19.; 36.; 25.; 32.; 21.; 36.; 25.; 31. +39.; 32.; 32.; 14.; 14.; 117.; 45.; 34. +31.; 22.; 20.; 20.; 20.; 20.; 20.; 27. +16.; 26.; 17.; 39.; 47.; 36.; 10.; 29. +.endif + .text +/------------------------------------------------------------------------------ +/ LOAD CONSTANT, LOAD LOCAL, STORE LOCAL +/------------------------------------------------------------------------------ + +loc.0: clr -(sp) + next +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 r0 / make multiplication undone + mov r0,-(sp) + next +loc._1: + mov $-1,-(sp) + next +loc.s0: + clr r0 + br 2f +loc.s_1: + mov $-400,r0 +2: bisb (pcx)+,r0 + mov r0,-(sp) + next +lpi.l: / let op, dit is een pointer + / zonder offset op het moment! +loc.l: + jsr pc,wrdoff + mov r0,-(sp) + next +ldc.0: + clr -(sp) + clr -(sp) + next +ldc.l: + jsr pc,wrdoff + mov r0,-(sp) + sxt -(sp) + next + +loc.f: jsr pc,wrdoff; mov r0,r1 + jsr pc,wrdoff; mov r0,-(sp) + mov r1,-(sp); next + +/__________________________________________________________________________ + +lol.0: mov 010(r2),-(sp); next +lol.1W: mov 012(r2),-(sp); next +lol.2W: mov 014(r2),-(sp); next +lol.3W: mov 016(r2),-(sp); next +lol._1W: mov -02(r2),-(sp); next +lol._2W: mov -04(r2),-(sp); next +lol._3W: mov -06(r2),-(sp); next +lol._4W: mov -010(r2),-(sp); next +lol._5W: mov -012(r2),-(sp); next +lol._6W: mov -014(r2),-(sp); next +lol._7W: mov -016(r2),-(sp); next +lol._8W: mov -020(r2),-(sp); next + +lol.w0: clr r0; bisb (pcx)+,r0 +5: asl r0; add r2,r0 + mov 010(r0),-(sp); next +lol.w_1: mov $-400,r0; bisb (pcx)+,r0 +2: asl r0; add r2,r0 + mov (r0),-(sp); next +lol.pw: jsr pc,wrdoff; br 5b +lol.nw: jsr pc,wrdoff; br 2b + +/------------------------------------------------------------------------------ + +ldl.0: mov 10.(r2),-(sp); mov 8.(r2),-(sp); next +ldl.w_1: mov $-400,r0; bisb (pcx)+,r0 +2: asl r0; add r2,r0 + mov 2(r0),-(sp); mov (r0),-(sp); next +ldl.pw: jsr pc,wrdoff; asl r0 + add r2,r0; mov 10.(r0),-(sp) + mov 8.(r0),-(sp); next +ldl.nw: jsr pc,wrdoff; br 2b + +/------------------------------------------------------------------------------ +loe.lw: jsr pc,wrdoff; br 2f +loe.w0: loe.w1: loe.w2: loe.w3: loe.w4: + asr r0; add $0144,r0 + swab r0; bisb (pcx)+,r0 +2: asl r0; add eb,r0 + mov (r0),-(sp); next +lde.lw: jsr pc,wrdoff; br 2f +lde.w0: clr r0; bisb (pcx)+,r0 +2: asl r0; add eb,r0 + mov 2(r0),-(sp); mov (r0),-(sp); next + + +/------------------------------------------------------------------------------ +lil.0: clr r0; br 1f +lil.1W: mov $1,r0; br 1f +lil.pw: jsr pc,wrdoff; br 1f +lil.w0: clr r0; bisb (pcx)+,r0 +1: add $04,r0 +2: asl r0; add r2,r0 + mov (r0),-(sp); jsr pc,chckptr + mov *(sp),(sp); next +lil.w_1: mov $-400,r0; bisb (pcx)+,r0; br 2b +lil.nw: jsr pc,wrdoff; br 2b +/------------------------------------------------------------------------------ +lof.l: jsr pc,wrdoff +1: jsr pc,chckptr; add (sp)+,r0; + mov (r0),-(sp); next + +lof.1W: lof.2W: lof.3W: lof.4W: + add $0276,r0; + br 1b +lof.s0: clr r0; bisb (pcx)+,r0; br 1b +ldf.l: jsr pc,wrdoff; add (sp)+,r0 + mov 2(r0),-(sp); mov (r0),-(sp); next +/------------------------------------------------------------------------------ +lal.p: jsr pc,wrdoff +5: add r2,r0; add $8.,r0 + mov r0,-(sp); next +lal.0: mov r2,-(sp); add $8.,(sp); next +lal.w0: clr r0; bisb (pcx)+,r0 + asl r0; br 5b +lal.n: jsr pc,wrdoff; br 2f +lal._1: mov $-1,r0 +2: add r2,r0; mov r0,-(sp); next +lal.w_1: mov $-400,r0 +3: bisb (pcx)+,r0; asl r0; br 2b +lal.w_2: mov $-1000,r0; br 3b + +lae.l: jsr pc,wrdoff; br 1f +lae.w0: lae.w1: lae.w2: lae.w3: lae.w4: lae.w5: lae.w6: + asr r0 + sub $0171,r0; swab r0 + bisb (pcx)+,r0; asl r0 +1: add eb,r0; +.if .test + cmp globmax,r0; + bhi 1f; jsr pc,e.badlae; +.endif +1: mov r0,-(sp); next +/------------------------------------------------------------------------------ +lxl.1: mov $1,r0; br 1f +lxl.2: mov $2,r0; br 1f +lxl.l: jsr pc,wrdoff + bgt 1f; jlt e.oddz + mov r2,-(sp); next +1: mov r2,r1 +2: mov 8(r1),r1; sob r0,2b + mov r1,-(sp); next + +lxa.1: mov $1,r0; br 1f +lxa.l: jsr pc,wrdoff; bgt 1f + jlt e.oddz; mov r2,-(sp) + add $10,(sp); next +1: mov r2,r1 +2: mov 8(r1),r1; sob r0,2b + add $10,r1; mov r1,-(sp); next + +/------------------------------------------------------------------------------ +loi.l: jsr pc,wrdoff; br 2f +loi.1W: loi.2W: loi.3W: loi.4W: + add $260,r0; br 1f +loi.s0: clr r0; bisb (pcx)+,r0 +2: cmp $1,r0; beq loi.1 +1: jsr pc,chckptr; mov (sp)+,r1; add r0,r1 + asr r0; jcs e.oddz +1: mov -(r1),-(sp); sob r0,1b; next +loi.1: jsr pc,chckptb; mov (sp),r1; clr r0 + bisb (r1),r0; mov r0,(sp); next +los.z: + mov (sp)+,r0 + br 0f +los.l: + jsr pc,wrdoff +0: + cmp $04,r0 + beq 4f + + cmp $02,r0; beq 3f + jbr e.oddz +4: mov (sp)+,r0 +3: mov (sp)+,r0; br 2b + +/------------------------------------------------------------------------------ + /Store group +/------------------------------------------------------------------------------ +stl.pw: jsr pc,wrdoff; asl r0; br 0f +stl.0: clr r0; br 0f +stl.1W: mov $2,r0 +0: add r2,r0; mov(sp)+,8.(r0); next + +stl.nw: jsr pc,wrdoff; br 0f +stl.w_1: mov $-400,r0; bisb (pcx)+,r0 +0: asl r0; add r2,r0 + mov (sp)+,(r0); next +stl._1W: mov (sp)+,-2(r2); next +stl._2W: mov (sp)+,-4(r2); next +stl._3W: mov (sp)+,-6(r2); next +stl._4W: mov (sp)+,-10(r2); next +stl._5W: mov (sp)+,-12(r2); next + +sdl.w_1: mov $-400,r0; bisb (pcx)+,r0 +0: asl r0; add r2,r0 +2: mov (sp)+,(r0)+; mov (sp)+,(r0); next +sdl.nw: jsr pc,wrdoff; br 0b +sdl.pw: jsr pc,wrdoff; asl r0 + add r2,r0; add $8.,r0; br 2b + +/------------------------------------------------------------------------------ + +sde.l: jsr pc,wrdoff; add eb,r0 + br 2b +ste.lw: jsr pc,wrdoff; br 1f +ste.w0: clr r0; br 0f +ste.w1: mov $400,r0; br 0f +ste.w2: mov $1000,r0 +0: bisb (pcx)+,r0 +1: asl r0; add eb,r0 + mov (sp)+,(r0); next + + +/------------------------------------------------------------------------------ + +stf.l: jsr pc,wrdoff; br 6f +stf.1W: mov $2,r0; br 6f +stf.2W: mov $4,r0; br 6f +stf.s0: clr r0; bisb (pcx)+,r0 +6: add (sp)+,r0; br 7f +sdf.l: jsr pc,wrdoff; add (sp)+,r0 + jbr 2b + + +/------------------------------------------------------------------------------ +sil.w0: clr r0; bisb (pcx)+,r0 +5: asl r0; add r2,r0 + mov 8.(r0),r0; br 7f +sil.w_1: mov $-400,r0; bisb (pcx)+,r0 +2: asl r0; add r2,r0 + mov (r0),r0; +7: mov (sp),r1; mov r0,(sp); + jsr pc,chckptr; mov r1,*(sp)+; next +sil.pw: jsr pc,wrdoff; br 5b +sil.nw: jsr pc,wrdoff; br 2b +/------------------------------------------------------------------------------ +sti.1: jsr pc,chckptb; mov (sp)+,r1; + movb (sp)+,(r1); next +sti.1W: sti.2W: sti.3W: sti.4W: + add $114,r0; br 1f +sti.s0: clr r0; bisb (pcx)+,r0; br 1f +sti.l: jsr pc,wrdoff +1: asr r0; beq 3f + jcs e.oddz; jsr pc,chckptr; + mov (sp)+,r1 +2: mov (sp)+,(r1)+; sob r0,2b; next +3: jcs sti.1; jbr e.oddz +sts.l: jsr pc,wrdoff +0: cmp $2,r0; beq 2f + cmp $4,r0; beq 4f; jbr e.oddz +4: mov (sp)+,r0 +2: mov (sp)+,r0; br 1b +sts.z: mov (sp)+,r0; br 0b + +/------------------------------------------------------------------------------ +/ POINTER ARITHMETIC +/------------------------------------------------------------------------------ +adp.l: jsr pc,wrdoff; add r0,(sp); next +adp.1: add $1,(sp); next +adp.2: add $2,(sp); next +adp.s0: clr r0; bisb (pcx)+,r0 + add r0,(sp); next +adp.s_1: mov $-400,r0; bisb (pcx)+,r0 + add r0,(sp); next +ads.l: jsr pc,wrdoff; br 0f +ads.z: mov (sp)+,r0 +0: cmp $1,r0; beq 1f + asr r0; jcs e.oddz +2: mov (sp)+,r1; sob r0,2b + add r1,(sp); next +ads.1W: mov (sp)+,r1; add r1,(sp); next +1: movb (sp)+,r1 + add r1,(sp); next +sbs.l: jsr pc,wrdoff; br 0f +sbs.z: mov (sp)+,r0 +0: mov (sp)+,r1; sub r1,(sp) + beq 0f; mov $-1,r1 + br 1f +0: clr r1 +1: dec r0; beq 3f + dec r0; beq 2f + asr r0 +4: mov r1,-(sp); sob r0,4b +2: next +3: clrb 1(sp); next + + +/------------------------------------------------------------------------------ +/------------------------------------------------------------------------------ +/ Clears, increments and decrements +/------------------------------------------------------------------------------ +inc.z: mov sp,r1; +4: +.if .test + cmp (r1),$und; jne 3f; + jsr pc,e.iund; 3: +.endif + inc (r1); bvs 9f; next +inl._1W: mov r2,r1; sub $2,r1; br 4b +inl._2W: mov r2,r1; sub $4,r1; br 4b +inl._3W: mov r2,r1; sub $6,r1; br 4b +inl.w_1: mov $-400,r0; bisb (pcx)+,r0; +1: asl r0; mov r2,r1; + add r0,r1; br 4b +inl.pw: jsr pc,wrdoff; add $4,r0; + br 1b; / !! proc frame 4 words +inl.nw: jsr pc,wrdoff; br 1b +ine.lw: jsr pc,wrdoff; br 1f +ine.w0: clr r0; bisb (pcx)+,r0; +1: asl r0; add eb,r0; + mov r0,r1; br 4b +dec.z: mov sp,r1; +4: +.if .test + cmp (r1),$und; jne 3f; + jsr pc,e.iund; 3: +.endif + dec (r1); bvs 9f; next +del.w_1: mov $-400,r0; bisb (pcx)+,r0; +1: asl r0; mov r0,r1; + add r2,r1; br 4b +del.pw: jsr pc,wrdoff; add $4,r0; + br 1b; / !proc frame 4 words +del.nw: jsr pc,wrdoff; br 1b +dee.w0: clr r0; bisb (pcx)+,r0; +1: asl r0; add eb,r0; + mov r0,r1; br 4b +dee.lw: jsr pc,wrdoff; br 1b; +9: jsr pc,e.iovfl; next + / jump to an error routine for integer overflow +zrl._1W: clr -2(r2); next +zrl._2W: clr -4(r2); next +zrl.w_1: mov $-400,r0; bisb (pcx)+,r0; +1: asl r0; add r2,r0; + clr (r0); next +zrl.nw: jsr pc,wrdoff; br 1b +zrl.pw: jsr pc,wrdoff; add $4,r0; + br 1b +zre.lw: jsr pc,wrdoff; br 1f +zre.w0: clr r0; bisb (pcx)+,r0; +1: asl r0; add eb,r0; + clr (r0); next +zrf.l: jsr pc,wrdoff; br 1f +zrf.z: mov (sp)+,r0; +1: asr r0; +2: clr -(sp); sob r0,2b; next +zer.s0: clr r0; bisb (pcx)+,r0; +3: bit $1,r0; jne e.illins + / test if number of bytes is even + br 1b +zer.l: jsr pc,wrdoff; br 3b +zer.z: mov (sp)+,r0; br 3b +/------------------------------------------------------------------------------ +/ LOGICAL GROUP +/------------------------------------------------------------------------------ + +and.1W: mov $1,r1; mov $2,r0; + br lbland; +and.l: jsr pc,wrdoff; br 0f +and.z: mov (sp)+,r0; +0: ble 9f; mov r0,r1; + asr r1; bcs 9f; +lbland: add sp,r0; +1: mov (sp)+,r5; com r5; + bic r5,(r0)+; sob r1,1b; + next +ior.1W: mov $1,r1; mov $2,r0; + br 0f +ior.s0: clr r0; bisb (pcx)+,r0; + br 0f +ior.l: jsr pc,wrdoff; br 0f +ior.z: mov (sp)+,r0; +lblior: + +0: ble 9f; bit $1,r0; + bne 9f; mov r0,r1; + mov sp,r5; add r0,r5; asr r1; +1: bis (sp)+,(r5)+; sob r1,1b; next +xor.l: jsr pc,wrdoff; br 0f; +xor.z: mov (sp)+,r0; +0: ble 9f; bit $1,r0; + bne 9f; mov r0,r1; + mov sp,r5; add r0,r5; asr r1 +1: mov (sp)+,r0; + xor r0,(r5)+; sob r1,1b; next +com.l: jsr pc,wrdoff; br 1f +com.z: mov (sp)+,r0; +1: bit $1,r0; bne 9f + mov r0,r1; asr r1 + add sp,r0; +2: com -(r0); sob r1,2b + next +rol.l: jsr pc,wrdoff; br 3f +rol.z: mov (sp)+,r0; +3: clr r4; + mov (sp)+,r5; ash $3,r0; + div r0,r4; mov r5,r4; + bge 1f; add r0,r4; +1: ash $-3,r0; mov sp,r1; + cmp r0,$1; beq 1f; + add r0,r1; mov r1,r5; + asr r0; jcs 9f + mov r3,saver0; mov r0,r3; +4: mov r3,r0; mov r5,r1; +2: rol -(r1); sob r0,2b; + adc -2(r5); sob r4,4b; + mov saver0,r3; mov $loop,r4; next +1: rolb (r1)+; adc (r1); + sob r4,1b; mov saver1,r4; next +ror.l: jsr pc,wrdoff; neg (sp); br 3b +ror.z: mov (sp)+,r0; neg (sp); br 3b +9: jsr pc,e.oddz /error codes for odd or + /negative number of bytes + +/------------------------------------------------------------------------------ +/ SET GROUP +/------------------------------------------------------------------------------ + +set.s0: clr r0; bisb (pcx)+,r0 +1: +.if .test + bgt 9f; jsr pc,e.set +9: +.endif + mov (sp)+,r1 + jsr pc,settest; inc r0 + asr r0; / if r0 odd choose next even +2: clr -(sp); sob r0,2b; / empty set + mov r1,r0; ash $-3,r0; + add sp,r0; bic $177770,r1; + bisb bits(r1),(r0); next +set.l: jsr pc,wrdoff; br 1b +set.z: mov (sp)+,r0; br 1b +inn.s0: clr r0; bisb (pcx)+,r0 +1: +.if .test + bgt 9f; jsr pc,e.set +9: +.endif + mov sp,r5; + add r0,r5; mov (sp)+,r1; + jsr pc,settest; mov r1,r0 + ash $-3,r0; add sp,r0; + clr -(sp); + bic $177770,r1; bitb bits(r1),(r0) + beq 2f; mov r5,sp; + mov $1,(sp); next +2: mov r5,sp; clr (sp); next +inn.l: jsr pc,wrdoff; br 1b +inn.z: mov (sp)+,r0; br 1b + .data +bits: .byte 1 + .byte 2 + .byte 4 + .byte 10 + .byte 20 + .byte 40 + .byte 100 + .byte 200 + .even + .text +settest: mov r0,-(sp); clc + ash $3,r0; sub r1,r0; +.if .test + bgt 3f; jsr pc,e.set +.endif +3: mov (sp)+,r0; rts pc +/------------------------------------------------------------------------------ +/ ARRAY GROUP +/------------------------------------------------------------------------------ + + + +lar.1W: mov $2,r0; br 1f +lar.l: jsr pc,wrdoff; br 1f +lar.z: mov (sp)+,r0; +1: jsr pc,calcarr; clr -2(sp); + sub r5,sp; bic $1,sp; + mov sp,r0; +2: movb (r1)+,(r0)+; sob r5,2b; next +sar.1W: mov $2,r0; br 1f +sar.l: jsr pc,wrdoff; br 1f +sar.z: mov (sp)+,r0; +1: jsr pc,calcarr; mov sp,r0; + add r5,sp; inc sp; + bic $1,sp; +2: movb (r0)+,(r1)+; sob r5,2b; next +aar.1W: mov $2,r0; br 1f +aar.l: jsr pc,wrdoff; br 1f +aar.z: mov (sp)+,r0; +1: jsr pc,calcarr; mov r1,-(sp); next + +calcarr: sub $02,r0; beq 0f; + jsr pc,e.oddz; +0: tst (sp)+; + mov (sp)+,r0; mov (sp)+,r1; + sub (r0)+,r1; bge 9f + jsr pc,e.array +9: + cmp (r0)+,r1; bge 9f + jsr pc,e.array +9: + mov (r0),r5; + mul r5,r1; add (sp)+,r1; + mov -010(sp),-(sp); rts pc; + + + +/------------------------------------------------------------------------------ +/-------------------------------------------------------------- +/ CONVERT GROUP +/-------------------------------------------------------------- + +cii.z: + / convert int to int + / 1 byte -> ? : sign extension + mov (sp)+,r0 + inc r0 / dest 1 byte = dest 1 word + bic $1,r0 +.if .test + cmp (sp),$2 / if size 2 then trap for undefined + bne 7f + cmp 2(sp),$und + bne 7f + jsr pc,e.iund / this is the trap +7: +.endif + sub (sp)+,r0 +0: blt 1f + asr r0 + bcc 2f + movb (sp),r1 + mov r1,(sp) +2: tst r0 + beq 3f + tst (sp) +4: sxt -(sp) + sob r0,4b +3: next +1: sub r0,sp +.if .test + mov sp,r1 + neg r0 + asr r0 + tst (sp) + blt 3f +5: tst -(r1) + bne 9f + sob r0,5b + next +3: cmp -(r1),$-1 + bne 9f + sob r0,3b +.endif + next +/------- +cui.z: mov (sp)+,r0 + sub (sp)+,r0 + clr -(sp) + add $-2,r0 + br 0b +cif.z: + mov (sp)+,r0 + jsr pc,setfloat + mov (sp)+,r0 +.if .test + cmp r0,$2 / trap if size 2 undefined integer + bne 7f + cmp (sp),$und + bne 7f + jsr pc,e.iund / trap for undefined integer +7: +.endif + jsr pc,setint + movif (sp)+,fr0 + movf fr0,-(sp) + next +cuf.z: + mov (sp)+,r0 + jsr pc,setfloat + mov (sp)+,r0 + cmp r0,$02 + bne 1b + clr -(sp) + mov $04,r0 + jsr pc,setint + movif (sp)+,fr0 + cfcc + bge 1f + addf fr3,fr0 +1: movf fr0,-(sp) + next +/------- +cff.z: + mov (sp)+,r0 + cmp (sp)+,r0 + beq 1f + jsr pc,setfloat + movof (sp)+,fr0 + movf fr0,-(sp) +1: next +/------- +ciu.z: mov (sp)+,r0 +.if .test + cmp (sp),$2 / trap undefined of size 2 + bne 7f + cmp 2(sp),$und + bne 7f + jsr pc,e.iund / this is the trap +7: +.endif + sub (sp)+,r0 + asr r0 + bcc 2f + clrb 1(sp) +2: tst (sp) +.if .test + jlt 9f +.endif +6: tst r0 + beq 3f + blt 5f +4: clr -(sp) + sob r0,4b +3: next +9: jsr pc,e.conv; next +5: neg r0 +4: tst (sp)+ +.if .test + jne 9b +.endif + sob r0,4b + next +cuu.z: + mov (sp)+,r0 + sub (sp)+,r0 + asr r0 + jbr 6b +/------- +cfu.z: + mov (sp)+,r0 + jsr pc,setint + mov (sp)+,r0 + jsr pc,setfloat + movf (sp)+,fr0 + movfi fr0,-(sp) +.if .test + jcs 9b + jlt 9b +.endif + next +/------- +cfi.z: + mov (sp)+,r0 + jsr pc,setint + mov (sp)+,r0 + jsr pc,setfloat + movf (sp)+,fr0 + movfi fr0,-(sp) + jcs e.conv + next +/-------------------------------------------------------------- +/ INTEGER ARITHMETIC +/-------------------------------------------------------------- + +adi.l: jsr pc,wrdoff; br 0f +adi.z: mov (sp)+,r0 +0: cmp r0,$04 + bgt 1f + cmp r0,$02 + bgt 2f + bne 1f +adi.1W: +.if .test + cmp (sp),$und / trap undefineds of size 2 + beq 6f + cmp 2(sp),$und + bne 7f +6: jsr pc,e.iund / this is the trap +7: +.endif + add (sp)+,(sp) +.if .test + bvs 9f +.endif + next +adi.2W: 2: add (sp)+,02(sp) +.if .test + bvc 2f + jsr pc,e.iovfl +2: +.endif + add (sp)+,02(sp) + adc (sp) +.if .test + bvs 9f +.endif + + next +1: + jsr pc,e.oddz ; next +/------- +sbi.l: jsr pc,wrdoff; br 0f +sbi.z: mov (sp)+,r0 +0: cmp r0,$04 + bgt 1b + cmp r0,$02 + bgt 2f + bne 1b +sbi.1W: +.if .test + cmp (sp),$und / trap for size 2 undefineds + beq 6f + cmp 2(sp),$und + bne 7f +6: jsr pc,e.iund / this is the trap +7: +.endif + sub (sp)+,(sp) +.if .test + bvs 9f +.endif + next +sbi.2W: 2: sub (sp)+,02(sp) +.if .test + bvc 2f + jsr pc,e.iovfl +2: +.endif + sub (sp)+,02(sp) + sbc (sp) +.if .test + bvs 9f + next +9: jsr pc,e.iovfl +.endif + next +/------ +mli.l: jsr pc,wrdoff; br 0f +mli.z: mov (sp)+,r0 +0: + cmp r0,$04 + bgt 1f + beq mli4 + cmp r0,$02 + bne 1f +mli.1W: mov (sp)+,r1 +.if .test + cmp r1,$und / trap for undefineds of size 2 + beq 6f + cmp (sp),$und + bne 7f +6: jsr pc,e.iund / this is the trap +7: +.endif + mul (sp)+,r1 +.if .test + + bcc 9f / overflow + jsr pc,e.iovfl +9: +.endif + mov r1,-(sp) + next +1: jmp e.oddz +/------ +mli.2W: mli4: +.if .prof + add $91.,*loprof + adc *hiprof +.endif + jsr pc,regsave + tst 02(sp) + sxt r0 + sub (sp),r0 + tst 06(sp) + sxt r2 + sub 04(sp),r2 + mov r0,r4 + mul r2,r4 + mul 06(sp),r0 +.if .test + bge 2f + inc r4 +2: +.endif + mul 02(sp),r2 +.if .test + bge 2f + inc r4 +2: sub r2,r5 + sbc r4 + sub r0,r5 + sbc r4 + add r1,r3 + sbc r5 + sbc r4 +.endif + mov 02(sp),r0 + mul 06(sp),r0 +.if .test + bge 2f + sub $1,r5 + sbc r4 +.endif +2: sub r3,r0 +.if .test + sxt r2 + sbc r5 + sbc r4 + cmp r2,r4 + bne 2f + cmp r2,r5 + beq 9f +2: jsr pc,e.iovfl +9: +.endif + add $010,sp + mov r1,-(sp); + mov r0,-(sp); + jsr pc,regretu; next + + +/------- +dvi.l: jsr pc,wrdoff; br 0f +dvi.z: mov (sp)+,r0 +0: cmp r0,$04 + bgt 1f + beq dvi4 + cmp r0,$02 + bne 1f +dvi.1W: mov 02(sp),r1 + sxt r0 +.if .test + cmp r1,$und / trap for undifined of size 2 + beq 6f + cmp (sp),$und + bne 7f +6: jsr pc,e.iund / this is the trap +7: +.endif + div (sp)+,r0 + jcs 9f + mov r0,(sp) + next +1: jmp e.oddz +/------- +dvi4: +.if .prof + add $100.,*loprof + adc *hiprof +.endif + jsr pc,regsave + mov 02(sp),r3 + bne 1f + tst (sp) + bne 1f +9: jsr pc,e.idivz +1: 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: +.if .prof + add $75.,*loprof + adc *hiprof +.endif + 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 + mov r1,-(sp); + mov r0,-(sp); + jsr pc,regretu; next +/------- +rmi.l: jsr pc,wrdoff; br 0f +rmi.z: mov (sp)+,r0 +0: cmp r0,$04 + bgt 1f + beq rmi4 + cmp r0,$02 + bne 1f +rmi.1W: mov 02(sp),r1 + sxt r0 +.if .test + cmp r1,$und / trap for undefineds of size 2 + beq 6f + cmp (sp),$und + bne 7f +6: jsr pc,e.iund / this is the trap +7: +.endif + div (sp)+,r0 + bcs 9f + mov r1,(sp) + next +1: jmp e.oddz +/------- +rmi4: +.if .prof + add $100.,*loprof + adc *hiprof +.endif + jsr pc,regsave + mov 02(sp),r3 + bne 1f + tst (sp) + bne 1f +9: jsr pc,e.idivz +1: tst 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: +.if .prof + add $75.,*loprof + adc *hiprof +.endif + 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 + mov r1,-(sp) + mov r0,-(sp) + jsr pc,regretu; next +/------- +ngi.l: jsr pc,wrdoff; br 1f +ngi.z: mov (sp)+,r0 +1: +lblngi: + cmp r0,$02 + bgt 1f +.if .test + cmp (sp),$und / trap for undefineds of size 2 + bne 7f + jsr pc,e.iund +7: +.endif + neg (sp) +3: next +1: cmp r0,$04 + bgt 2f + mov (sp),r0 + neg (sp) + mov 02(sp),r1 + neg 02(sp) + sbc (sp) + cmp r0,(sp) +.if .test + bne 3b + cmp r1,02(sp) + bne 3b +2: jsr pc,e.iovfl +.endif + next +/------- +sli.l: jsr pc,wrdoff; br 0f +sli.z: mov (sp)+,r0 +0: cmp r0,$02 + bgt 1f +sli.1W: mov (sp)+,r1 + mov (sp)+,r0 +.if .test + cmp r0,$und / trap for undefined size 2 + bne 7f + jsr pc,e.iund +7: +.endif + ash r1,r0 +.if .test + bvc 7f + jsr pc,e.iovfl +7: +.endif + mov r0,-(sp) + next +1: cmp r0,$04 + bgt 2f + mov 02(sp),r0 + mov 04(sp),r1 + ashc (sp)+,r0 +.if .test + bvc 7f + jsr pc,e.iovfl +7: +.endif + mov r0,(sp) + mov r1,02(sp) + next +2: jmp e.oddz +/------- +sri.l: jsr pc,wrdoff; br 0f +sri.z: mov (sp)+,r0 +0: cmp r0,$02 + bgt 1f + mov (sp)+,r1 + mov (sp)+,r0 +.if .test + cmp r0,$und / trap for undefined size 2 + bne 7f + jsr pc,e.iund +7: +.endif + neg r1 + ash r1,r0 + mov r0,-(sp) + next +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) + next +2: jmp e.oddz +/-------------------------------------------------------------- +adu.l: jsr pc,wrdoff; br 0f +adu.z: mov (sp)+,r0 +0: jsr pc,tstr0; add r0,sp + mov sp,r1; add r0,sp; asr r0 +2: adc -(sp); add -(r1),(sp); sob r0,2b + next +sbu.l: jsr pc,wrdoff; br 0f +sbu.z: mov (sp)+,r0 +0: jsr pc,tstr0; add r0,sp + mov sp,r1; add r0,sp; asr r0; +2: sbc -(sp); sub -(r1),(sp); sob r0,2b + next +mlu.l: jsr pc,wrdoff; br 0f +mlu.z: mov (sp)+,r0 +0: jsr pc,tstr0 + cmp r0,$04 + bgt 1f + beq mlu4 + mov (sp)+,r1 + mul (sp)+,r1 + mov r1,-(sp) + next +1: jmp e.oddz +mlu4: +.if .prof + add $90.,*loprof + adc *hiprof +.endif + jsr pc,regsave + 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 + mov r1,-(sp) + mov r0,-(sp) + jsr pc,regretu; next +9: jmp e.oddz +/------- +dvu.l: jsr pc,wrdoff; br 0f +dvu.z: mov (sp)+,r0 +0: + clr saver0; + cmp r0,$04 + bgt 9b + beq dvu4 + clr r0 + mov 02(sp),r1 + tst (sp) + blt 1f + div (sp)+,r0 + mov r0,(sp); next +1: mov (sp),-(sp); + clr 02(sp); + clr -(sp); + mov $1,saver0; +dvu4: +.if .prof + add $95.,*loprof + adc *hiprof +.endif + jsr pc,regsave + 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: +.if .prof + add $75.,*loprof + adc *hiprof +.endif + 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 + mov r1,-(sp) + mov r0,-(sp) + jsr pc,regretu + tst saver0; + beq 2f; + tst (sp)+ +2: + next +/------- +9: jbr e.oddz +rmu.l: jsr pc,wrdoff; br 0f +rmu.z: mov (sp)+,r0 +0: clr saver0; + cmp r0,$04 + bgt 9b + beq rmu4 + cmp r0,$02 + bne 9b + mov $1,saver0; + mov 02(sp),r1 + tst (sp) + blt 1f + clr r0 + div (sp)+,r0 + mov r1,(sp); next +1: mov (sp),-(sp) + clr 02(sp) + clr -(sp) +rmu4: +.if .prof + add $95.,*loprof + adc *hiprof +.endif + jsr pc,regsave + 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: +.if .prof + add $75.,*loprof + adc *hiprof +.endif + 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 + mov r1,-(sp) + mov r0,-(sp) + jsr pc,regretu + tst saver0 + beq 2f; + tst (sp)+; +2: next +/------- +slu.l: jsr pc,wrdoff; br 0f +slu.z: mov (sp)+,r0 +0: + cmp r0,$02 + bgt 1f + mov (sp)+,r1 + mov (sp)+,r0 + ash r1,r0 + mov r0,-(sp) + next +1: cmp r0,$04 + bgt 2f + mov 02(sp),r0 + mov 04(sp),r1 + ashc (sp)+,r0 + mov r0,(sp) + mov r1,02(sp) + next +2: jmp e.oddz +/------- +sru.l: jsr pc,wrdoff; br 0f +sru.z: mov (sp)+,r0 +0: + cmp r0,$02 + bgt 1f + mov 2(sp),r1 + neg (sp) + clr r0 + ashc (sp)+,r0 +2: mov r1,-(sp) + next +1: cmp r0,$04 + bgt 3f + mov 02(sp),r0 + mov 04(sp),r1 + neg (sp) + beq 4f + ashc $-1,r0 + bic $0100000,r0 + inc (sp) + beq 4f + ashc (sp)+,r0 +4: mov r0,(sp) + mov r1,02(sp) + next +3: jmp e.oddz +/------- + +/-------------------------------------------------------------- + / FLOATING POINT INSTRUCTIONS +/-------------------------------------------------------------- + +adf.s0: clr r0; bisb (pcx)+,r0; br 0f +adf.l: jsr pc,wrdoff; br 0f +adf.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp)+,fr0 + addf (sp)+,fr0 + movf fr0,-(sp) + next +/------- + +sbf.s0: clr r0; bisb (pcx)+,r0; br 0f +sbf.l: jsr pc,wrdoff; br 0f +sbf.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp)+,fr0 + subf (sp)+,fr0 + negf fr0 + movf fr0,-(sp) + next +/------- + +mlf.s0: clr r0; bisb (pcx)+,r0; br 0f +mlf.l: jsr pc,wrdoff; br 0f +mlf.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp)+,fr0 + mulf (sp)+,fr0 + movf fr0,-(sp) + next +/------- + +dvf.s0: clr r0; bisb (pcx)+,r0; br 0f +dvf.l: jsr pc,wrdoff; br 0f +dvf.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp)+,fr0 + movf (sp)+,fr1 + divf fr0,r1 + movf fr1,-(sp) + next +/------- + +ngf.l: jsr pc,wrdoff; br 0f +ngf.z: mov (sp)+,r0 +0: + jsr pc,setfloat + negf (sp) + next +/------- + +fif.l: jsr pc,wrdoff; br 0f +fif.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp)+,fr0 + modf (sp)+,fr0 + movf fr0,-(sp) + movf fr1,-(sp) + next +/------- + +fef.l: jsr pc,wrdoff; br 0f +fef.z: mov (sp)+,r0 +0: + jsr pc,setfloat + movf (sp),fr0 + movei fr0,-(sp) + movie $0,fr0 + movf fr0,02(sp) + next +/---------------------------------------------------------------------------- +/ TEST AND BRANCH GROUP +/---------------------------------------------------------------------------- +tlt.z: tst (sp)+; blt true; clr -(sp); next +tle.z: tst (sp)+; ble true; clr -(sp); next +teq.z: tst (sp)+; beq true; clr -(sp); next +tne.z: tst (sp)+; bne true; clr -(sp); next +tge.z: tst (sp)+; bge true; clr -(sp); next +tgt.z: tst (sp)+; bgt true; clr -(sp); next +/---------------------------------------------------------------------------- +zlt.s0: tst (sp)+; blt yesbr2; br nobr2 +zlt.l: tst (sp)+; blt yesbr3; br nobr3 +zle.s0: tst (sp)+; ble yesbr2; br nobr2 +zle.l: tst (sp)+; ble yesbr3; br nobr3 +zeq.s0: tst (sp)+; beq yesbr2; br nobr2 +zeq.s1: tst (sp)+; beq yesbr4; br nobr2 +zeq.l: tst (sp)+; beq yesbr3; br nobr3 +zne.s0: tst (sp)+; bne yesbr2; br nobr2 +zne.l: tst (sp)+; bne yesbr3; br nobr3 +zne.s_1: tst (sp)+; bne yesbr5; br nobr2 +zge.s0: tst (sp)+; bge yesbr2; br nobr2 +zge.l: tst (sp)+; bge yesbr3; br nobr3 +zgt.s0: tst (sp)+; bgt yesbr2; br nobr2 +zgt.l: tst (sp)+; bgt yesbr3; br nobr3 +great: +true: mov $1,-(sp) + next + +/------------------------------------------------------------------------------ + +blt.s0: cmp (sp)+,(sp)+; bgt yesbr2; br nobr2 +blt.l: cmp (sp)+,(sp)+; bgt yesbr3; br nobr3 +ble.s0: cmp (sp)+,(sp)+; bge yesbr2; br nobr2 +ble.l: cmp (sp)+,(sp)+; bge yesbr3; br nobr3 +beq.l: cmp (sp)+,(sp)+; beq yesbr3; br nobr3 +beq.s0: cmp (sp)+,(sp)+; beq yesbr2; br nobr2 +bne.s0: cmp (sp)+,(sp)+; bne yesbr2; br nobr2 +bne.l: cmp (sp)+,(sp)+; bne yesbr3; br nobr3 +bge.s0: cmp (sp)+,(sp)+; ble yesbr2; br nobr2 +bge.l: cmp (sp)+,(sp)+; ble yesbr3; br nobr3 +bgt.s0: cmp (sp)+,(sp)+; blt yesbr2; br nobr2 +bgt.l: cmp (sp)+,(sp)+; blt yesbr3; br nobr3 + +bra.s0: yesbr2: + clr r0; +5: bisb (pcx)+,r0 +1: add r0,pcx + next +bra.l: yesbr3: + jsr pc,wrdoff + br 1b +bra.s1: yesbr4: mov $400,r0; br 5b +bra.s_1: yesbr5: mov $-400,r0; br 5b +bra.s_2: mov $-800,r0; br 5b +nobr2: tstb (pcx)+ + next +nobr3: cmpb (pcx)+,(pcx)+ + next +/ +/------------------------------------------------------------------------------ +/ Compare group +/------------------------------------------------------------------------------ + +calccomp: mov (sp)+,saver1; / old pc + mov sp,r1; + add r0,r1; mov r1,r5; + add r0,r1; mov r1,saver0; / new sp + mov r0,r1; asr r1; +2: cmp (r5)+,(sp)+; blt 3f; + bgt 4f; dec r1; + beq 5f +2: cmp (r5)+,(sp)+; blo 3f; + bhi 4f; sob r1,2b; +5: mov saver0,sp; clr -(sp); + br 5f +4: mov saver0,sp; mov $1,-(sp); + br 5f +3: mov saver0,sp; mov $-1,-(sp); + br 5f +5: mov saver1,-(sp); rts pc + +cmi.1W: mov $2,r0; br 1f +cmi.2W: mov $4,r0; br 1f +cmi.l: jsr pc,wrdoff; br 1f +cmi.z: mov (sp)+,r0; +1: jsr pc,calccomp; next +cms.s0: clr r0; bisb (pcx)+,r0 +1: jsr pc,calccomp; tst (sp)+; + bne great; clr -(sp); next +cms.l: jsr pc,wrdoff; br 1b +cms.z: mov (sp)+,r0; br 1b +cmu.l: jsr pc,wrdoff; br 1f +cmu.z: mov (sp)+,r0; br 1f +cmp.z: mov $2,r0; +1: jsr pc,calccomp; mov (sp)+,r1; + jlo less; jhi great; + clr -(sp); next +cmf.s0: clr r0; bisb (pcx)+,r0; +1: cmp $4,r0; beq 3f + cmp $8,r0; beq 3f + jsr pc,e.oddz; +3: jsr pc,setfloat + movf (sp)+,fr0; cmpf (sp)+,fr0; +4: cfcc; jlt less; jgt great; + clr -(sp); next +cmf.l: jsr pc,wrdoff; br 1b +cmf.z: mov (sp)+,r0; br 1b +less: mov $-1,-(sp); next + +/------------------------------------------------------------------------------ +/------------------------------------------------------------------------------ +/------------------------------------------------------------------------------ +/ call and return group +/------------------------------------------------------------------------------ +/ +/ Frame format on the stack is: +/ +/ | Parameter 1 | +/ | - - - - - - - - - - - - | +/ | Static link = param 0 | < AB +/ |_________________________| ____ +/ |-------------------------| | P +/ | Saved line number | | R +/ |-------------------------| | O +/ | Saved file address | | C +/ |-------------------------| | F +/ | Return address | | R +/ |-------------------------| | A +/ | Dynamic link | < LB | M +/ |_________________________| ____| E +/ |-------------------------| +/ | | +/ | local variable -1 | +/ |-------------------------| +/ | | +/ +/ +/ The static link and the parameters are set by the +/ calling procedure; the frame is set by cal which reserves +/ also the space for local variables. +/------------------------------------------------------------------------------ + +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 r0; sub $077,r0; br 1f +cal.s0: clr r0; bisb (pcx)+,r0; br 1f +cai.z: mov (sp)+,r0; br 1f +cal.l: jsr pc,wrdoff +lblcal: +1: + cmp nprocs,r0 + jlos e.badpc +1: asl r0; asl r0; +.if .flow + .count + .prof + mov r0,r5; + asl r5 + add r5,r0 / procdes 12 bytes in this case +.endif + add pd,r0; / now r0 points to the bottom + / of the proc descriptor + mov *eb,-(sp) / save line number + mov *filb,-(sp) / save file address + +.if .prof + .count + .flow + tst 10.(r0) / yet a filename defined in this proc? + bne 4f / yes? continue + mov (sp),10.(r0) / no? Then take the old filename +4: mov curproc,(sp) / save old procdescriptor + mov r0,curproc / continue with the new one + mov 4(r0),countfld / count pointer minus line number + sub 6(r0),countfld / to add at line numbers +.endif + mov pcx,-(sp) / return address + mov r2,-(sp) / old local base + mov sp,r2 / new local base + mov (r0)+,r1 / number of bytes for locals + beq 3f / no locals + inc r1; asr r1 / make even +2: mov $und,-(sp) / make undefined + sob r1,2b / for r1 words local +3: mov (r0),pcx / em start address + next / ready +/------------------------------------------------------------------------------ + +ret.l: jsr pc,wrdoff; br 1f +ret.1W: mov $2,r0; br 1f +ret.s0: clr r0; bisb (pcx)+,r0; + jlt e.oddz / bad result size + beq ret.0 / no result + cmp $32.,r0; bge 1f; jsr pc,e.badlfr +1: inc r0; asr r0 / make even + mov r0,retsize / result size + mov $retarea,r1 / must point to retarea +2: mov (sp)+,(r1)+ / load result + sob r0,2b / continue when there is more + br 3f +retcount: +ret.0: clr retsize / no function result +3: mov r2,sp / set sp to bottom frame + mov (sp)+,r2 / restore (dynamic) local base + jeq lblhalt; / if zero then main procedure returns + mov (sp)+,pcx / return address in program counter + mov eb,r1 / must point to external base + mov (sp)+,r0 / file or procdesbase in r0 +.if .count + .flow + .prof + mov r0,curproc / save procdesbase current proc + mov 4(r0),countfld / restore pointer to + beq 5f / countfield 0 non interesting + sub 6(r0),countfld / table entries + mov countfld,countptr + add (sp),countptr +.if .prof + tst (sp) + beq 5f + mov countptr,r5 + asl r5 + asl r5 + add ltime,r5 + mov r5,hiprof + add $2,r5 + mov r5,loprof +.endif +5: + mov 10.(r0),r0 / pointer to file name in r0 +.endif +retlast: +.if .last + tst 4(r1) / file 0 not stacked + beq 4f + cmp r0,4(r1) / same file name? + beq 4f / yes continue + jsr pc,nexttab / next line table entry in r5 + clr (r5) / 0 indicates file pointer follows + jsr pc,nexttab / next entry in r5 + mov 4(r1),(r5) / store pointer to file name +5: mov (sp),(r1) / restored line number in *eb + beq 4f / do not put 0 in last table + jsr pc,nexttab / next entry in r5 + mov (sp),(r5) / line number in table +4: cmp (sp),(r1) / line number different? + bne 5b / yes? put it in table +.endif + mov r0,4(r1) / old file address + mov (sp)+,(r1) / reset line number + next / main loop again + +lfr.l: jsr pc,wrdoff; +8: bit $1,r0; jne e.illins + cmp r0,retsize; jeq 7f; jsr pc,e.badlfr +7: asr r0; / number of words + tst r0; beq 0f; + mov $retarea,r1; / must point to retarea + add r0,r1; + add r0,r1; / top of result +2: mov -(r1),-(sp); / move word of result + sob r0,2b; / look for more +0: next +lfr.1W: mov $2,r0; br 8b +lfr.2W: mov $4,r0; br 8b +lfr.s0: clr r0; bisb (pcx)+,r0; br 8b +/ +/------------------------------------------------------------------------------ + +/ miscellaneous +/------------------------------------------------------------------------------ +exg.s0: clr r0; bisb (pcx)+,r0; br 1f +exg.l: jsr pc,wrdoff; br 1f +exg.z: mov (sp)+,r0; +1: cmp r0,$1; beq 0f; + blt 9f; bit $1,r0; + bne 9f; + add r0,sp; + mov r0,r1; asr r1; + add sp,r0; +2: mov -(sp),r5; mov -(r0),(sp); + mov r5,(r0); sob r1,2b; + next +0: swab (sp); next +9: jsr pc,e.oddz; next + + + + +/------------------------------------------------------------------------------ + +dup.1W: mov (sp),-(sp); next +dup.l: jsr pc,wrdoff; br 1f; +dus.l: jsr pc,wrdoff; br 0f; +dus.z: mov (sp)+,r0; +0: ble 9b; bit $1,r0; + bne 9b; add r0,sp; + tst -(sp); mov (sp)+,r0; +1: ble 9b; inc r0; + bic $1,r0; mov r0,r1; + mov sp,r5; add r0,r5; + asr r1; +2: mov -(r5),-(sp); sob r1,2b; next + +nop.z: + next + +/------------------------------------------------------------------------------ +fil.l: jsr pc,wrdoff; add eb,r0 + cmp r0,*filb; beq 1f; +.if .last + clr *eb / new file asks for new line + jsr pc,nexttab; clr (r5); + jsr pc,nexttab; mov *filb,(r5); +.endif +.if .flow + .count + .prof + mov curproc,r1 / current proc descriptor + mov 4(r1),countfld + sub 6(r1),countfld / start countptr for this proc + mov r0,10.(r1) / file pointer in procdes +.endif + mov r0,*filb +1: next +lni.z: inc *eb; +.if .count + .flow + .prof + inc countptr +.if .prof + add $4,hiprof + add $4,loprof +.endif +.endif + br 8f +lin.l: jsr pc,wrdoff; br 1f +lin.s0: clr r0; bisb (pcx)+,r0 +1: cmp *eb,r0; beq 9f; + mov r0,*eb +.if .count + .flow + .prof + mov countfld,r5 + add r0,r5 / this is the right countptr + mov r5,countptr +.if .prof + asl r5 + asl r5 + add ltime,r5 + mov r5,hiprof + add $2,r5 + mov r5,loprof +.endif +.endif +8: +.if .last + jsr pc,nexttab / next entry in lasttab + mov *eb,(r5) / set endline +.endif +.if .count + mov countptr,r1 / line number in r1 + asl r1 + asl r1 / multiply by 4 + add lcount,r1 / r1 is pointer to long integer now + add $1,2(r1) / cannot be inc + adc (r1) / that was all +.endif +.if .flow + mov countptr,r1 / line number in r1 + clr r0 / get ready for divide + div $8.,r0 / r0 = byte offset; r1 = bit offset + add lflow,r0 / r0 is byte pointer now + bisb bits(r1),(r0) / set bit +.endif +9: next + +/------------------------------------------------------------------------------ + +bls.l: jsr pc,wrdoff; br 0f; +bls.z: mov (sp)+,r0; +0: asr r0 + bhi 1f + jbr e.oddz +1: mov (sp)+,r1; sob r0,1b; + mov r1,r0; br 1f; +blm.l: jsr pc,wrdoff + tst r0 + br 1f +blm.s0: clr r0; bisb (pcx)+,r0 +1: jsr pc,regsave; jsr pc,chckptr + mov (sp)+,r2; jsr pc,chckptr + 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: jsr pc,regretu; next +3: add r1,r3; add r1,r2; +1: mov -(r3),-(r2); sob r0,1b; br 2b +/------------------------------------------------------------------------------ +/ Range check and case instructions +/------------------------------------------------------------------------------ +csa.l: jsr pc,wrdoff; br 1f; +csa.z: mov (sp)+,r0; +1: sub $2,r0; jne e.illins; +csa.1W: mov (sp)+,r0; + mov (sp)+,r1; sub 2(r0),r1; + blt 6f; cmp 4(r0),r1; + blo 6f; asl r1; + add $6,r1; add r0,r1; +5: mov (r1),pcx; + jeq e.case; next +6: mov r0,r1; br 5b; + +csb.z: mov (sp)+,r0; br 1f; +csb.l: jsr pc,wrdoff; +1: sub $2,r0; jne e.illins; +csb.1W: mov (sp)+,r0; mov (sp)+,r1; + mov 2(r0),r5; mov r0,pcx; + /use pcx as ordinary register +2: add $4,r0; cmp (r0),r1; + beq 4f; sob r5,2b; + mov (pcx),pcx; jeq e.case; next +4: mov 2(r0),pcx; jeq e.case; next + +rck.l: jsr pc,wrdoff; br 1f; +rck.z: mov (sp)+,r0; +1: sub $2,r0; beq rck.1W; + sub $2,r0; jne e.oddz; + mov (sp)+,r1; cmp (sp),(r1); + blt 9f; cmp (sp),4(r1); + bgt 9f; next +rck.1W: mov (sp)+,r1; cmp (sp),(r1); + blt 9f; cmp (sp),2(r1); + bgt 9f; next +9: mov $ERANGE,-(sp); jmp trp.z; + +/------------------------------------------------------------------------------ +/ Load and store register +/------------------------------------------------------------------------------ +lbllor: +lor.s0: clr r0; bisb (pcx)+,r0 + cmp r0,$2; jhi e.illins + asl r0; jmp 1f(r0) +1: br 2f; br 3f; br 4f +2: mov lb,-(sp); next +3: mov sp,r1; mov r1,-(sp); next +4: mov hp,-(sp); next +lblstr: +str.s0: clr r0; bisb (pcx)+,r0 + cmp r0,$2; jhi e.illins + asl r0; jmp 1f(r0) +1: br 2f; br 3f; br 4f +2: mov (sp)+,lb; next +3: mov (sp)+,r1; mov r1,sp; next +4: mov (sp)+,r1; +5: cmp r1,sybreak+2; + blos 5f; add $unixextra,sybreak+2; + sys indir;sybreak / ask for more core + jec 5b; + jsr pc,e.heap; / core claim failed +5: cmp r1,globmax; jlo e.heap; + mov r1,hp; next + +/------------------------------------------------------------------------------ + +ass.l: jsr pc,wrdoff; br 1f +ass.z: mov (sp)+,r0; +1: cmp $2,r0; beq 2f + cmp $4,r0; jne e.oddz + mov (sp)+,r0; +2: mov (sp)+,r0; br 3f +asp.lw: jsr pc,wrdoff; br 2f +asp.w0: clr r0; bisb (pcx)+,r0; +2: asl r0; br 3f +asp.1W: asp.2W: asp.3W: asp.4W: asp.5W: + sub $88.,r0; +3: blt 4f; add r0,sp; next +4: neg r0; asr r0; +2: mov $und,-(sp); sob r0,2b; next + + +/------------------------------------------------------------------------------ + +dch.z: mov (sp)+,r1; mov (r1),-(sp); + cmp (sp),ml; jge e.badptr; + next / dch adjusts local base to + / dynamically previous local base + +lpb.z: add $8.,(sp); next / static link 8 bytes from lb + +/------------------------------------------------------------------------------ + +gto.l: jsr pc,wrdoff; / get descriptor address + add eb,r0 / descriptor is in external address space + mov 4(r0),r2; / new local base after jump + mov 2(r0),sp; / new stack pointer after jump + mov (r0),pcx; / new program counter +.if .prof + .flow + .count + mov firstp,r0 +1: mov 8.(r0),r1 + cmp r3,2(r1) + blos 2f + mov r1,r0 + br 1b +2: mov r0,curproc / procdesbase current proc + mov 4(r0),countfld / restore pointer to + sub 6(r0),countfld / table entries + mov 10.(r0),*filb / file name restored +.endif + next +/------------------------------------------------------------------------------ +/ Ignore mask +/------------------------------------------------------------------------------ + +lim.z: mov ignmask,-(sp); next / load ignore mask +sim.z: mov (sp)+,ignmask; next / store ignore mask + / for trap routines + +sig.z: mov (sp),r1; / exchange previous + mov uerrorp,(sp); / and stacked error + mov r1,uerrorp; / procedure pointer + next +/------------------------------------------------------------------------------ +/ Signals generated by UNIX +/------------------------------------------------------------------------------ + +sig1: + mov $sig.trp+0.,-(sp); br 1f +sig2: + mov $sig.trp+2.,-(sp); br 1f +sig3: + mov $sig.trp+4.,-(sp); br 1f +sig13: + mov $sig.trp+24.,-(sp); br 1f +sig14: + mov $sig.trp+26.,-(sp); br 1f +sig15: + mov $sig.trp+28.,-(sp); br 1f +sig16: + mov $sig.trp+30.,-(sp) / push address trap number +1: mov *(sp),-2(sp); / save trap number + mov $-2,*(sp) / set defold trap number + mov $retutrap,(sp) / set return address to rti + tst -(sp) / trap number position on stack + jbr error + +sig12: mov r0,-(sp) + mov $2,r0; / fildes standard error + sys 0; 9b / call write message + sys signal;12.;sig12 / this is a mon-error + jsr pc,e.badmon + mov (sp)+,r0 + rti + +sig11: mov r0,saver1 /save r0 + mov sybreak+2,r0 + sub sp,r0 + jgt e.memflt /real trap + mov $7f,r0 + mov argv,sp /setup a new stack + jbr rude_error + + .data +7: + .even +sybreak:sys break;_end /For indirect calling of break + .text +sig8: mov r0,saver1; + sys signal;8.;sig8 + mov $ECONV,fpperr+6 + stfps r0 + bit $100,r0 + beq 1f + mov $ECONV,fpperr+6 +1: stst r0 + mov $retutrap,-(sp) + mov fpperr(r0),-(sp) + mov saver1,r0 + jbr error +retutrap: rti + .data +fpperr: EILLINS; EILLINS; EFDIVZ; ECONV; EFOVFL; EFUNFL; EFUND; EILLINS + .text +/------------------------------------------------------------------------------ +/ Errors,traps and all their friends + +/------------------------------------------------------------------------------ + +savereg: mov r1,-(sp) / stack r1 so r1 scratch register + mov 2(sp),r1 / now r1 contains return address + mov r0,2(sp) / save r0 + mov r2,-(sp) / save r2 + mov r3,-(sp) / save r3 + mov r4,-(sp) / save r4 + mov r5,-(sp) / save r5 + mov 12.(sp),r0 / copy error number or param 0 + movf fr0,-(sp) / save float registers + movf fr1,-(sp) / fr0 and fr1 + stfps -(sp) / and status + mov $retsize+26.,r5 + mov $13.,r2 +8: mov -(r5),-(sp); sob r2,8b + mov r0,-(sp) / extra errno (param 0) on stack + mov r1,-(sp) / set return address + rts pc + +restoreg: mov (sp)+,r1 / return address in r1 + add $2,sp / skip error number (param 0) + mov $13.,r2; + mov $retsize,r5; +8: mov (sp)+,(r5)+; sob r2,8b + ldfps (sp)+ / restore floating point status + movf (sp)+,fr1 / restore float registers + movf (sp)+,fr0 / fr0 and fr1 + mov (sp)+,r5 / restore r5 + mov (sp)+,r4 / restore r4 + mov (sp)+,r3 / restore r3 + mov (sp)+,r2 / restore r2 + mov 2(sp),r0 / restore r0 + mov r1,2(sp) / reset return address + mov (sp)+,r1 / restore r1 + rts pc + +/------------------------------------------------------------------------------ +/ Various error entries +/------------------------------------------------------------------------------ + +e.badlfr: mov r0,r5; mov $2,r0; mov $blfr,9f+2 + sys 0;9f; + mov r5,r0; rts pc +.data +9: sys write;7;0; +blfr: +.even +.text + +e.iund: mov $EIUND,-(sp); br error +e.iovfl: mov $EIOVFL,-(sp); br error +e.idivz: mov $EIDIVZ,-(sp); br error +e.range: mov $ERANGE,-(sp); br error +e.set: mov $ESET,-(sp); br error +e.badptr: mov $EBADPTR,-(sp); br fatal +e.fovfl: mov $EFOVFL,-(sp); br error +e.funfl: mov $EFUNFL,-(sp); br error +e.fdivz: mov $EFDIVZ,-(sp); br error +e.fund: mov $EFUND,-(sp); br error +e.conv: mov $ECONV,-(sp); br error +e.stack: mov $ESTACK,-(sp); br fatal +e.badpc: mov $EBADPC,-(sp); br fatal +e.badlin: mov $EBADLIN,-(sp); br error +e.badlae: mov $EBADLAE,-(sp); br error +e.array: mov $EARRAY,-(sp); br error +e.badmon: mov $EBADMON,-(sp); br error +e.case: mov $ECASE,-(sp); br fatal +e.oddz: mov $EODDZ,-(sp); br fatal +e.illins: mov $EILLINS,-(sp); br fatal +e.heap: mov $EHEAP,-(sp); br fatal +e.memflt: mov $EMEMFLT,-(sp); br fatal +e.badgto: mov $EBADGTO,-(sp); br error +/------------------------------------------------------------------------------ + +fatal: mov $hlt.z,-(sp) / return from fatal halts + mov 2(sp),-(sp) / dup error number +error: + jsr pc,savereg / save old register contents + cmp $16.,r0; + ble 9f; + mov $1,r1 + ash r0,r1 + bic ignmask,r1 + bne 9f + jsr pc,restoreg + add $2,sp / remove error number from stack + rts pc +9: + cmp uerrorp,$-1 / has the user defined a trapprocedure ? + beq notrap / if not kill it off fast + mov uerrorp,-(sp) / go for cal + mov $-1,uerrorp / user must set trap again + jbr precal / call trap routine + +/------------------------------------------------------------------------------ + +rtt.z: mov r2,sp / sp to bottom frame + add $8,sp / set to top frame + jsr pc,restoreg / restore status and registers + add $2,sp / skip error number + rts pc +/------------------------------------------------------------------------------ +trp.z: mov (sp),-(sp); / error number one down + mov r4,2(sp); / set return address to main loop + jbr error / call error routine + +/------------------------------------------------------------------------------ + +notrap: mov (sp),r1 / error number + mov $num+9.,r0 + mov r1,retarea / set error number for exit status + jsr pc,itoa / make string + mov $num,r0 +rude_error: + mov r0,8f+4 + mov *filb,8f / pointer to file name + mov *eb,r1 / line number + mov $line,8f+6 / line message + mov $line+21.,r0 + jsr pc,itoa / convert to string +1: mov $8f,r4 +2: mov (r4)+,r0 / next string + beq 5f +3: mov r0,9f+2 +4: tstb (r0)+ / find zero byte + bne 4b + dec r0 + sub 9f+2,r0 / string length + mov r0,9f+4 + mov $2,r0 / diagnostic output + sys 0; 9f + jbr 2b +5: / no file + mov $-1,argc + jbr hlt.z + +itoa: mov r5,-(sp) + mov r0,r5 +1: clr r0 + div $10.,r0 + add $'0,r1 + movb r1,-(r5) + mov r0,r1 + bne 1b + mov r5,r0 + mov (sp)+,r5 + rts pc + + .data +uerrorp: -1 / undefined trap procedure +sep: <: \0> +line: < on source line \n\0> +num: + .even +8: 0 / name of text file + sep / separator + 0 / error + line+21. / line number if present + 0 / end of list +lblwri: +9: sys write;0;0 + .text +/------------------------------------------------------------------------------ +/ Exit instruction, with all it's crud +/------------------------------------------------------------------------------ + +hlt.z: + mov (sp)+,retarea +.if .count + .flow + .prof + br 9f +.endif + bne 9f + clr r0 + sys exit +9: +lblhalt: + sys creat;1f;666 +.data +1: +2: +.even +.text + bec 2f +3: mov $2b,lblwri+2 + mov $19.,lblwri+4 + mov $2.,r0 + sys indir;lblwri + br 9f +2: mov r0,saver0 + mov $hp,r1 + mov r1,ndatad + mov $txtsiz,r5 + mov r5,txtsiz + sub r5,r1 + mov r5,lblwri+2 + mov r1,lblwri+4 + clr r1 +.if .last + add $1,r1 +.endif +.if .opfreq + add $2,r1 +.endif +.if .count + add $4,r1 +.endif +.if .flow + add $8.,r1 +.endif +.if .prof + add $16.,r1 +.endif + mov r1,entry. + sys indir;lblwri + bes 3b + mov pd,lblwri+2 + mov tblmax,lblwri+4 + sub pd,lblwri+4 + mov saver0,r0 + sys indir;lblwri + bes 3b + mov ml,lblwri+2 + mov ml,lblwri+4 + neg lblwri+4 + mov saver0,r0 + sys indir;lblwri + bes 3b +9: + mov retarea,r0 / set exit status +2: sys exit + +/------------------------------------------------------------------------------ +/ System call interface routine +/------------------------------------------------------------------------------ +R0_IN = 0200 +R1_IN = 0100 +R0_OUT = 040 +R1_OUT = 020 +CBIT = 010 + +lblmon: +mon.z: + mov (sp)+,r0; / call number from stack + cmp r0,$1 / sys exit ? + jeq hlt.z / go there + bit $177700,r0; / range 0-63? + bne mon.bad; / no? bad call + movb r0,call; / move call number in system call + movb tab(r0),r5; / table lookup call conditions + cmp r5,$-1; / compare for special context + beq mon.special; / yes? jump to special context +monmon: mov r5,r4; / save call conditions + rolb r5 / R0_IN + bcc 1f / check if bit 7 is on + mov (sp)+,r0; / call argument in r0 +1: rolb r5 / R1_IN + bcc 1f / check if bit 6 is on + mov (sp)+,r1; / argument in r1 +1: bic $177770,r4 / clear all exept bits 2,1,0 + beq 2f / if 0 forget about args + mov r3,saver1 / save r3 + mov $call+2,r3 / base of args for call +1: mov (sp)+,(r3)+ / move argument + sob r4,1b / look for more + mov saver1,r3 / restore r3 +2: sys indir;call / this is it folks + bcc 1f / no error set? forward + mov r0,r4 / copy error in r4 +1: rolb r5 / R0_OUT + bcc 1f / check original bit 5 + mov r0,-(sp) / stack r0 from errno +1: rolb r5 / R1_OUT + bcc 1f / check original bit 4 + mov r1,-(sp) / stack r1 +1: rolb r5 / CBIT + bcc mon.end / no c-bit then ready +mon.cbit: + mov r4,-(sp) / stack errno + beq mon.end / only once if no error + mov r4,-(sp) / stack errno twice when error +mon.end: + mov $loop,r4 / restore r4 + next / ready + +mon.special: / special calls decoded here + cmp r0,$fork / fork? + beq mon.fork + cmp r0,$signal / signal? + beq mon.signal +mon.bad: / otherwise undecodable + mov saver0,r4 / restore r4 + jsr pc,e.badmon / mon call error routine + next + +mon.fork: + clr r5 + clr r4 + sys fork + inc r5 + bcc 1f + mov r0,r4 +1: mov r0,-(sp) + mov r5,-(sp) + br mon.cbit +mon.signal: +msign: + mov (sp)+,r1 / trap number + mov (sp)+,r0 / signal number + cmp r0,$16. / only 1 - 16 legal + bhi sig.bad + mov r0,call+2 / move signal number into call + beq sig.bad / 0 illegal + asl r0 / make 2-32 and even + mov sig.trp-2(r0),r5 / previous trap number + cmp r1,$256. / values -1 and -2 special + bhis 1f + mov sig.adr-2(r0),r4 / zero label means illegal signal + bne 2f +sig.bad: + mov $EINVAL,r4 / bad signal + jbr mon.cbit / and continue +1: cmp r1,$-3 / -2: reset default, -3: ignore + blo sig.bad + mov r1,r4 / trap number in r4 + inc r4 + inc r4 / -2 -> 0, -3 -> -1 +2: mov r1,sig.trp-2(r0) / new trap number + / -3 if ignored; -2 if default action + mov r4,call+4 / translated trap number in call + clr r4 + sys indir;call + bcs sig.bad / unlikely to happen + asr r0 / special if old label odd + bcc 1f + mov $-3,r5 / set ignore signal +1: mov r5,-(sp) / push trap number + jbr mon.cbit + + + .data + +call: sys 0; 0; 0; 0; 0 +sig.trp: + -2; -2; -2; -2; -2; -2; -2; -2 + -2; -2; 21.; 25.; -2; -2; -2; -2 +sig.adr: + sig1; sig2; sig3; 0; 0; 0; 0; sig8 + 0; 0; sig11; sig12; sig13; sig14; sig15; sig16 + +tab: +.if V6 +.byte -1 / 0 = indir +.byte -1 / 1 = exit +.byte -1 / 2 = fork +.byte 2 +R0_IN +R0_OUT +CBIT / 3 = read +.byte 2 +R0_IN +R0_OUT +CBIT / 4 = write +.byte 2 +R0_OUT +CBIT / 5 = open +.byte 0 +R0_IN +CBIT / 6 = close +.byte 0 +R0_OUT +R1_OUT +CBIT / 7 = wait +.byte 2 +R0_OUT +CBIT / 8 = creat +.byte 2 +CBIT / 9 = link +.byte 1 +CBIT / 10 = unlink +.byte 2 +CBIT / 11 = exec +.byte 1 +CBIT / 12 = chdir +.byte 0 +R0_OUT +R1_OUT / 13 = time +.byte 3 +CBIT / 14 = mknod +.byte 2 +CBIT / 15 = chmod +.byte 2 +CBIT / 16 = chown +.byte -1 / 17 = break +.byte 2 +CBIT / 18 = stat +.byte 2 +R0_IN +CBIT / 19 = seek +.byte 0 +R0_OUT / 20 = getpid +.byte 3 +CBIT / 21 = mount +.byte 1 +CBIT / 22 = umount +.byte 0 +R0_IN +CBIT / 23 = setuid +.byte 0 +R0_OUT / 24 = getuid +.byte 0 +R1_IN +R0_IN +CBIT / 25 = stime +.byte 3 +R0_IN +R0_OUT +CBIT / 26 = ptrace +.byte -1 / 27 = x +.byte 1 +R0_IN +CBIT / 28 = fstat +.byte -1 / 29 = x +.byte -1 / 30 = x +.byte 1 +R0_IN +CBIT / 31 = stty +.byte 1 +R0_IN +CBIT / 32 = gtty +.byte -1 / 33 = x +.byte 0 +R0_IN +CBIT / 34 = nice +.byte 0 +R0_IN / 35 = sleep +.byte 0 / 36 = sync +.byte 1 +R0_IN +CBIT / 37 = kill +.byte 0 +R0_OUT / 38 = csw +.byte -1 / 39 = x +.byte -1 / 40 = x +.byte 0 +R0_IN +R0_OUT +CBIT / 41 = dup +.byte 0 +R0_OUT +R1_OUT +CBIT / 42 = pipe +.byte 1 / 43 = times +.byte 4 / 44 = prof +.byte -1 / 45 = x +.byte 0 +R0_IN +CBIT / 46 = setgid +.byte 0 +R0_OUT / 47 = getgid +.byte -1 / 48 = signal +.byte -1 / 49 = reserved for USG +.byte -1 / 50 = reserved for USG +.byte -1 / 51 = x +.byte -1 / 52 = x +.byte -1 / 53 = x +.byte -1 / 54 = x +.byte -1 / 55 = x +.byte -1 / 56 = x +.byte -1 / 57 = x +.byte -1 / 58 = x +.byte -1 / 59 = x +.byte -1 / 60 = x +.byte -1 / 61 = x +.byte -1 / 62 = x +.byte -1 / 63 = x +.endif + +.if VPLUS +.byte -1 / 0 = indir +.byte -1 / 1 = exit +.byte -1 / 2 = fork +.byte 2 +R0_IN +R0_OUT +CBIT / 3 = read +.byte 2 +R0_IN +R0_OUT +CBIT / 4 = write +.byte 2 +R0_OUT +CBIT / 5 = open +.byte 0 +R0_IN +CBIT / 6 = close +.byte 0 +R0_OUT +R1_OUT +CBIT / 7 = wait +.byte 2 +R0_OUT +CBIT / 8 = creat +.byte 2 +CBIT / 9 = link +.byte 1 +CBIT / 10 = unlink +.byte 2 +CBIT / 11 = exec +.byte 1 +CBIT / 12 = chdir +.byte 0 +R0_OUT +R1_OUT / 13 = time +.byte 3 +CBIT / 14 = mknod +.byte 2 +CBIT / 15 = chmod +.byte 2 +CBIT / 16 = chown +.byte -1 / 17 = break +.byte 2 +CBIT / 18 = stat +.byte 2 +R0_IN +CBIT / 19 = seek +.byte 0 +R0_OUT / 20 = getpid +.byte 3 +CBIT / 21 = mount +.byte 1 +CBIT / 22 = umount +.byte 0 +R0_IN +CBIT / 23 = setuid +.byte 0 +R0_OUT / 24 = getuid +.byte 0 +R1_IN +R0_IN +CBIT / 25 = stime +.byte 3 +R0_IN +R0_OUT +CBIT / 26 = ptrace +.byte 0 +R0_IN +R0_OUT / 27 = alarm +.byte 1 +R0_IN +CBIT / 28 = fstat +.byte 0 / 29 = pause +.byte -1 / 30 = x +.byte 1 +R0_IN +CBIT / 31 = stty +.byte 1 +R0_IN +CBIT / 32 = gtty +.byte 2 +CBIT / 33 = access +.byte 0 +R0_IN +CBIT / 34 = nice +.byte 0 +R0_IN / 35 = sleep +.byte 0 / 36 = sync +.byte 1 +R0_IN +CBIT / 37 = kill +.byte 0 +R0_OUT / 38 = csw +.byte -1 / 39 = x +.byte 0 +R0_IN +R0_OUT +R1_OUT +CBIT / 40 = tell +.byte 0 +R0_IN +R0_OUT +CBIT / 41 = dup +.byte 0 +R0_OUT +R1_OUT +CBIT / 42 = pipe +.byte 1 / 43 = times +.byte 4 / 44 = prof +.byte -1 / 45 = x +.byte 0 +R0_IN +CBIT / 46 = setgid +.byte 0 +R0_OUT / 47 = getgid +.byte -1 / 48 = signal +.byte -1 / 49 = reserved for USG +.byte -1 / 50 = reserved for USG +.byte 1 +CBIT / 51 = acct +.byte -1 / 52 = x +.byte -1 / 53 = x +.byte -1 / 54 = x +.byte -1 / 55 = x +.byte -1 / 56 = x +.byte -1 / 57 = x +.byte -1 / 58 = x +.byte -1 / 59 = x +.byte -1 / 60 = x +.byte -1 / 61 = x +.byte -1 / 62 = x +.byte -1 / 63 = x +.endif + +.if V7 +.byte -1 / 0 = indir +.byte 0 / 1 = exit +.byte -1 / 2 = fork +.byte 2 +R0_IN +R0_OUT +CBIT / 3 = read +.byte 2 +R0_IN +R0_OUT +CBIT / 4 = write +.byte 2 +R0_OUT +CBIT / 5 = open +.byte 0 +R0_IN +CBIT / 6 = close +.byte 0 +R0_OUT +R1_OUT +CBIT / 7 = wait +.byte 2 +R0_OUT +CBIT / 8 = creat +.byte 2 +CBIT / 9 = link +.byte 1 +CBIT / 10 = unlink +.byte -1 / 11 = x no exec in em code +.byte 1 +CBIT / 12 = chdir +.byte -1 / 13 = x time is obsolete +.byte 3 +CBIT / 14 = mknod +.byte 2 +CBIT / 15 = chmod +.byte 3 +CBIT / 16 = chown +.byte -1 / 17 = break +.byte 2 +CBIT / 18 = stat +.byte 3 +R0_IN +R0_OUT +R1_OUT +CBIT / 19 = lseek +.byte 0 +R0_OUT / 20 = getpid +.byte 3 +CBIT / 21 = mount +.byte 1 +CBIT / 22 = umount +.byte 0 +R0_IN +CBIT / 23 = setuid +.byte 0 +R0_OUT +R1_OUT / 24 = getuid +.byte 0 +R1_IN +R0_IN +CBIT / 25 = stime +.byte 3 +R0_IN +R0_OUT +CBIT / 26 = ptrace +.byte 0 +R0_IN +R0_OUT / 27 = alarm +.byte 1 +R0_IN +CBIT / 28 = fstat +.byte 0 / 29 = pause +.byte 2 +CBIT / 30 = utime +.byte -1 / 31 = x +.byte -1 / 32 = x +.byte 2 +CBIT / 33 = access +.byte 0 +R0_IN +CBIT / 34 = nice +.byte 1 / 35 = ftime +.byte 0 / 36 = sync +.byte 1 +R0_IN +CBIT / 37 = kill +.byte -1 / 38 = x +.byte -1 / 39 = x +.byte -1 / 40 = x +.byte 0 +R1_IN +R0_IN +R0_OUT +CBIT / 41 = dup +.byte 0 +R0_OUT +R1_OUT +CBIT / 42 = pipe +.byte 1 / 43 = times +.byte 4 / 44 = prof +.byte -1 / 45 = x +.byte 0 +R0_IN +CBIT / 46 = setgid +.byte 0 +R0_OUT +R1_OUT / 47 = getgid +.byte -1 / 48 = signal +.byte -1 / 49 = reserved for USG +.byte -1 / 50 = reserved for USG +.byte 1 +CBIT / 51 = acct +.byte 3 +CBIT / 52 = phys +.byte 1 +CBIT / 53 = lock +.byte 3 +CBIT / 54 = ioctl +.byte -1 / 55 = x +.byte 2 +CBIT / 56 = mpxcall +.byte -1 / 57 = x +.byte -1 / 58 = x +.byte 3 +CBIT / 59 = exece +.byte 1 +CBIT / 60 = umask +.byte 1 +CBIT / 61 = chroot +.byte -1 / 62 = x +.byte -1 / 63 = x +.endif + + .text +/------------------------------------------------------------------------------ +/ General subroutines +/------------------------------------------------------------------------------ + +wrdoff: movb (pcx)+,r0 /get first byte + swab r0 /put it in high byte + clrb r0 /clear low byte of r0 + bisb (pcx)+,r0 /"or" second byte in + rts pc /done + +/------------------------------------------------------------------------------ + +tstr0: cmp r0,$04; jgt e.oddz; + cmp r0,$02; jne e.oddz; rts pc + +chckptr: / this routine traps a pointer outside + / the globals, the stack or the heap + bit $1,2(sp); bne 8f +chckptb: + mov 2(sp),r5; + cmp r5,sp; bhis 9f + cmp r5,hp; bhis 8f +.if .count + .prof + .flow + cmp r5,tblmax; bhis 9f + cmp r5,globmax; bhis 8f +.endif + cmp r5,eb; bhis 9f +8: jsr pc,e.badptr +9: rts pc + +.if .last +nexttab: mov linused,r5; + add $2,r5 / increment lasttab + cmp r5,$linused / top of table reached? + blo 1f + sub $96.,r5 +1: mov r5,linused + rts pc +.endif +regsave: + mov r5,savearea + mov $[savearea+2],r5 + mov r4,(r5)+ + mov r3,(r5)+ + mov r2,(r5) + rts pc +regretu: + mov $[savearea+6],r5 + mov (r5),r2 + mov -(r5),r3 + mov -(r5),r4 + mov -(r5),r5 + rts pc + +setfloat: + cmp r0,$8. + bne 1f + setd + rts pc +1: cmp r0,$04 + bne 3f + setf +2: rts pc +3: jmp e.oddz +setint: + cmp r0,$04 + bne 4f + setl + rts pc +4: cmp r0,$02 + bne 3b + seti +5: rts pc + + + +/------------------------------------------------------------------------------ +/ Leftover data +/------------------------------------------------------------------------------ + + + + + .bss +filb: .=.+2 +curproc:.=.+2 +linmax: .=.+2 +countptr:.=.+2 +countfld:.=.+2 +hiprof: .=.+2 +loprof: .=.+2 +ignmask:.=.+2 / ignore mask for trap +retsize:.=.+2 / size of return value of function +retarea:.=.+8 / return area for function value +savearea: .=.+8 / save register area +saver0: .=.+2 +saver1: .=.+2 +header: + txtsiz: .=.+2 / program textsize in bytes + ndatad: .=.+2 / number of loadfile descriptors + nprocs: .=.+2 / number of entries in procedure descriptors +option: entry.: .=.+2 / procedure number to start + nlines: .=.+2 / maximum sorceline number + szdata: .=.+2 / address of lowest uninitialized byte + firstp: .=.+2 / descriptor address first basic block of text + maxcount: .=.+2 / total number of processable source lines +argc: .=.+2 +argv: .=.+2 +environ: + .=.+2 +pb: .=.+2 +pd: .=.+2 +eb: .=.+2 +globmax: + .=.+2 +tblmax: .=.+2 +ml: .=.+2 +.if .last +lasttab:.=.+96. / 16 descriptors of integers + index at the end +linused:.=.+2 +.endif + +.if .opfreq +counttab: + .=.+1664. +.endif + +.if .count +lcount: .=.+2 +countsiz:.=.+2 +.endif + +.if .flow +lflow: .=.+2 +flowsiz:.=.+2 +.endif + +.if .prof +ltime: .=.+2 +profsiz:.=.+2 +.endif + +hp: .=.+2 diff --git a/mach/pdp/int/eminform.s b/mach/pdp/int/eminform.s new file mode 100644 index 00000000..739d53e9 --- /dev/null +++ b/mach/pdp/int/eminform.s @@ -0,0 +1,634 @@ +/ +/ (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 +/ +/ +/------------------------------------------------------------------------------ +/ + indir = 0 + exit = 1 + fork = 2 + read = 3 + write = 4 + open = 5 + close = 6 + creat = 8. + unlink = 10. + break = 17. + alarm = 27. + pause = 29. + sleep = 35. + signal = 48. + + iot = 4 +/------------------------------------------------------------------------------ +/ External references +/------------------------------------------------------------------------------ + + .globl _end + +/ +/------------------------------------------------------------------------------ +/ Now the real program starts +/------------------------------------------------------------------------------ + +startoff: + mov sp,memlim + mov $ldfail,r5 + mov $emfile,forward+2 + sys indir;forward + jes badruninf; + mov r0,saver0; + mov $rhfail,r5; + sys read;header;34. + jes badruninf; + cmp $34.,r0 + jne badruninf + mov $rtfail,r5 + mov $_end,loadstart + mov option,r1 + bit $17774,r1 + bne 1f + mov tblmax,globmax +1: + bit $1,r1 + beq 1f + mov saver0,r0 + sys read;lasttab;98. + jes badruninf; + +1: bit $2,r1 + beq 1f + mov saver0,r0 + sys read;opfrb;512. + jes badruninf + mov saver0,r0 + sys read;opfra;512. + jes badruninf + mov saver0,r0 + sys read;opfrc;640. + jes badruninf +1: bit $4,r1 + beq 1f + mov saver0,r0 + sys read;lcount;4 + jes badruninf +1: bit $8.,r1 + beq 1f + mov saver0,r0 + sys read;lflow;4 + jes badruninf +1: bit $16.,r1 + beq 1f + mov saver0,r0 + sys read;ltime;4 + jes badruninf +1: + mov tblmax,r3 + sub pd,r3 + sub ml,r3 + mov $_end,sybreak+2 + add r3,sybreak+2; + sys indir;sybreak + mov r3,lblread+4 + mov $_end,lblread+2; + mov saver0,r0 + sys indir;lblread; + jes badruninf + mov saver0,r0 + sys close + sys unlink;emfile +lbladj: + add $header,linused + sub header,linused + + mov pd,filext + sub loadstart,filext + mov filext,filarg + add ml,filarg + sub tblmax,filarg +lbllast: + bit $1,option /test for last + beq 2f / no last table jump + sys creat;emlast;666 + bcs 2f + cmp linused,$lasttab + bhis 3f + mov $yetmsg,lblwri+2 + mov $40.,lblwri+4 + sys indir;lblwri + br 2f +3: mov r0,saver0 + cmp linused-2,$-1 + bne 6f + mov $linused-2,linused + clr linused-2 +6: jsr pc,slilast + inc r2 + jsr pc,nexttab + tst (r5) + beq 3f + sub $2,linused + cmp eb,(r5) + blo 3f +7: cmp r2,$lnend + blt 1f + jsr pc,slnlast +1: jsr pc,lnrnxt + bne 7b +3: jsr pc,sfllast + bne 6b + mov saver0,r0 + sys close +2: + +lblopfreq: + bit $2,option + beq 9f + sys creat;emopf;666 + bcs 9f + mov r0,saver0 + mov $opcode,r3 + mov $104.,r4 + mov $counttab,r5 +0: mov $lnlast,r2 + mov $8.,r0 +2: movb (r3)+,(r2)+ + sob r0,2b + add $8,r2 + mov r2,-(sp) + jsr pc,ltoa + mov (sp)+,r2 + add $5,r2 + mov $8.,r0 +2: movb (r3)+,(r2)+ + sob r0,2b + add $8,r2 + mov r2,-(sp) + jsr pc,ltoa + mov (sp)+,r2 + add $5,r2 + mov $8.,r0 +2: movb (r3)+,(r2)+ + sob r0,2b + add $8,r2 + mov r2,-(sp) + jsr pc,ltoa + mov (sp)+,r2 + add $5,r2 + mov $8.,r0 +2: movb (r3)+,(r2)+ + sob r0,2b + add $8,r2 + mov r2,-(sp) + jsr pc,ltoa + mov (sp)+,r2 + mov r3,-(sp) + jsr pc,slnlast + mov (sp)+,r3 + sob r4,0b + mov saver0,r0 + sys close +9: +lblcount: + clr filb + bit $4,option + beq 9f + sys creat;emcount;666 + bcs 9f + mov r0,saver0 + mov lcount,r5 + add $4,r5 + sub filext,r5 + jsr pc,procrun + mov saver0,r0 + sys close +9: +lblprof: + bit $16.,option + beq 9f + sys creat;emprof;666 + bcs 9f + mov r0,saver0 + mov ltime,r5 + sub filext,r5 + mov $profmsg,lblwri+2 + mov $29,lblwri+4 + mov $profmsg+27,r2 + jsr pc,ltoa + mov saver0,r0 + sys indir;lblwri + jsr pc,procrun + mov saver0,r0 + sys close +9: +lblflow: + mov $1,filb + bit $8.,option + beq 9f + sys creat;emflow;666 + bcs 9f + mov lflow,r5 + mov $-1,flowsiz + sub filext,r5 + jsr pc,procrun + mov saver0,r0 + sys close +9: + clr r0 + sys exit + +badruninf: + mov $0f,lblwri+2 + mov $21.,lblwri+4 + mov $2,r0 + sys indir;lblwri + mov r5,lblwri+2 + mov $23.,lblwri+4 + mov $2,r0 + sys indir;lblwri + iot /force core dump +.data +lblwri: + sys write;0;0 +forward: + sys open;0;0 +sybreak: + sys break;0; +lblread: + sys read;0;0 +0: +ldfail: < open runinf failed \n\0> +rhfail: < read header failed \n\0> +rtfail: < read tables failed \n\0> +msgto: +emlast: +emcount: +emfile: +emopf: +emprof: +emflow: +yetmsg: +unknown: +lilast: <\nlines \0> +lnlast: < > + < > +lnend: < \0> +fllast: < of file > + < \0> +profmsg:<\ninitialization \n\0> +sep: <\n\0> +/---------------------------------------------------------------------------- +opcode: + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + .even + .text +/------------------------------------------------------------------------------ +/ General subroutines +/------------------------------------------------------------------------------ + +wrdoff: movb (r3)+,r0 /get first byte + swab r0 /put it in high byte + clrb r0 /clear low byte of r0 + bisb (r3)+,r0 /"or" second byte in + rts pc /done + +/------------------------------------------------------------------------------ + + +nexttab: mov linused,r5; + add $2,r5 / increment lasttab + cmp r5,$linused / top of table reached? + blo 1f + sub $96.,r5 +1: mov r5,linused + rts pc + +slilast: mov $lnlast,r2 + mov $6,r0 + mov $lilast,r3 +2: movb (r3)+,(r2)+ + sob r0,2b + rts pc + +slnlast: mov $lnlast,lblwri+2 + mov r2,r3 + sub $lnlast,r3 + beq 3f + inc r3 + movb sep,(r2) +1: mov r3,lblwri+4 + mov saver0,r0 + sys indir; lblwri + mov $lnlast,r2 +2: movb $' ,(r2)+ + sob r3,2b +3: mov $lnlast,r2 + rts pc + +lnrnxt: jsr pc,nexttab + tst (r5) + ble 0f + mov (r5),r1 + clr (r5) + add $6,r2 + mov r2,r0 + jsr pc,itoa +0: rts pc + +sfllast:jsr pc,nexttab + tst (r5) + bne 0f + clr linused + mov eb,-(sp) + sub filext,(sp) + add $4,(sp) + mov *(sp),(sp) + mov (sp)+,(r5) +0: jsr pc,slnlast + jsr pc,filadj + mov $14.,r3 + mov $fllast+14.,r2 + mov (r5),r0 +3: inc r3 + movb (r0)+,(r2)+ + bne 3b + movb sep,-(r2) + mov $fllast,lblwri+2 + mov r3,lblwri+4 + mov saver0,r0 + sys indir;lblwri + mov $fllast+14.,r2 + sub $10.,r3 +2: movb $' ,(r2)+ + sob r3,2b + clr (r5) + tst linused + beq 2f + jsr pc,slilast +2: rts pc + +filadj: + cmp ml,(r5) + bhi 8f + sub filarg,(r5) + br 7f +8: cmp eb,(r5) + bhi 7f + sub filext,(r5) +7: rts pc + +procrun: + mov firstp,r4 + sub filext,r4 +0: + tst 4(r4) + beq 8f + jsr pc,msgfile + mov r4,-(sp) + mov countsiz,r4 +7: cmp r2,$lnend+10 + blo 6f + jsr pc,slnlast + mov $lnlast,r2 +6: tst filb + bne 3f + add $11.,r2 + mov r2,-(sp) + jsr pc,ltoa + mov (sp)+,r2 + br 4f +3: + jsr pc,bittoa + add $4,r2 +4: sob r4,7b + jsr pc,slnlast + mov (sp)+,r4 +8: mov 8.(r4),r4 + beq 8f + sub filext,r4 + br 0b + mov r0,saver0 + sys write;sep;1 +8: rts pc + + +msgfile: + jsr pc,slilast + add $6,r2 + mov 6(r4),r1 + mov r2,r0 + jsr pc,itoa + add $4,r2 + movb msgto,(r2)+ + movb msgto+1,(r2)+ + add $6,r2 + mov 8.(r4),r1 +3: bne 1f + mov maxcount,r1 + br 2f +1: sub filext,r1 + tst 4(r1) + beq 1f + mov 4(r1),r1 + br 2f +1: mov 8.(r1),r1 + br 3b +2: sub 4(r4),r1 + mov r1,countsiz + dec r1 / is this a bug? + add 6(r4),r1 + mov r2,r0 + jsr pc,itoa + mov $fllast,r3 + mov $14,r1 +2: movb (r3)+,(r2)+ + sob r1,2b + mov 10.(r4),r3 + bne 6f + mov $unknown,r3 + br 5f +6: cmp ml,r3 + bhi 4f + sub filarg,r3 + br 5f +4: cmp eb,r3 + bhi 5f + sub filext,r3 +5: +lblmsgf: +2: movb (r3)+,(r2)+ + bne 2b + jsr pc,slnlast + rts pc + +itoa: + + mov r5,-(sp) + mov r0,r5 +1: clr r0 + div $10.,r0 + add $'0,r1 + movb r1,-(r5) + mov r0,r1 + bne 1b + mov r5,r0 + mov (sp)+,r5 + rts pc + + rts pc +ltoa: +0: mov (r5),r1 + clr r0 + div $10.,r0 + mov r0,(r5) + swab r1 + clr r0 + bisb 3(r5),r1 + div $10.,r0 + movb r0,3(r5) + clr r0 + swab r1 + bisb 2(r5),r1 + div $10.,r0 + add $'0,r1 + movb r1,-(r2) + movb r0,2(r5) + bne 0b + tst (r5) + bne 0b + add $4,r5 + rts pc + +bittoa: + mov (r5),r1 + mov flowsiz,r0 + ash r0,r1 + bit $1,r1 + beq 0f + movb $'1,(r2) + br 1f +0: movb $'0,(r2) +1: dec r0 + cmp $-16.,r0 + beq 2f + mov r0,flowsiz + br 3f +2: clr flowsiz + add $2,r5 +3: rts pc + +/------------------------------------------------------------------------------ +/ Leftover data +/------------------------------------------------------------------------------ + + + + + .bss +filb: .=.+2 +loadstart: .=.+2 +saver0: .=.+2 +filarg: .=.+2 +filext: .=.+2 +memlim: .=.+2 +header: +bstrt: txtsiz: .=.+2 +bend: ndatad: .=.+2 + nprocs: .=.+2 +option: entry.: .=.+2 + nlines: .=.+2 + szdata: .=.+2 + firstp: .=.+2 + maxcount: .=.+2 +argc: .=.+2 +argv: .=.+2 +environ: + .=.+2 +pb: .=.+2 +pd: .=.+2 +eb: .=.+2 +globmax: .=.+2 +tblmax: .=.+2 +ml: .=.+2 +lasttab:.=.+96. / 16 descriptors of integers + index at the end +linused:.=.+2 + +counttab: +opfra: .=.+512. +opfrb: .=.+512. +opfrc: .=.+640. + +lcount: .=.+2 +countsiz:.=.+2 + +lflow: .=.+2 +flowsiz:.=.+2 + +ltime: .=.+2 +profsiz:.=.+2 diff --git a/mach/pdp/int/f+ b/mach/pdp/int/f+ new file mode 100644 index 00000000..4cb1380b --- /dev/null +++ b/mach/pdp/int/f+ @@ -0,0 +1 @@ +.flow = 1 diff --git a/mach/pdp/int/f- b/mach/pdp/int/f- new file mode 100644 index 00000000..4787d73b --- /dev/null +++ b/mach/pdp/int/f- @@ -0,0 +1 @@ +.flow = 0 diff --git a/mach/pdp/int/p+ b/mach/pdp/int/p+ new file mode 100644 index 00000000..bd5ace85 --- /dev/null +++ b/mach/pdp/int/p+ @@ -0,0 +1 @@ +.prof = 1 diff --git a/mach/pdp/int/p- b/mach/pdp/int/p- new file mode 100644 index 00000000..ea9ff3c4 --- /dev/null +++ b/mach/pdp/int/p- @@ -0,0 +1 @@ +.prof = 0 diff --git a/mach/pdp/int/t+ b/mach/pdp/int/t+ new file mode 100644 index 00000000..c9571097 --- /dev/null +++ b/mach/pdp/int/t+ @@ -0,0 +1 @@ +.test = 1 diff --git a/mach/pdp/int/t- b/mach/pdp/int/t- new file mode 100644 index 00000000..eedebddf --- /dev/null +++ b/mach/pdp/int/t- @@ -0,0 +1 @@ +.test = 0 diff --git a/mach/pdp/libbc/Makefile b/mach/pdp/libbc/Makefile new file mode 100644 index 00000000..7e516a90 --- /dev/null +++ b/mach/pdp/libbc/Makefile @@ -0,0 +1,21 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=pdp" "SUF=o" "ASAR=ar" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/pdp/libbc/compmodule b/mach/pdp/libbc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/pdp/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/pdp/libcc/Makefile b/mach/pdp/libcc/Makefile new file mode 100644 index 00000000..5ebb62db --- /dev/null +++ b/mach/pdp/libcc/Makefile @@ -0,0 +1,49 @@ +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 diff --git a/mach/pdp/libcc/compmodule b/mach/pdp/libcc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/pdp/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/pdp/libem/LIST b/mach/pdp/libem/LIST new file mode 100644 index 00000000..b5ba9485 --- /dev/null +++ b/mach/pdp/libem/LIST @@ -0,0 +1,74 @@ +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 diff --git a/mach/pdp/libem/Makefile b/mach/pdp/libem/Makefile new file mode 100644 index 00000000..bbad255b --- /dev/null +++ b/mach/pdp/libem/Makefile @@ -0,0 +1,28 @@ + +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 + +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` diff --git a/mach/pdp/libem/RT.s b/mach/pdp/libem/RT.s new file mode 100644 index 00000000..ef9cb78b --- /dev/null +++ b/mach/pdp/libem/RT.s @@ -0,0 +1,32 @@ +/ $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 diff --git a/mach/pdp/libem/aar.s b/mach/pdp/libem/aar.s new file mode 100644 index 00000000..bcc130fe --- /dev/null +++ b/mach/pdp/libem/aar.s @@ -0,0 +1,12 @@ +/ $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 diff --git a/mach/pdp/libem/adf.s b/mach/pdp/libem/adf.s new file mode 100644 index 00000000..2c4c7aaf --- /dev/null +++ b/mach/pdp/libem/adf.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/adi.s b/mach/pdp/libem/adi.s new file mode 100644 index 00000000..b2d4dd62 --- /dev/null +++ b/mach/pdp/libem/adi.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/and.s b/mach/pdp/libem/and.s new file mode 100644 index 00000000..a9c34951 --- /dev/null +++ b/mach/pdp/libem/and.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/blm.s b/mach/pdp/libem/blm.s new file mode 100644 index 00000000..ea55f5f1 --- /dev/null +++ b/mach/pdp/libem/blm.s @@ -0,0 +1,29 @@ +/ $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 diff --git a/mach/pdp/libem/cff.s b/mach/pdp/libem/cff.s new file mode 100644 index 00000000..afdc3688 --- /dev/null +++ b/mach/pdp/libem/cff.s @@ -0,0 +1,15 @@ +/ $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) diff --git a/mach/pdp/libem/cfi.s b/mach/pdp/libem/cfi.s new file mode 100644 index 00000000..72ebe6e1 --- /dev/null +++ b/mach/pdp/libem/cfi.s @@ -0,0 +1,15 @@ +/ $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) diff --git a/mach/pdp/libem/cif.s b/mach/pdp/libem/cif.s new file mode 100644 index 00000000..d5272747 --- /dev/null +++ b/mach/pdp/libem/cif.s @@ -0,0 +1,25 @@ +/ $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 diff --git a/mach/pdp/libem/cii.s b/mach/pdp/libem/cii.s new file mode 100644 index 00000000..fe1e6c9e --- /dev/null +++ b/mach/pdp/libem/cii.s @@ -0,0 +1,22 @@ +/ $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) diff --git a/mach/pdp/libem/ciu.s b/mach/pdp/libem/ciu.s new file mode 100644 index 00000000..bf1ad2dd --- /dev/null +++ b/mach/pdp/libem/ciu.s @@ -0,0 +1,13 @@ +/ $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) diff --git a/mach/pdp/libem/cmf.s b/mach/pdp/libem/cmf.s new file mode 100644 index 00000000..733b1200 --- /dev/null +++ b/mach/pdp/libem/cmf.s @@ -0,0 +1,20 @@ +/ $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) diff --git a/mach/pdp/libem/cmi.s b/mach/pdp/libem/cmi.s new file mode 100644 index 00000000..792a12b8 --- /dev/null +++ b/mach/pdp/libem/cmi.s @@ -0,0 +1,18 @@ +/ $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~ diff --git a/mach/pdp/libem/cmi4.s b/mach/pdp/libem/cmi4.s new file mode 100644 index 00000000..ffc0b76a --- /dev/null +++ b/mach/pdp/libem/cmi4.s @@ -0,0 +1,21 @@ +/ $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) diff --git a/mach/pdp/libem/cms.s b/mach/pdp/libem/cms.s new file mode 100644 index 00000000..964538ba --- /dev/null +++ b/mach/pdp/libem/cms.s @@ -0,0 +1,17 @@ +/ $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~ diff --git a/mach/pdp/libem/cmu.s b/mach/pdp/libem/cmu.s new file mode 100644 index 00000000..8c37c854 --- /dev/null +++ b/mach/pdp/libem/cmu.s @@ -0,0 +1,23 @@ +/ $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~ diff --git a/mach/pdp/libem/cmu4.s b/mach/pdp/libem/cmu4.s new file mode 100644 index 00000000..6525354c --- /dev/null +++ b/mach/pdp/libem/cmu4.s @@ -0,0 +1,20 @@ +/ $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) diff --git a/mach/pdp/libem/compmodule b/mach/pdp/libem/compmodule new file mode 100755 index 00000000..e6e7c76e --- /dev/null +++ b/mach/pdp/libem/compmodule @@ -0,0 +1,4 @@ +if pdp -c $1 1>&2 +then echo `basename $1 $2`.o +else exit 1 +fi diff --git a/mach/pdp/libem/csa.s b/mach/pdp/libem/csa.s new file mode 100644 index 00000000..0e5f9751 --- /dev/null +++ b/mach/pdp/libem/csa.s @@ -0,0 +1,22 @@ +/ $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~ diff --git a/mach/pdp/libem/csb.s b/mach/pdp/libem/csb.s new file mode 100644 index 00000000..f1505415 --- /dev/null +++ b/mach/pdp/libem/csb.s @@ -0,0 +1,23 @@ +/ $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~ diff --git a/mach/pdp/libem/dup.s b/mach/pdp/libem/dup.s new file mode 100644 index 00000000..9d5863eb --- /dev/null +++ b/mach/pdp/libem/dup.s @@ -0,0 +1,12 @@ +/ $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) diff --git a/mach/pdp/libem/dvf.s b/mach/pdp/libem/dvf.s new file mode 100644 index 00000000..32947969 --- /dev/null +++ b/mach/pdp/libem/dvf.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/dvi.s b/mach/pdp/libem/dvi.s new file mode 100644 index 00000000..0eb13ce7 --- /dev/null +++ b/mach/pdp/libem/dvi.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/dvi4.s b/mach/pdp/libem/dvi4.s new file mode 100644 index 00000000..d47af695 --- /dev/null +++ b/mach/pdp/libem/dvi4.s @@ -0,0 +1,82 @@ +/ $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~ diff --git a/mach/pdp/libem/dvu.s b/mach/pdp/libem/dvu.s new file mode 100644 index 00000000..e27d99fb --- /dev/null +++ b/mach/pdp/libem/dvu.s @@ -0,0 +1,18 @@ +/ $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~ diff --git a/mach/pdp/libem/dvu2.s b/mach/pdp/libem/dvu2.s new file mode 100644 index 00000000..841edbe6 --- /dev/null +++ b/mach/pdp/libem/dvu2.s @@ -0,0 +1,16 @@ +/ $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 diff --git a/mach/pdp/libem/dvu4.s b/mach/pdp/libem/dvu4.s new file mode 100644 index 00000000..d2daa4fd --- /dev/null +++ b/mach/pdp/libem/dvu4.s @@ -0,0 +1,62 @@ +/ $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~ diff --git a/mach/pdp/libem/eret.s b/mach/pdp/libem/eret.s new file mode 100644 index 00000000..bf942fec --- /dev/null +++ b/mach/pdp/libem/eret.s @@ -0,0 +1,9 @@ +/ $Header$ + .globl eret + +eret: + mov r5,sp + mov (sp)+,r5 + mov (sp)+,r4 + mov (sp)+,r2 + rts pc diff --git a/mach/pdp/libem/exg.s b/mach/pdp/libem/exg.s new file mode 100644 index 00000000..9a198563 --- /dev/null +++ b/mach/pdp/libem/exg.s @@ -0,0 +1,19 @@ +/ $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~ + diff --git a/mach/pdp/libem/fef.s b/mach/pdp/libem/fef.s new file mode 100644 index 00000000..30a4225c --- /dev/null +++ b/mach/pdp/libem/fef.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/fif.s b/mach/pdp/libem/fif.s new file mode 100644 index 00000000..2fa50788 --- /dev/null +++ b/mach/pdp/libem/fif.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/gto.s b/mach/pdp/libem/gto.s new file mode 100644 index 00000000..61e4bbff --- /dev/null +++ b/mach/pdp/libem/gto.s @@ -0,0 +1,19 @@ +/ $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) diff --git a/mach/pdp/libem/head_em.s b/mach/pdp/libem/head_em.s new file mode 100644 index 00000000..6bc948f1 --- /dev/null +++ b/mach/pdp/libem/head_em.s @@ -0,0 +1,76 @@ +/ $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 diff --git a/mach/pdp/libem/hlt.s b/mach/pdp/libem/hlt.s new file mode 100644 index 00000000..a6bd5be4 --- /dev/null +++ b/mach/pdp/libem/hlt.s @@ -0,0 +1,11 @@ +/ $Header$ +.text +.globl hlt~ + +exit = 1 + +hlt~: + mov (sp)+,r0 + bne 1f + sys exit +1: 4 diff --git a/mach/pdp/libem/iaar.s b/mach/pdp/libem/iaar.s new file mode 100644 index 00000000..302dd632 --- /dev/null +++ b/mach/pdp/libem/iaar.s @@ -0,0 +1,19 @@ +/ $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) diff --git a/mach/pdp/libem/ilar.s b/mach/pdp/libem/ilar.s new file mode 100644 index 00000000..936fb3fe --- /dev/null +++ b/mach/pdp/libem/ilar.s @@ -0,0 +1,19 @@ +/ $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) diff --git a/mach/pdp/libem/inn.s b/mach/pdp/libem/inn.s new file mode 100644 index 00000000..5d326613 --- /dev/null +++ b/mach/pdp/libem/inn.s @@ -0,0 +1,22 @@ +/ $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 diff --git a/mach/pdp/libem/isar.s b/mach/pdp/libem/isar.s new file mode 100644 index 00000000..f1a505a0 --- /dev/null +++ b/mach/pdp/libem/isar.s @@ -0,0 +1,19 @@ +/ $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) diff --git a/mach/pdp/libem/lar.s b/mach/pdp/libem/lar.s new file mode 100644 index 00000000..ce4f92e9 --- /dev/null +++ b/mach/pdp/libem/lar.s @@ -0,0 +1,20 @@ +/ $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) diff --git a/mach/pdp/libem/los2.s b/mach/pdp/libem/los2.s new file mode 100644 index 00000000..1caccea2 --- /dev/null +++ b/mach/pdp/libem/los2.s @@ -0,0 +1,16 @@ +/ $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) diff --git a/mach/pdp/libem/mlf.s b/mach/pdp/libem/mlf.s new file mode 100644 index 00000000..b4f27400 --- /dev/null +++ b/mach/pdp/libem/mlf.s @@ -0,0 +1,13 @@ +/ $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) diff --git a/mach/pdp/libem/mli.s b/mach/pdp/libem/mli.s new file mode 100644 index 00000000..d9826fcb --- /dev/null +++ b/mach/pdp/libem/mli.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/mli4.s b/mach/pdp/libem/mli4.s new file mode 100644 index 00000000..1051223c --- /dev/null +++ b/mach/pdp/libem/mli4.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/mlu.s b/mach/pdp/libem/mlu.s new file mode 100644 index 00000000..9bd1328b --- /dev/null +++ b/mach/pdp/libem/mlu.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/mlu4.s b/mach/pdp/libem/mlu4.s new file mode 100644 index 00000000..cc312ca2 --- /dev/null +++ b/mach/pdp/libem/mlu4.s @@ -0,0 +1,24 @@ +/ $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~ diff --git a/mach/pdp/libem/mon.s b/mach/pdp/libem/mon.s new file mode 100644 index 00000000..a3d8fd8e --- /dev/null +++ b/mach/pdp/libem/mon.s @@ -0,0 +1,146 @@ +/ $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-- diff --git a/mach/pdp/libem/ngf.s b/mach/pdp/libem/ngf.s new file mode 100644 index 00000000..a167ee88 --- /dev/null +++ b/mach/pdp/libem/ngf.s @@ -0,0 +1,10 @@ +/ $Header$ +.text +.globl ngf~ +.globl setfloat~ + +ngf~: + jsr pc,setfloat~ + negf 2(sp) + setd + rts pc diff --git a/mach/pdp/libem/ngi.s b/mach/pdp/libem/ngi.s new file mode 100644 index 00000000..8e4a246f --- /dev/null +++ b/mach/pdp/libem/ngi.s @@ -0,0 +1,18 @@ +/ $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~ diff --git a/mach/pdp/libem/nop.s b/mach/pdp/libem/nop.s new file mode 100644 index 00000000..77539cc3 --- /dev/null +++ b/mach/pdp/libem/nop.s @@ -0,0 +1,13 @@ +/ $Header$ +.text +.globl nop~ +.globl hol0,prf~ + +nop~: + mov hol0,-(sp) + mov $fmt,-(sp) + jsr pc,prf~ + add $04,sp + rts pc +.data +fmt: diff --git a/mach/pdp/libem/prf.s b/mach/pdp/libem/prf.s new file mode 100644 index 00000000..3b6567e5 --- /dev/null +++ b/mach/pdp/libem/prf.s @@ -0,0 +1,34 @@ +/ $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> diff --git a/mach/pdp/libem/printf.s b/mach/pdp/libem/printf.s new file mode 100644 index 00000000..aad9ff70 --- /dev/null +++ b/mach/pdp/libem/printf.s @@ -0,0 +1,63 @@ +/ $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. diff --git a/mach/pdp/libem/rck.s b/mach/pdp/libem/rck.s new file mode 100644 index 00000000..d0faaac1 --- /dev/null +++ b/mach/pdp/libem/rck.s @@ -0,0 +1,16 @@ +/ $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) diff --git a/mach/pdp/libem/ret.s b/mach/pdp/libem/ret.s new file mode 100644 index 00000000..c20cd393 --- /dev/null +++ b/mach/pdp/libem/ret.s @@ -0,0 +1,31 @@ +/ $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: diff --git a/mach/pdp/libem/rmi.s b/mach/pdp/libem/rmi.s new file mode 100644 index 00000000..d7f5e88c --- /dev/null +++ b/mach/pdp/libem/rmi.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/rmi4.s b/mach/pdp/libem/rmi4.s new file mode 100644 index 00000000..b3417ca0 --- /dev/null +++ b/mach/pdp/libem/rmi4.s @@ -0,0 +1,76 @@ +/ $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~ diff --git a/mach/pdp/libem/rmu.s b/mach/pdp/libem/rmu.s new file mode 100644 index 00000000..995d8947 --- /dev/null +++ b/mach/pdp/libem/rmu.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/rmu2.s b/mach/pdp/libem/rmu2.s new file mode 100644 index 00000000..5e98c361 --- /dev/null +++ b/mach/pdp/libem/rmu2.s @@ -0,0 +1,17 @@ +/ $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 diff --git a/mach/pdp/libem/rmu4.s b/mach/pdp/libem/rmu4.s new file mode 100644 index 00000000..e406f1d9 --- /dev/null +++ b/mach/pdp/libem/rmu4.s @@ -0,0 +1,53 @@ +/ $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~ diff --git a/mach/pdp/libem/rol.s b/mach/pdp/libem/rol.s new file mode 100644 index 00000000..e0c75b30 --- /dev/null +++ b/mach/pdp/libem/rol.s @@ -0,0 +1,20 @@ +/ $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~ diff --git a/mach/pdp/libem/ror.s b/mach/pdp/libem/ror.s new file mode 100644 index 00000000..f2d50f9c --- /dev/null +++ b/mach/pdp/libem/ror.s @@ -0,0 +1,19 @@ +/ $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~ diff --git a/mach/pdp/libem/sar.s b/mach/pdp/libem/sar.s new file mode 100644 index 00000000..5e13b441 --- /dev/null +++ b/mach/pdp/libem/sar.s @@ -0,0 +1,17 @@ +/ $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) diff --git a/mach/pdp/libem/save.s b/mach/pdp/libem/save.s new file mode 100644 index 00000000..7eac2866 --- /dev/null +++ b/mach/pdp/libem/save.s @@ -0,0 +1,25 @@ +/ $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. diff --git a/mach/pdp/libem/sbf.s b/mach/pdp/libem/sbf.s new file mode 100644 index 00000000..2950aa2e --- /dev/null +++ b/mach/pdp/libem/sbf.s @@ -0,0 +1,14 @@ +/ $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) diff --git a/mach/pdp/libem/sbi.s b/mach/pdp/libem/sbi.s new file mode 100644 index 00000000..315c156f --- /dev/null +++ b/mach/pdp/libem/sbi.s @@ -0,0 +1,19 @@ +/ $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~ diff --git a/mach/pdp/libem/set.s b/mach/pdp/libem/set.s new file mode 100644 index 00000000..2ae3e522 --- /dev/null +++ b/mach/pdp/libem/set.s @@ -0,0 +1,25 @@ +/ $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 diff --git a/mach/pdp/libem/setfl.s b/mach/pdp/libem/setfl.s new file mode 100644 index 00000000..238f9ef3 --- /dev/null +++ b/mach/pdp/libem/setfl.s @@ -0,0 +1,22 @@ +/ $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 diff --git a/mach/pdp/libem/sigtrp.s b/mach/pdp/libem/sigtrp.s new file mode 100644 index 00000000..5ffaaab7 --- /dev/null +++ b/mach/pdp/libem/sigtrp.s @@ -0,0 +1,93 @@ +/ $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 diff --git a/mach/pdp/libem/sim.s b/mach/pdp/libem/sim.s new file mode 100644 index 00000000..8052f9ea --- /dev/null +++ b/mach/pdp/libem/sim.s @@ -0,0 +1,29 @@ +/ $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) diff --git a/mach/pdp/libem/sli.s b/mach/pdp/libem/sli.s new file mode 100644 index 00000000..cf704d2d --- /dev/null +++ b/mach/pdp/libem/sli.s @@ -0,0 +1,23 @@ +/ $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~ diff --git a/mach/pdp/libem/sri.s b/mach/pdp/libem/sri.s new file mode 100644 index 00000000..2d3dc385 --- /dev/null +++ b/mach/pdp/libem/sri.s @@ -0,0 +1,26 @@ +/ $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~ diff --git a/mach/pdp/libem/sru.s b/mach/pdp/libem/sru.s new file mode 100644 index 00000000..7450c73d --- /dev/null +++ b/mach/pdp/libem/sru.s @@ -0,0 +1,29 @@ +/ $Header$ +.text +.globl sru~ +.globl unknown~ + +sru~: + neg 2(sp) + mov (sp)+,r3 + cmp r0,$02 + bgt 1f + mov 2(sp),r1 + clr r0 + ashc (sp)+,r0 + 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) +4: ashc (sp)+,r0 + mov r0,(sp) + mov r1,02(sp) + jmp (r3) +3: jmp unknown~ diff --git a/mach/pdp/libem/sto2.s b/mach/pdp/libem/sto2.s new file mode 100644 index 00000000..9609fd30 --- /dev/null +++ b/mach/pdp/libem/sto2.s @@ -0,0 +1,15 @@ +/ $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) diff --git a/mach/pdp/libem/strhp.s b/mach/pdp/libem/strhp.s new file mode 100644 index 00000000..8b70738c --- /dev/null +++ b/mach/pdp/libem/strhp.s @@ -0,0 +1,25 @@ +/ $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 diff --git a/mach/pdp/libem/trp.s b/mach/pdp/libem/trp.s new file mode 100644 index 00000000..af879512 --- /dev/null +++ b/mach/pdp/libem/trp.s @@ -0,0 +1,93 @@ +/ $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: diff --git a/mach/pdp/libem/unknown.s b/mach/pdp/libem/unknown.s new file mode 100644 index 00000000..d76bea0d --- /dev/null +++ b/mach/pdp/libem/unknown.s @@ -0,0 +1,10 @@ +/ $Header$ +.text +.globl unknown~ +.globl fat~ + +EILLSIZ = 19. + +unknown~: + mov $EILLSIZ,-(sp) + jmp fat~ diff --git a/mach/pdp/libem/xor.s b/mach/pdp/libem/xor.s new file mode 100644 index 00000000..fd0ae60f --- /dev/null +++ b/mach/pdp/libem/xor.s @@ -0,0 +1,14 @@ +/ $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~ diff --git a/mach/pdp/libpc/Makefile b/mach/pdp/libpc/Makefile new file mode 100644 index 00000000..ddc6a8e6 --- /dev/null +++ b/mach/pdp/libpc/Makefile @@ -0,0 +1,21 @@ +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 diff --git a/mach/pdp/libpc/compmodule b/mach/pdp/libpc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/pdp/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/pdp/ncg/Makefile b/mach/pdp/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/pdp/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/pdp/ncg/mach.c b/mach/pdp/ncg/mach.c new file mode 100644 index 00000000..9f9e95e3 --- /dev/null +++ b/mach/pdp/ncg/mach.c @@ -0,0 +1,205 @@ +#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 + */ + +con_part(sz,w) register sz; word w; { + + while (part_size % sz) + part_size++; + if (part_size == 2) + part_flush(); + if (sz == 1) { + w &= 0xFF; + if (part_size) + w <<= 8; + part_word |= w; + } else { + assert(sz == 2); + part_word = w; + } + part_size += sz; +} + +con_mult(sz) word sz; { + long l; + + if (sz != 4) + fatal("bad icon/ucon size"); + l = atol(str); + fprintf(codefile,"\t%o;%o\n",(int)(l>>16),(int)l); +} + +con_float() { + double f; + register short *p,i; + + /* + * 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,"\t%o;%o;",i,*p++); + i = *p++; + } + fprintf(codefile,"\t%o;%o\n",i,*p++); +} + +#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; { + + /* + * This function is full of magic constants. + * They are a result of experimentation. + */ + + 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); /* 10 * estimated # of words of profit */ +} + +i_regsave() { + + Rstring[0] = 0; + n_regvars=0; +} + +f_regsave() { + register i; + + if (n_regvars==0 || lbytes==0) { + 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;i6) { + 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=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,"/ Local %ld into %s\n",off,regstr); + strcat(Rstring,regstr); + regadm[n_regvars].ra_str = regstr; + regadm[n_regvars].ra_off = off; + n_regvars++; +} + +regreturn() { + + fprintf(codefile,"jmp RT%s\n",Rstring); +} + +#endif + +prolog(nlocals) full nlocals; { + +#ifndef REGVARS + 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)+23 +uses REG={LOCAL, SL, 2}, + REG={const2,$1-1} +gen 1: + move {regind2,%a, SL},%a + sob %b,{label,1b} yields %a + +pat lxa $1==0 yields {addr_local, SL} + +pat lxa $1==1 +uses REG={LOCAL, SL, 2 } yields {regconst2, %a, SL } + +pat lxa $1==2 +uses REG={LOCAL, SL, 2 } +gen move {regind2, %a, SL }, %a yields {regconst2, %a, SL } + +pat lxa $1==3 +uses REG={LOCAL, SL, 2 } +gen move {regind2, %a, SL }, %a + move {regind2, %a, SL }, %a yields {regconst2, %a, SL } + +pat lxa $1 > 3 +uses REG={LOCAL, SL, 2}, + REG={const2,$1-1} +gen 1: + move {regind2,%a, SL},%a + sob %b,{label,1b} yields {regconst2, %a, SL } + +pat dch leaving loi 2 + +pat loi $1==2 +with REG yields {regdef2, %1} +with exact regconst2 yields {regind2, %1.reg, %1.off} +with exact relative2 yields {reldef2, %1.off} +with exact regind2 yields {reginddef2, %1.reg, %1.off} +with exact regdef2 yields {reginddef2, %1.reg, 0} +with exact addr_local yields {LOCAL, %1.ind,2} +with exact addr_external yields {relative2, %1.off} +with exact LOCAL yields {reginddef2, lb, %1.ind} + +pat loi $1==1 +with REG yields {regdef1, %1} +with exact regconst2 yields {regind1, %1.reg, %1.off} +with exact addr_external yields {relative1, %1.off} +with exact addr_local yields {regind1, lb, %1.ind} +with exact relative2 yields {reldef1, %1.off} +with exact regind2 yields {reginddef1, %1.reg, %1.off} +with exact regdef2 yields {reginddef1, %1.reg, 0} +with exact LOCAL yields {reginddef1, lb, %1.ind} + +pat loi $1==4 +with REG yields {regdef4, %1} +with exact regconst2 yields {regind4, %1.reg, %1.off} +with exact addr_local yields {DLOCAL,%1.ind,4} +with exact addr_external yields {relative4, %1.off} + +pat loi $1==8 +with REG yields {regdef8, %1} +with exact regconst2 yields {regind8, %1.reg, %1.off} +with exact addr_local yields {regind8, lb , %1.ind} +with exact addr_external yields {relative8, %1.off} + +pat loi +with exact addr_local + kills ALL + uses REG={const2,$1/2}, REG + gen move lb,%b + add {const2,%1.ind+$1},%b + 1: + mov {autodec,%b},{autodec,sp} + sob %a,{label,1b} +with exact addr_external + kills ALL + uses REG={const2,$1/2}, REG + gen mov {addr_external,%1.off+$1},%b + 1: + mov {autodec,%b},{autodec,sp} + sob %a,{label,1b} +with REG + kills ALL + uses REG={const2,$1} + gen add %a,%1 + asr %a + 1: + mov {autodec,%1},{autodec,sp} + sob %a,{label,1b} + + +pat ldl yields {DLOCAL, $1,4} +pat lde yields {relative4, $1} +pat ldf +with regconst2 yields {regind4,%1.reg,$1+%1.off} +with exact addr_external yields {relative4, $1+%1.off} +with exact addr_local yields {DLOCAL, %1.ind+$1,4} + +pat lpi yields {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. * + ****************************************************************/ + +pat stl with xsrc2 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen move %1,{LOCAL,$1,2} + +pat ste with xsrc2 +kills posextern +gen move %1, {relative2, $1 } + +pat sil with xsrc2 +kills allexeptcon +gen move %1, {reginddef2,lb,$1} + +pat stf +with regconst2 xsrc2 + kills allexeptcon + gen move %2,{regind2,%1.reg,$1+%1.off} +with addr_external xsrc2 + kills allexeptcon + gen move %2,{relative2,$1+%1.off} + +pat sti $1==2 +with REG xsrc2 + kills allexeptcon + gen move%2,{regdef2,%1} +with regconst2 xsrc2 + kills allexeptcon + gen move%2,{regind2,%1.reg,%1.off} +with addr_external xsrc2 + kills allexeptcon + gen move %2,{relative2,%1.off} +with addr_local xsrc2 + kills allexeptcon + gen move %2,{LOCAL, %1.ind, 2} +with relative2 xsrc2 + kills allexeptcon + gen move %2,{reldef2,%1.off} +with regind2 xsrc2 + kills allexeptcon + gen move %2,{reginddef2,%1.reg,%1.off} + +pat sti $1==1 +with REG src1or2 + kills allexeptcon + gen move %2,{regdef1,%1} +with exact regconst2 src1or2 + kills allexeptcon + gen move %2,{regind1,%1.reg,%1.off} +with exact addr_external src1or2 + kills allexeptcon + gen move %2,{relative1,%1.off} +with exact addr_local src1or2 + kills allexeptcon + gen move %2,{regind1, lb, %1.ind} +with exact relative2 src1or2 + kills allexeptcon + gen move %2,{reldef1,%1.off} +with exact regind2 src1or2 + kills allexeptcon + gen move %2,{reginddef1,%1.reg,%1.off} + +pat sti $1==4 +with exact REG FLTREG + kills allexeptcon + gen movfo %2,{regdef4,%1} +with exact regind2 FLTREG + kills allexeptcon + gen movfo %2,{reginddef4,%1.reg,%1.off} +with exact relative2 FLTREG + kills allexeptcon + gen movfo %2,{reldef4,%1.off} +with exact REG ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{regdef2,%1} + seti. +with exact regind2 ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{reginddef2,%1.reg,%1.off} + seti. +with exact relative2 ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{reldef2,%1.off} + seti. +with exact regconst2 FLTREG + kills allexeptcon + gen movfo %2,{regind4,%1.reg,%1.off} +with exact regconst2 ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{regind2,%1.reg,%1.off} + seti. +with exact addr_local FLTREG + kills allexeptcon + gen movfo %2,{DLOCAL,%1.ind,4} +with exact addr_local ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{DLOCAL,%1.ind,4} + seti. +with exact addr_external FLTREG + kills allexeptcon + gen movfo %2,{relative4,%1.off} +with exact addr_external ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{relative2,%1.off} + seti. +with REG src2 src2 + kills allexeptcon + gen move %2,{regdef2,%1} + move %3,{regind2,%1,2} +with REG STACK + gen mov {autoinc,sp},{autoinc,%1} + mov {autoinc,sp},{regdef2,%1} + +pat sti $1==8 +with exact REG DBLREG + kills allexeptcon + gen movf %2,{regdef8,%1} +with exact regind2 DBLREG + kills allexeptcon + gen movf %2,{reginddef8,%1.reg,%1.off} +with exact relative2 DBLREG + kills allexeptcon + gen movf %2,{reldef8,%1.off} +with exact regconst2 DBLREG + kills allexeptcon + gen movf %2,{regind8,%1.reg,%1.off} +with exact addr_local DBLREG + kills allexeptcon + gen movf %2,{regind8, lb, %1.ind} +with exact addr_external DBLREG + kills allexeptcon + gen movf %2,{relative8, %1.off} +with REG regind8 + kills allexeptcon + gen mov {regind2,%2.reg,%2.off },{autoinc,%1} + mov {regind2,%2.reg,%2.off+2},{autoinc,%1} + mov {regind2,%2.reg,%2.off+4},{autoinc,%1} + mov {regind2,%2.reg,%2.off+6},{regdef2,%1} +with REG relative8 + kills allexeptcon + uses REG={addr_external,%2.off} + gen mov {autoinc,%a},{autoinc,%1} + mov {autoinc,%a},{autoinc,%1} + mov {autoinc,%a},{autoinc,%1} + mov {regdef2,%a},{regdef2,%1} +with REG STACK + gen mov {autoinc,sp},{autoinc,%1} + mov {autoinc,sp},{autoinc,%1} + mov {autoinc,sp},{autoinc,%1} + mov {autoinc,sp},{regdef2,%1} + +pat sti +with REG STACK +uses REG={const2,$1/2} +gen 1: + mov {autoinc,sp},{autoinc,%1} + sob %a,{label,1b} + +pat lal sti $2>2 && $2<=8 +with exact xsrc2 + yields %1 + leaving stl $1 lal $1+2 sti $2-2 +with + yields {addr_local,$1} + leaving sti $2 + +pat sdl +with exact FLTREG + kills indordef, locals %ind <= $1+2 && %ind+%size > $1 + gen move %1,{DLOCAL,$1,4} +with exact ftolong + kills indordef, locals %ind <= $1+2 && %ind+%size > $1 + gen setl. + movfi %1.reg,{DLOCAL,$1,4} + seti. +with src2 src2 + kills indordef, locals %ind <= $1+2 && %ind+%size > $1 + gen move %1,{LOCAL,$1,2} + move %2,{LOCAL,$1+2,2} + +pat sde +with exact FLTREG + kills posextern + gen move %1,{relative4,$1} +with exact ftolong + kills posextern + gen setl. + movfi %1.reg,{relative4,$1} + seti. +with src2 src2 + kills posextern + gen move %1, {relative2, $1 } + move %2, {relative2, $1+2} + +pat sdf +with exact regconst2 FLTREG + kills allexeptcon + gen move %2,{regind4,%1.reg,$1+%1.off} +with exact regconst2 ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{regind4,%1.reg,$1+%1.off} + seti. +with exact addr_external FLTREG + kills allexeptcon + gen move %2,{relative4,$1+%1.off} +with exact addr_external ftolong + kills allexeptcon + gen setl. + movfi %2.reg,{relative4, $1+%1.off} + seti. +with regconst2 src2 src2 + kills allexeptcon + gen move %2,{regind2,%1.reg,$1+%1.off} + move %3,{regind2,%1.reg,$1+2+%1.off} +with addr_external src2 src2 + kills allexeptcon + gen move %2,{relative2,$1+%1.off} + move %3,{relative2,$1+2+%1.off} + +/**************************************************************** + * Group 3 : Integer arithmetic. * + * * + * Implemented (sometimes with the use of subroutines) : * + * all 2 and 4 byte arithmetic. * + ****************************************************************/ + +pat adi $1==2 +with exact REG const2 yields {regconst2,%1,%2.num} +with exact REG addr_external yields {regconst2,%1,%2.off} +with exact REG addr_local + gen add lb,%1 yields {regconst2,%1,%2.ind} +with exact REG addr_local + uses REG + gen mov lb,%a + add %1,%a yields {regconst2,%a,%2.ind} +with exact REG regconst2 + gen add %2.reg,%1 yields {regconst2,%1,%2.off} +with exact src2-REG const2+addr_external+addr_local + uses reusing %1,REG=%1 yields %2 %a + leaving adi 2 +with exact regconst2 const2 yields {regconst2,%1.reg,%2.num+%1.off} +with exact regconst2 addr_external yields {regconst2,%1.reg,%2.off+%1.off} +with exact regconst2 addr_local + gen add lb,%1.reg yields {regconst2,%1.reg,%2.ind+%1.off} +with exact regconst2 regconst2 + gen add %2.reg,%1.reg yields {regconst2,%1.reg,%2.off+%1.off} +with exact regconst2 noconst2 + gen add %2,%1.reg yields %1 +with exact REG noconst2 + gen add %2,%1 yields %1 +with exact src2 regconst2 + gen add %1,%2.reg yields %2 +with exact regconst2 src2 + gen add %2,%1.reg yields %1 +with src2 REG + gen add %1,%2 yields %2 + +pat adi $1==4 +with REG REG src2 src2 + gen add %4,%2 + adc %1 + add %3,%1 yields %2 %1 +with REG REG src2 STACK + gen add {autoinc,sp},%2 + adc %1 + add %3,%1 yields %2 %1 +with REG REG STACK + gen add {autoinc,sp},%1 + add {autoinc,sp},%2 + adc %1 yields %2 %1 +with src2 src2 REG REG + gen add %2,%4 + adc %3 + add %1,%3 yields %4 %3 + +pat sbi $1==2 +with src2 REG + gen sub %1,%2 yields %2 +with exact REG src2-REG + gen sub %2,%1 + neg %1 yields %1 + +pat sbi $1==4 +with src2-REG src2-REG REG REG + gen sub %2,%4 + sbc %3 + sub %1,%3 yields %4 %3 +with src2 src2 STACK + gen sub %2,{regind2,sp,2} + sbc {regdef2,sp} + sub %1,{regdef2,sp} + +pat mli $1==2 +with ODDREG src2 + gen mul %2,%1 yields %1 +with src2 ODDREG + gen mul %1,%2 yields %2 + +pat mli $1==4 +with STACK + gen jsr pc,{label, "mli4~"} yields r1 r0 + +pat dvi $1==2 +with src2 src2 + uses reusing %2,REGPAIR + gen mov %2,%a.2 + sxt %a.1 + div %1,%a.1 yields %a.1 +with src2 src2 STACK + gen mov %1,{autodec,sp} + mov %2,r1 + sxt r0 + div {autoinc,sp},r0 yields r0 + +pat dvi $1==4 +with STACK + gen jsr pc,{label, "dvi4~"} yields r1 r0 + +pat rmi $1==2 +with src2 src2 + uses reusing %2,REGPAIR + gen mov %2,%a.2 + sxt %a.1 + div %1,%a.1 yields %a.2 +with src2 src2 STACK + gen mov %1,{autodec,sp} + mov %2,r1 + sxt r0 + div {autoinc,sp},r0 yields r1 + +pat rmi $1==4 +with STACK +gen jsr pc,{label, "rmi4~"} yields r1 r0 + +pat ngi $1==2 +with REG +gen neg %1 yields %1 + +pat ngi $1==4 +with REG REG +gen neg %1 + neg %2 + sbc %1 yields %2 %1 + +pat loc sli $1==1 && $2==2 +with REG +gen asl %1 yields %1 + +pat sli $1==2 +with src2 REG +gen ash %1,%2 yields %2 + +pat sli $1==4 +with src2 REGPAIR +gen ashc %1,%2 yields %2 + +pat loc sri $1==1 && $2==2 +with REG +gen asr %1 yields %1 + +pat loc sri $2==2 +with REG +gen ash {const2,0-$1},%1 yields %1 + +pat sri $1==2 +with REG REG +gen neg %1 + ash %1,%2 yields %2 + +pat loc sri $2==4 +with REGPAIR +gen ashc {const2,0-$1},%1 yields %1 + +pat sri $1==4 +with REG REGPAIR +gen neg %1 + ashc %1,%2 yields %2 + +/************************************************ + * Group 4 : unsigned arithmetic * + * * + * adu = adi * + * sbu = sbi * + * slu = sli * + * * + * Supported : 2- and 4 byte arithmetic. * + ************************************************/ + +pat adu leaving adi $1 +pat sbu leaving sbi $1 +pat mlu $1==2 leaving mli 2 + +pat mlu $1==4 +with STACK +gen jsr pc,{label, "mlu4~"} yields r1 r0 + +pat dvu $1==2 +with STACK +gen jsr pc,{label, "dvu2~"} yields r0 + +pat dvu $1==4 +with STACK +gen jsr pc,{label, "dvu4~"} yields r1 r0 + +pat rmu $1==2 +with STACK +gen jsr pc,{label, "rmu2~"} yields r1 + +pat rmu $1==4 +with STACK +gen jsr pc,{label, "rmu4~"} yields r1 r0 + +pat slu leaving sli $1 + +pat sru $1==2 +with REG xsrc2 +uses reusing %2,REGPAIR +gen move %2,%a.2 + move {const2,0},%a.1 + neg %1 + ashc %1,%a yields %a.2 + +pat loc sru $2==2 +with xsrc2 +uses reusing %1,REGPAIR +gen move %1,%a.2 + move {const2,0},%a.1 + ashc {const2,0-$1},%a yields %a.2 + +pat sru $1==4 +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "sru~"} + +/************************************************ + * Group 5 : Floating point arithmetic * + * * + * Supported : 4- and 8 byte arithmetic. * + ************************************************/ + +pat adf $1==4 +with FLTREG FLTREG + gen addf %1,%2 yields %2 +with FLTREG FLTREG + gen addf %2,%1 yields %1 + +pat adf $1==8 +with double8 DBLREG + gen addf %1,%2 yields %2 +with DBLREG double8 +gen addf %2,%1 yields %1 + +pat sbf $1==4 +with FLTREG FLTREG +gen subf %1,%2 yields %2 + +pat sbf $1==8 +with double8 DBLREG +gen subf %1,%2 yields %2 + +pat mlf $1==4 +with FLTREG FLTREG + gen mulf %1,%2 yields %2 +with FLTREG FLTREG + gen mulf %2,%1 yields %1 + +pat mlf $1==8 +with double8 DBLREG + gen mulf %1,%2 yields %2 +with DBLREG double8 + gen mulf %2,%1 yields %1 + +pat dvf $1==4 +with FLTREG FLTREG +gen divf %1,%2 yields %2 + +pat dvf $1==8 +with double8 DBLREG +gen divf %1,%2 yields %2 + +pat ngf $1==4 +with FLTREG +gen negf %1 yields %1 + +pat ngf $1==8 +with DBLREG +gen negf %1 yields %1 + +pat fif $1==4 +with longf4 FLTREG +uses FLTREGPAIR +gen move %1,%a.1 + modf %2,%a yields %a.1 %a.2 + +pat fif $1==8 +with double8 double8 +uses DBLREGPAIR +gen move %1,%a.1 + modf %2,%a yields %a.1 %a.2 + +pat fef $1==4 +with FLTREG +uses REG +gen movei %1,%a + movie {const2,0},%1 yields %1 %a + +pat fef $1==8 +with DBLREG +uses REG +gen movei %1,%a + movie {const2,0},%1 yields %1 %a + +/**************************************** + * Group 6 : pointer arithmetic. * + * * + * Pointers have size 2 bytes. * + ****************************************/ + +pat adp +with REG yields {regconst2, %1, $1} +with exact regconst2 yields {regconst2, %1.reg, $1+%1.off} +with exact addr_external yields {addr_external, $1+%1.off} +with exact addr_local yields {addr_local,%1.ind+$1} + +pat ads $1==2 leaving adi 2 +pat sbs $1==2 leaving sbi $1 + +/**************************************** + * Group 7 : increment/decrement/zero * + ****************************************/ + +pat inc +with REG +gen inc %1 yields %1 + +pat inl +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen inc {LOCAL,$1,2} + +pat ine +kills posextern +gen inc {relative2, $1} + +pat dec +with REG +gen dec %1 yields %1 + +pat del +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen dec {LOCAL, $1, 2} + +pat dee +kills posextern +gen dec {relative2, $1} + +pat lol loc sbi stl $1==$4 && $3==2 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen sub {const2,$2},{LOCAL,$1,2} + +pat lol ngi stl $1==$3 && $2==2 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen neg {LOCAL, $1, 2} + +pat lil ngi sil $1==$3 && $2==2 +kills allexeptcon +gen neg {ILOCAL, $1} + +pat lil inc sil $1==$3 +kills allexeptcon +gen inc {ILOCAL, $1} + +pat lol adi stl $2==2 && $1==$3 +with src2 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen add %1,{LOCAL, $1, 2} + +pat lol adp stl $1==$3 && $2==1 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen inc {LOCAL, $1, 2} + +pat lol adp stl $1==$3 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen add {const2, $2},{LOCAL, $1, 2} + +pat loe adi ste $2==2 && $1==$3 +with src2 +kills posextern +gen add %1,{relative2, $1} + +pat loe adp ste $1==$3 +kills posextern +gen add {const2, $2},{relative2, $1} + +pat lol ior stl $2==2 && $1==$3 +with src2 +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen bis %1,{LOCAL, $1, 2} + +pat loe ior ste $2==2 && $1==$3 +with src2 +kills posextern +gen bis %1,{relative2, $1} + +pat lol and stl $2==2 && $1==$3 +with REG +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen com %1 + bic %1,{LOCAL, $1, 2} + +pat loe and ste $2==2 && $1==$3 +with REG +kills posextern +gen com %1 + bic %1,{relative2, $1} + +pat loc lol and stl $3==2 && $2==$4 +kills indordef, locals %ind <= $2 && %ind+%size > $2 +gen bic {const2, ~$1},{LOCAL, $2, 2} + +pat loc loe and ste $3==2 && $2==$4 +kills posextern +gen bic {const2, ~$1},{relative2, $2} + +pat zrl +kills indordef, locals %ind <= $1 && %ind+%size > $1 +gen clr {LOCAL, $1, 2} + +pat zre +kills posextern +gen clr {relative2, $1} + +pat zrf $1==4 +uses FLTREG +gen clrf %a yields %a + +pat zrf $1==8 +uses DBLREG +gen clrf %a yields %a + +pat zer $1==2 yields {const2, 0} +pat zer $1==4 yields {const2,0} {const2,0} +pat zer $1==6 yields {const2,0} {const2,0} {const2,0} +pat zer $1==8 yields {const2,0} {const2,0} + {const2,0} {const2,0} +pat zer defined($1) +with STACK +gen move {const2,$1/2},r0 + 1: + clr {autodec,sp} + sob r0,{label, 1b} + +/**************************************** + * Group 8 : Convert instructions * + ****************************************/ + +pat cii +with STACK +gen jsr pc,{label, "cii~"} + +pat cfi leaving cfu +pat ciu leaving cuu +pat cui leaving cuu + +pat cfu +with STACK +gen jsr pc,{label, "cfi~"} + +pat cif +with STACK +gen jsr pc,{label, "cif~"} + +pat cuf +with STACK +gen jsr pc,{label, "cuf~"} + +pat cff +with STACK +gen jsr pc,{label, "cff~"} + +pat cuu +with STACK +gen jsr pc,{label, "cuu~"} + +pat loc loc cii $1==1 && $2==2 +with src1or2 +uses reusing %1,REG +gen movb %1,%a yields %a + +pat loc loc cii $1==1 && $2==4 +with src1or2 +uses reusing %1,REG,REG +gen movb %1,%a + sxt %b yields %a %b + +pat loc loc cii $1==2 && $2==4 +with src2 +uses reusing %1,REG,REG +gen move %1,%a + test %a + sxt %b yields %a %b + +pat loc loc loc cii $1>=0 && $2==2 && $3==4 leaving loc $1 loc 0 + +pat loc loc loc cii $1< 0 && $2==2 && $3==4 leaving loc $1 loc 0-1 + +pat loc loc cii $1==4 && $2==2 +with src2 + +pat loc loc cuu $1==2 && $2==4 leaving loc 0 + +pat loc loc cuu $1==4 && $2==2 +with src2 + +pat loc loc cfi leaving loc $1 loc $2 cfu + +pat loc loc cfu $1==4 && $2==2 +with FLTREG yields {ftoint,%1} + +pat loc loc cfu $1==4 && $2==4 +with FLTREG yields {ftolong,%1} + +pat loc loc cfu $1==8 && $2==2 +with DBLREG yields {ftoint,%1.1} + +pat loc loc cfu $1==8 && $2==4 +with DBLREG yields {ftolong,%1.1} + +pat loc loc cif $1==2 && $2==4 +with src2 +uses FLTREG +gen movif %1,%a yields %a + +pat loc loc cif $1==2 && $2==8 +with src2 +uses DBLREG +gen movif %1,%a yields %a + +pat loc loc cif $1==4 && $2==4 +with exact long4-REGPAIR + uses FLTREG + gen setl. + movif %1,%a + seti. yields %a +with STACK + uses FLTREG + gen setl. + movif {autoinc,sp},%a + seti. yields %a + +pat loc loc cif $1==4 && $2==8 +with exact long4-REGPAIR + uses DBLREG + gen setl. + movif %1,%a + seti. yields %a +with STACK + uses DBLREG + gen setl. + movif {autoinc,sp},%a + seti. yields %a + +pat loc loc cuf $1==2 && $2==4 +with STACK +uses FLTREG +gen clr {autodec,sp} + setl. + movif {autoinc,sp},%a + seti. yields %a + +pat loc loc cuf $1==2 && $2==8 +with STACK +uses DBLREG +gen clr {autodec,sp} + setl. + movif {autoinc,sp},%a + seti. yields %a + +pat loc loc cuf $1==4 leaving loc $1 loc $2 cif + +pat loc loc cff $1==4 && $2==8 +with longf4 - FLTREG + uses DBLREG + gen movof %1,%a yields %a +with FLTREG + uses DBLREG + gen move %1,%a.1 yields %a + +pat loc loc cff $1==8 && $2==4 +with DBLREG yields %1.1 + +/**************************************** + * Group 9 : Logical instructions * + ****************************************/ + +pat and $1==2 +with const2 REG + gen bic {const2,~%1.num},%2 yields %2 +with REG const2 + gen bic {const2,~%2.num},%1 yields %1 +with REG REG + gen com %1 + bic %1,%2 yields %2 + +pat and defined($1) +with STACK +gen move {const2,$1}, r0 + jsr pc,{label, "and~"} + +pat ior $1==2 +with REG src2 + gen bis %2,%1 yields %1 +with src2 REG + gen bis %1,%2 yields %2 + +pat ior $1==8 +with exact src2 src2 src2 src2 STACK + gen bis %1,{regdef2,sp} + bis %2,{regind2,sp,2} + bis %3,{regind2,sp,4} + bis %4,{regind2,sp,6} +with STACK +uses REG={const2,$1} + gen add sp,%a + bis {autoinc,sp},{autoinc,%a} + bis {autoinc,sp},{autoinc,%a} + bis {autoinc,sp},{autoinc,%a} + bis {autoinc,sp},{autoinc,%a} + +pat ior defined($1) +with STACK +uses REG={const2,$1},REG={const2,$1/2} +gen add sp,%a + 1: + bis {autoinc,sp},{autoinc,%a} + sob %b,{label,1b} + +pat xor $1==2 +with REG REG + gen xor %1,%2 yields %2 +with REG REG + gen xor %2,%1 yields %1 + +pat xor defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "xor~"} + +pat com $1==2 +with REG +gen com %1 yields %1 + +pat com defined($1) +with STACK +uses REG={const2,$1/2},REG +gen mov sp,%b + 1: + com {autoinc,%b} + sob %a,{label,1b} + +pat rol $1==2 +with const2 ODDREG + gen ashc {const2,%1.num-16},%2 yields %2 +with REG ODDREG + gen sub {const2,16},%1 + ashc %1,%2 yields %2 + +pat rol defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "rol~"} + +pat ror $1==2 +with const2 ODDREG + gen ashc {const2,0-%1.num},%2 yields %2 +with REG ODDREG + gen neg %1 + ashc %1,%2 yields %2 + +pat ror defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "ror~"} + +pat com and $1==2 && $2==2 +with src2 REG +gen bic %1,%2 yields %2 + +pat com and $1==$2 +with STACK +uses REG={const2,$1},REG +gen mov sp,%b + add %a,%b + asr %a + 1: + bic {autoinc,sp},{autoinc,%b} + sob %a,{label,1b} + +/******************************** + * Group 10 : Set instructions * + ********************************/ + +pat inn $1==2 +with REG REG +gen neg %1 + ash %1,%2 + bic {const2,0177776},%2 yields %2 + +pat loc inn $2==2 && $1==0 +with REG +gen bic {const2,0177776},%1 yields %1 + +pat loc inn $2==2 && $1==1 +with REG +gen asr %1 + bic {const2,0177776},%1 yields %1 + +pat loc inn $2==2 +with REG +gen ash {const2,0-$1},%1 + bic {const2,0177776},%1 yields %1 + +pat loc inn zeq $2==2 yields {const2, 1<<$1} + leaving and 2 zeq $3 + +pat inn zeq $1==2 +with src2 +uses REG={const2,1} +gen ash %1,%a yields %a + leaving and 2 zeq $2 + +pat loc inn zne $2==2 yields {const2, 1<<$1} + leaving and 2 zne $3 + +pat inn zne $1==2 +with src2 +uses REG={const2,1} +gen ash %1,%a yields %a + leaving and 2 zne $2 + +pat inn defined($1) +with src2 STACK +gen move %1,r1 + move {const2,$1},r0 + jsr pc,{label, "inn~"} yields r0 + +pat set $1==2 +with REG +uses REG={const2,1} +gen ash %1,%a yields %a + +pat set defined($1) +with src2 STACK +gen move %1,r1 + move {const2,$1},r0 + jsr pc,{label, "set~"} + +/**************************************** + * Group 11 : Array instructions * + ****************************************/ + +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)==0 leaving adi 2 +pat lae aar $2==2 && rom($1,3)==1 && rom($1,1)!=0 leaving adi 2 adp 0-rom($1,1) + +pat lae aar $2==2 && rom($1,3)==2 && rom($1,1)==0 +with REG +gen asl %1 yields %1 leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==2 && rom($1,1)!=0 +with REG +gen asl %1 yields {regconst2,%1,(0-2)*rom($1,1)} + leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==4 && rom($1,1)==0 +with REG +gen ash {const2,2},%1 yields %1 leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==4 && rom($1,1)!=0 +with REG +gen ash {const2,2},%1 yields {regconst2,%1,(0-4)*rom($1,1)} + leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==8 && rom($1,1)==0 +with REG +gen ash {const2,3},%1 yields %1 + leaving adi 2 + +pat lae aar $2==2 && rom($1,3)==8 && rom($1,1)!=0 +with REG +gen ash {const2,3},%1 yields {regconst2,%1,(0-8)*rom($1,1)} + leaving adi 2 + +pat lae aar $2==2 && rom($1,1)==0 +with ODDREG +gen mul {const2,rom($1,3)},%1 yields %1 leaving adi 2 + +pat lae aar $2==2 && defined(rom($1,1)) +with ODDREG +gen mul {const2,rom($1,3)},%1 yields {regconst2,%1,(0-rom($1,3))*rom($1,1)} + leaving adi 2 + +pat aar $1==2 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + jsr pc,{label, "aar~"} + +pat lae sar defined(rom($1,3)) leaving lae $1 aar $2 sti rom($1,3) +pat lae lar defined(rom($1,3)) leaving lae $1 aar $2 loi rom($1,3) +pat sar $1==2 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + jsr pc,{label, "sar~"} + +pat lar $1==2 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + jsr pc,{label, "lar~"} + +/**************************************** + * group 12 : Compare instructions * + ****************************************/ + +pat cmi $1==2 +with src2 REG + gen sub %1,%2 yields %2 +with REG src2 + gen sub %2,%1 + neg %1 yields %1 + +pat cmi $1==4 +with STACK +gen jsr pc,{label, "cmi4~"} yields r0 + +pat cmf defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "cmf~"} yields r0 + +pat cmu $1==2 leaving cmp + +pat cmu $1==4 +with STACK +gen jsr pc,{label, "cmu4~"} yields r0 + +pat cmu defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "cmu~"} yields r0 + +pat cms $1==2 leaving cmi $1 + +pat cms defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "cms~"} yields r0 +pat cmp +with src2 src2 +uses REG = {const2,0} +gen cmp %1,%2 + beq {label,2f} + bhi {label,1f} + inc %a + br {label,2f} + 1: + dec %a + 2: yields %a + +proc txxand +with src2 REG +gen test %1 + bxx* {label,1f} + clr %2 + 1: yields %2 + +proc txxior +with src2 REG +gen test %1 + bxx* {label,1f} + bis {const2,1},%2 + 1: yields %2 + +proc txx +with src2 +uses REG={const2,0} +gen test %1 + bxx* {label,1f} + inc %a + 1: yields %a + +pat tlt and $2==2 call txxand("blt") +pat tle and $2==2 call txxand("ble") +pat teq and $2==2 call txxand("beq") +pat tne and $2==2 call txxand("bne") +pat tgt and $2==2 call txxand("bgt") +pat tge and $2==2 call txxand("bge") + +pat tlt ior $2==2 call txxior("bge") +pat tle ior $2==2 call txxior("bgt") +pat teq ior $2==2 call txxior("bne") +pat tne ior $2==2 call txxior("beq") +pat tgt ior $2==2 call txxior("ble") +pat tge ior $2==2 call txxior("blt") + +pat tlt call txx("bge") +pat tle call txx("bgt") +pat teq call txx("bne") +pat tne call txx("beq") +pat tgt call txx("ble") +pat tge call txx("blt") + +proc andtxx +with src2 src2 +uses REG={const2,0} +gen bit %1,%2 + bxx* {label,1f} + inc %a + 1: yields %a + +pat and tne $1==2 call andtxx("beq") +pat and teq $1==2 call andtxx("bne") + +proc cmitxxand +with src2 src2 REG +gen cmp %2,%1 + bxx* {label,1f} + clr %3 + 1: yields %3 + +proc cmitxxior +with src2 src2 REG +gen cmp %2,%1 + bxx* {label,1f} + bis {const2,1},%3 + 1: yields %3 + +proc cmitxx +with src2 src2 +uses REG={const2,0} +gen cmp %2,%1 + bxx* {label,1f} + inc %a + 1: yields %a + +pat cmi tlt and $1==2 && $3==2 call cmitxxand("blt") +pat cmi tle and $1==2 && $3==2 call cmitxxand("ble") +pat cmi teq and $1==2 && $3==2 call cmitxxand("beq") +pat cmi tne and $1==2 && $3==2 call cmitxxand("bne") +pat cmi tgt and $1==2 && $3==2 call cmitxxand("bgt") +pat cmi tge and $1==2 && $3==2 call cmitxxand("bge") + +pat cmi tlt ior $1==2 && $3==2 call cmitxxior("bge") +pat cmi tle ior $1==2 && $3==2 call cmitxxior("bgt") +pat cmi teq ior $1==2 && $3==2 call cmitxxior("bne") +pat cmi tne ior $1==2 && $3==2 call cmitxxior("beq") +pat cmi tgt ior $1==2 && $3==2 call cmitxxior("ble") +pat cmi tge ior $1==2 && $3==2 call cmitxxior("blt") + +pat cmi tlt $1==2 call cmitxx("bge") +pat cmi tle $1==2 call cmitxx("bgt") +pat cmi teq $1==2 call cmitxx("bne") +pat cmi tne $1==2 call cmitxx("beq") +pat cmi tgt $1==2 call cmitxx("ble") +pat cmi tge $1==2 call cmitxx("blt") + +pat loc cmi teq and $1>=0 && $1<=127 && $2==2 && $4==2 +with exact src1 REG + gen cmpb %1,{const2,$1} + beq {label,1f} + clr %2 + 1: yields %2 +with yields {const2, $1} + leaving cmi 2 teq and 2 + +pat loc cmi teq ior $1>=0 && $1<=127 && $2==2 && $4==2 +with exact src1 REG + gen cmpb %1,{const2,$1} + bne {label,1f} + bis {const2,1},%2 + 1: yields %2 +with yields {const2, $1} + leaving cmi 2 teq ior 2 + +pat loc cmi teq $1>=0 && $1<=127 && $2==2 +with exact src1 +uses REG={const2,0} + gen cmpb %1,{const2,$1} + bne {label,1f} + inc %a + 1: yields %a +with yields {const2, $1} + leaving cmi 2 teq + +pat loc cmi tne and $1>=0 && $1<=127 && $2==2 && $4==2 +with exact src1 REG + gen cmpb %1,{const2,$1} + bne {label,1f} + clr %2 + 1: yields %2 +with yields {const2, $1} + leaving cmi 2 tne and 2 + +pat loc cmi tne ior $1>=0 && $1<=127 && $2==2 && $4==2 +with exact src1 REG + gen cmpb %1,{const2,$1} + beq {label,1f} + bis {const2,1},%2 + 1: yields %2 +with yields {const2, $1} + leaving cmi 2 tne ior 2 + +pat loc cmi tne $1>=0 && $1<=127 && $2==2 +with exact src1 + uses REG={const2,0} + gen cmpb %1,{const2,$1} + beq {label,1f} + inc %a + 1: yields %a +with yields {const2, $1} + leaving cmi 2 tne + +proc cmptxx +with src2 src2 +uses REG={const2,0} +gen cmp %2,%1 + bxx* {label,1f} + inc %a + 1: yields %a + +pat cmp tlt call cmptxx("bhis") +pat cmp tle call cmptxx("bhi") +pat cmp teq call cmptxx("bne") +pat cmp tne call cmptxx("beq") +pat cmp tgt call cmptxx("blos") +pat cmp tge call cmptxx("blo") + +proc cmf4txx +with FLTREG FLTREG +uses REG={const2,0} +gen cmpf %2,%1 + cfcc. + bxx* {label,1f} + inc %a + 1: yields %a + +pat cmf tlt $1==4 call cmf4txx("bge") +pat cmf tle $1==4 call cmf4txx("bgt") +pat cmf teq $1==4 call cmf4txx("bne") +pat cmf tne $1==4 call cmf4txx("beq") +pat cmf tgt $1==4 call cmf4txx("ble") +pat cmf tge $1==4 call cmf4txx("blt") + +proc cmf8txx +with DBLREG double8 + uses REG={const2,0} + gen cmpf %2,%1 + cfcc. + bxx[1] {label,1f} + inc %a + 1: yields %a +with double8 DBLREG + uses REG={const2,0} + gen cmpf %1,%2 + cfcc. + bxx[2] {label,1f} + inc %a + 1: yields %a + +pat cmf tlt $1==8 call cmf8txx("bge","ble") +pat cmf tle $1==8 call cmf8txx("bgt","blt") +pat cmf teq $1==8 call cmf8txx("bne","bne") +pat cmf tne $1==8 call cmf8txx("beq","beq") +pat cmf tgt $1==8 call cmf8txx("ble","bge") +pat cmf tge $1==8 call cmf8txx("blt","bgt") + +/**************************************** + * Group 13 : Branch instructions * + ****************************************/ + +pat bra +with STACK +gen jbr {label, $1} + +proc bxx example beq +with src2 src2 STACK +gen cmp %2,%1 + jxx* {label, $1} +pat blt call bxx("jlt") +pat ble call bxx("jle") +pat beq call bxx("jeq") +pat bne call bxx("jne") +pat bgt call bxx("jgt") +pat bge call bxx("jge") + +pat loc beq $1>=0 && $1<=127 +with exact src1 STACK + gen cmpb %1,{const2,$1} + jeq {label, $2} +with yields {const2, $1} + leaving beq $2 + +pat loc bne $1>=0 && $1<=127 +with exact src1 STACK + gen cmpb %1,{const2,$1} + jne {label, $2} +with yields {const2, $1} + leaving bne $2 + +proc zxx example zeq +with src2 STACK +gen test %1 + jxx* {label, $1} + +pat zlt call zxx("jlt") +pat zle call zxx("jle") +pat zeq call zxx("jeq") +pat zne call zxx("jne") +pat zgt call zxx("jgt") +pat zge call zxx("jge") + +proc cmpzxx example cmp zeq +with src2 src2 STACK +gen cmp %2,%1 + jxx* {label, $2} + +pat cmp zlt call cmpzxx("jlo") +pat cmp zle call cmpzxx("jlos") +pat cmp zeq call cmpzxx("jeq") +pat cmp zne call cmpzxx("jne") +pat cmp zgt call cmpzxx("jhi") +pat cmp zge call cmpzxx("jhis") + +proc cmf4zxx example cmf zeq +with FLTREG FLTREG STACK +gen cmpf %2,%1 + cfcc. + jxx* {label, $2} + +pat cmf zlt $1==4 call cmf4zxx("jlt") +pat cmf zle $1==4 call cmf4zxx("jle") +pat cmf zeq $1==4 call cmf4zxx("jeq") +pat cmf zne $1==4 call cmf4zxx("jne") +pat cmf zgt $1==4 call cmf4zxx("jgt") +pat cmf zge $1==4 call cmf4zxx("jge") + +proc cmf8zxx example cmf zeq +with DBLREG double8 STACK + gen cmpf %2,%1 + cfcc. + jxx[1] {label, $2} +with double8 DBLREG STACK + gen cmpf %1,%2 + cfcc. + jxx[2] {label, $2} + +pat cmf zlt $1==8 call cmf8zxx("jlt","jgt") +pat cmf zle $1==8 call cmf8zxx("jle","jge") +pat cmf zeq $1==8 call cmf8zxx("jeq","jeq") +pat cmf zne $1==8 call cmf8zxx("jne","jne") +pat cmf zgt $1==8 call cmf8zxx("jgt","jlt") +pat cmf zge $1==8 call cmf8zxx("jge","jle") + +proc andzen example and zeq +with src2 src2 STACK +gen bit %1,%2 + jxx* {label, $2} + +pat and zeq $1==2 call andzen("jeq") +pat and zne $1==2 call andzen("jne") + +/************************************************ + * group 14 : Procedure call instructions * + ************************************************/ + +pat cal +with STACK +gen jsr pc,{label, $1} + +pat cai +with REG STACK +gen jsr pc,{regdef2,%1} + +pat lfr $1==2 yields r0 +pat lfr $1==4 yields r1 r0 +pat lfr $1==8 yields {relative8,"retar"} +pat lfr +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "lfr~"} + +pat lfr ret $1==$2 leaving ret 0 + + +pat ret $1==0 +with STACK +gen mov lb,sp + rts pc + +pat ret $1==2 +with src2 STACK +gen move %1,r0 + mov lb,sp + rts pc + +pat ret $1==4 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + mov lb,sp + rts pc + +pat ret $1==8 yields {addr_external, "retar"} + leaving sti 8 ret 0 + +pat ret +with STACK +gen move {const2,$1},r0 + jmp {label,"ret~"} + +/************************************************ + * Group 15 : Miscellaneous instructions * + ************************************************/ + +pat asp $1==2 +with STACK +gen tst {autoinc,sp} + +pat asp $1==4 +with STACK +gen cmp {autoinc,sp},{autoinc,sp} + +pat asp $1==0-2 +with STACK +gen tst {autodec,sp} + +pat asp +with STACK +gen add {const2,$1},sp + +pat ass $1==2 +with STACK +gen add {autoinc,sp},sp + +pat blm $1==4 +with REG REG +gen mov {autoinc,%2},{autoinc,%1} + mov {regdef2,%2},{regdef2,%1} + +pat blm $1==6 +with REG REG +gen mov {autoinc,%2},{autoinc,%1} + mov {autoinc,%2},{autoinc,%1} + mov {regdef2,%2},{regdef2,%1} + +pat blm $1==8 +with REG REG +gen mov {autoinc,%2},{autoinc,%1} + mov {autoinc,%2},{autoinc,%1} + mov {autoinc,%2},{autoinc,%1} + mov {regdef2,%2},{regdef2,%1} + +pat blm +with REG REG +uses REG={const2,$1/2} +gen 1: + mov {autoinc,%2},{autoinc,%1} + sob %a,{label,1b} + +pat lae csa $2==2 +with src2 STACK +gen move %1,r1 + move {addr_external,$1},r0 + jmp {label, "csa~"} + +pat csa $1==2 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + jmp {label, "csa~"} + +pat lae csb $2==2 +with src2 STACK +gen move %1,r1 + move {addr_external,$1},r0 + jmp {label, "csb~"} + +pat csb $1==2 +with STACK +gen mov {autoinc,sp},r0 + mov {autoinc,sp},r1 + jmp {label, "csb~"} + +pat dup $1==2 +with REG yields %1 %1 + +pat dup $1==4 +with exact long4 yields %1 %1 +with src2 src2 yields %2 %1 %2 %1 + +pat dup $1==8 +with exact long8 yields %1 %1 +with STACK +gen move {const2, $1}, r0 + jsr pc,{label, "dup~"} + +pat dup +with STACK +gen move {const2, $1}, r0 + jsr pc,{label, "dup~"} + +pat dus $1==2 +with src2 STACK +gen move %1,r0 + jsr pc,{label, "dup~"} + +pat gto +with STACK +gen mov {addr_external, $1},{autodec,sp} + jmp {label, "gto~"} + +pat fil +gen mov {addr_external, $1},{relative2, "hol0"+4} + +pat lim yields { relative2, "trpim~"} + +pat lin +gen mov {const2,$1},{relative2, "hol0"} + +pat lni +gen inc {relative2, "hol0"} + +pat lor $1==0 yields lb + +pat lor $1==1 +with STACK +uses REG +gen mov sp,%a yields %a + +pat lor $1==2 yields {relative2,"reghp~"} + +pat mon +with STACK +gen jsr pc,{label, "mon~"} + +pat nop +with STACK +gen jsr pc,{label, "nop~"} + +pat rck $1==2 +with src2 + +pat rtt leaving ret 0 + +pat sig +with src2 +uses REG +gen move {relative2,"trppc~"},%a + mov %1,{relative2,"trppc~"} yields %a + +pat sim +with STACK +gen jsr pc,{label, "sim~"} + +pat str $1==0 +with src2 +gen mov %1,lb + +pat str $1==1 +with src2 STACK +gen mov %1,sp + +pat str $1==2 +with STACK +gen jsr pc,{label, "strhp~"} + +pat trp +with STACK +gen jsr pc,{label, "trp~"} + +pat exg $1==2 +with src2 src2 yields %1 %2 + +pat exg defined($1) +with STACK +gen move {const2,$1},r0 + jsr pc,{label, "exg~"} + +pat lol lal sti $1==$2 && $3==1 /* throw away funny C-proc-prolog */ + +pat los +gen jmp {label, illins} + +pat sts +gen jmp {label, illins} + +pat inn +gen jmp {label, illins} + +pat set +gen jmp {label, illins} diff --git a/mach/pmds/Action b/mach/pmds/Action new file mode 100644 index 00000000..42ad4725 --- /dev/null +++ b/mach/pmds/Action @@ -0,0 +1,6 @@ +name "PMDS download program(s)" +dir dl +end +name "PMDS EM library" +dir libem +end diff --git a/mach/pmds/cv/Makefile b/mach/pmds/cv/Makefile new file mode 100644 index 00000000..88eac1cb --- /dev/null +++ b/mach/pmds/cv/Makefile @@ -0,0 +1,29 @@ +CFLAGS=-O + +pmcv: pmcv.o + $(CC) -o pmcv -n pmcv.o + +pmcv.c: + case `ack_sys` in \ + vax*) cp vax_cv.c pmcv.c ;; \ + pdp*) cp pdp_cv.c pmcv.c ;; \ + *) echo "A conversion program should be present in `pwd`/pmcv.c" ;\ + exit 9 ;; \ + esac + +install: ins_pmcv +ins_pmcv: pmcv + ../../install pmcv + +cmp: cmp_pmcv +cmp_pmcv: pmcv + -../../compare pmcv + +opr: + make pr | opr + +pr: + @pr `pwd`/pmcv.c + +clean: + -rm -f *.o *.old pmcv diff --git a/mach/pmds/cv/pdp_cv.c b/mach/pmds/cv/pdp_cv.c new file mode 100644 index 00000000..b11f6574 --- /dev/null +++ b/mach/pmds/cv/pdp_cv.c @@ -0,0 +1,41 @@ +/* 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 + +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; +} diff --git a/mach/pmds/cv/vax_cv.c b/mach/pmds/cv/vax_cv.c new file mode 100644 index 00000000..6e210f17 --- /dev/null +++ b/mach/pmds/cv/vax_cv.c @@ -0,0 +1,41 @@ +/* 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 vax-11 + while the target machine is a Philips Microcomputer Development system + +*/ + +#include + +main(argc,argv) char **argv ; { + char i_addr[4]; + short count; + char i_count[2]; + + if (argc != 3) { + fprintf(stderr,"Usage: %s vax-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[3]) ; putchar(i_addr[2]) ; + putchar(i_addr[1]) ; putchar(i_addr[0]) ; + 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; +} diff --git a/mach/pmds/libsys/LIST b/mach/pmds/libsys/LIST new file mode 100644 index 00000000..5b288000 --- /dev/null +++ b/mach/pmds/libsys/LIST @@ -0,0 +1,39 @@ +tail_mon +gtty.s +stty.s +chmod.s +close.s +creat.s +exec.s +fork.s +fstat.s +getgid.s +getpid.s +getuid.s +ioctl.s +kill.s +link.s +lseek.s +open.s +pipe.s +read.s +sbrk.s +stat.s +unlink.s +wait.s +write.s +cerror.s +access.s +alarm.s +chown.s +dup.s +mknod.s +mount.s +nice.s +profil.s +signal.s +exit1.s +exit2.s +time.s +cleanup.s +pause.s diff --git a/mach/pmds/libsys/Makefile b/mach/pmds/libsys/Makefile new file mode 100644 index 00000000..d3d832c3 --- /dev/null +++ b/mach/pmds/libsys/Makefile @@ -0,0 +1,16 @@ +install: + ../../install head_em + ../../install tail_mon + +cmp: + -../../compare head_em + -../../compare tail_mon + +clean : + +opr : + make pr | opr + +pr: + @pr `pwd`/head_em + @arch pv tail_mon | pr -h `pwd`/tail_mon diff --git a/mach/pmds/libsys/access.s b/mach/pmds/libsys/access.s new file mode 100644 index 00000000..24a8235a --- /dev/null +++ b/mach/pmds/libsys/access.s @@ -0,0 +1,21 @@ +.define _access +.extern _access +.text +_access: +tst.b -40(sp) +link a6,#-0 +move.w 12(a6), d2 +ext.l d2 +move.l d2,-(sp) +move.l 8(a6),-(sp) +jsr __Saccess +add.l #8,sp +unlk a6 +rts +__Saccess: trap #0 +.short 0x21 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/alarm.s b/mach/pmds/libsys/alarm.s new file mode 100644 index 00000000..88bcb728 --- /dev/null +++ b/mach/pmds/libsys/alarm.s @@ -0,0 +1,15 @@ +.define _alarm +.extern _alarm +.text +_alarm: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6),-(sp) +clr.w -(sp) +jsr __Salarm +add.l #4,sp +unlk a6 +rts +__Salarm: trap #0 +.short 0x1B + rts diff --git a/mach/pmds/libsys/cerror.s b/mach/pmds/libsys/cerror.s new file mode 100644 index 00000000..d9fff34c --- /dev/null +++ b/mach/pmds/libsys/cerror.s @@ -0,0 +1,9 @@ +.define cerror +.extern cerror +cerror: move.l d0,_errno + move.l #-1,d0 + rts +.bss +_errno: + .space 4 +.text diff --git a/mach/pmds/libsys/chmod.s b/mach/pmds/libsys/chmod.s new file mode 100644 index 00000000..3e628769 --- /dev/null +++ b/mach/pmds/libsys/chmod.s @@ -0,0 +1,21 @@ +.define _chmod +.extern _chmod +.text +_chmod: +tst.b -40(sp) +link a6,#-0 +move.w 12(a6), d2 +ext.l d2 +move.l d2,-(sp) +move.l 8(a6),-(sp) +jsr __Schmod +add.l #8,sp +unlk a6 +rts +__Schmod: trap #0 +.short 0xF + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/chown.s b/mach/pmds/libsys/chown.s new file mode 100644 index 00000000..8cd89680 --- /dev/null +++ b/mach/pmds/libsys/chown.s @@ -0,0 +1,24 @@ +.define _chown +.extern _chown +.text +_chown: +tst.b -40(sp) +link a6,#-0 +move.w 14(a6), d2 +ext.l d2 +move.w 12(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l d1,-(sp) +move.l 8(a6),-(sp) +jsr __Schown +lea 12(sp),sp +unlk a6 +rts +__Schown: trap #0 +.short 0x10 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/cleanup.s b/mach/pmds/libsys/cleanup.s new file mode 100644 index 00000000..ce4a7635 --- /dev/null +++ b/mach/pmds/libsys/cleanup.s @@ -0,0 +1,5 @@ +.define __cleanup +.extern __cleanup +.text +__cleanup: +rts diff --git a/mach/pmds/libsys/close.s b/mach/pmds/libsys/close.s new file mode 100644 index 00000000..a32ac79c --- /dev/null +++ b/mach/pmds/libsys/close.s @@ -0,0 +1,20 @@ +.define _close +.extern _close +.text +_close: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l d2,-(sp) +jsr __Sclose +add.l #4,sp +unlk a6 +rts +__Sclose: trap #0 +.short 0x6 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/creat.s b/mach/pmds/libsys/creat.s new file mode 100644 index 00000000..88df1031 --- /dev/null +++ b/mach/pmds/libsys/creat.s @@ -0,0 +1,20 @@ +.define _creat +.extern _creat +.text +_creat: +tst.b -40(sp) +link a6,#-0 +move.w 12(a6), d2 +ext.l d2 +move.l d2,-(sp) +move.l 8(a6),-(sp) +jsr __Screat +add.l #8,sp +unlk a6 +rts +__Screat: trap #0 +.short 0x8 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/dup.s b/mach/pmds/libsys/dup.s new file mode 100644 index 00000000..f189fb53 --- /dev/null +++ b/mach/pmds/libsys/dup.s @@ -0,0 +1,36 @@ +.define _dup +.define _dup2 +.extern _dup +.text +_dup: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l d2,-(sp) +jsr __Sdup +add.l #4,sp +unlk a6 +rts +.extern _dup2 +_dup2: +tst.b -40(sp) +link a6,#-0 +move.w 10(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l d1,-(sp) +jsr __Sdup2 +add.l #8,sp +unlk a6 +rts +__Sdup2: or.l #64,4(sp) + +__Sdup: trap #0 +.short 0x29 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/exec.s b/mach/pmds/libsys/exec.s new file mode 100644 index 00000000..22a8260d --- /dev/null +++ b/mach/pmds/libsys/exec.s @@ -0,0 +1,27 @@ +.define _execl +.define _execve +.define _execv +.extern _execl +.extern _execve +.extern _execv +_execl: tst.b -48(sp) + link a6,#0 + move.l _environ,-(sp) + pea 12(a6) + move.l 8(a6),-(sp) + jsr _execve + add.l #12,sp + unlk a6 + rts +_execve: trap #0 +.short 59 + jmp cerror +_execv: tst.b -48(sp) + link a6,#0 + move.l _environ,-(sp) + move.l 12(a6),-(sp) + move.l 8(a6),-(sp) + jsr _execve + add.l #12,sp + unlk a6 + rts diff --git a/mach/pmds/libsys/exit1.s b/mach/pmds/libsys/exit1.s new file mode 100644 index 00000000..d766750e --- /dev/null +++ b/mach/pmds/libsys/exit1.s @@ -0,0 +1,12 @@ +.define _exit +.extern _exit +.text +_exit: +tst.b -40(sp) +link a6,#-0 +jsr __cleanup +move.w 8(a6),-(sp) +jsr __exit +add.l #2,sp +unlk a6 +rts diff --git a/mach/pmds/libsys/exit2.s b/mach/pmds/libsys/exit2.s new file mode 100644 index 00000000..ea2bea6f --- /dev/null +++ b/mach/pmds/libsys/exit2.s @@ -0,0 +1,15 @@ +.define __exit +.extern __exit +.text +__exit: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l d2,-(sp) +jsr __Sexit +add.l #4,sp +unlk a6 +rts +__Sexit: trap #0 +.short 0x1 diff --git a/mach/pmds/libsys/fork.s b/mach/pmds/libsys/fork.s new file mode 100644 index 00000000..ca96887d --- /dev/null +++ b/mach/pmds/libsys/fork.s @@ -0,0 +1,12 @@ +.define _fork +.extern _fork +_fork: trap #0 +.short 0x2 + bra 3f + rts +3: + bcc 2f + jmp cerror +2: + clr.l d0 + rts diff --git a/mach/pmds/libsys/fstat.s b/mach/pmds/libsys/fstat.s new file mode 100644 index 00000000..3aaee95e --- /dev/null +++ b/mach/pmds/libsys/fstat.s @@ -0,0 +1,21 @@ +.define _fstat +.extern _fstat +.text +_fstat: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l 10(a6),-(sp) +move.l d2,-(sp) +jsr __Sfstat +add.l #8,sp +unlk a6 +rts +__Sfstat: trap #0 +.short 0x1C + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/getgid.s b/mach/pmds/libsys/getgid.s new file mode 100644 index 00000000..098977ad --- /dev/null +++ b/mach/pmds/libsys/getgid.s @@ -0,0 +1,12 @@ +.define _getgid +.define _getegid +.extern _getgid +.extern _getegid +_getgid: trap #0 +.short 0x2F + rts + +_getegid: trap #0 +.short 0x2F + move.l d1,d0 + rts diff --git a/mach/pmds/libsys/getpid.s b/mach/pmds/libsys/getpid.s new file mode 100644 index 00000000..75894271 --- /dev/null +++ b/mach/pmds/libsys/getpid.s @@ -0,0 +1,5 @@ +.define _getpid +.extern _getpid +_getpid: trap #0 +.short 0x14 + rts diff --git a/mach/pmds/libsys/getuid.s b/mach/pmds/libsys/getuid.s new file mode 100644 index 00000000..53f6b0be --- /dev/null +++ b/mach/pmds/libsys/getuid.s @@ -0,0 +1,12 @@ +.define _getuid +.define _geteuid +.extern _getuid +.extern _geteuid +_getuid: trap #0 +.short 0x18 + rts + +_geteuid: trap #0 +.short 0x18 + move.l d1,d0 + rts diff --git a/mach/pmds/libsys/gtty.s b/mach/pmds/libsys/gtty.s new file mode 100644 index 00000000..ee9f096c --- /dev/null +++ b/mach/pmds/libsys/gtty.s @@ -0,0 +1,13 @@ +.define _gtty +.extern _gtty +.text +_gtty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29704,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/pmds/libsys/head_em.s b/mach/pmds/libsys/head_em.s new file mode 100644 index 00000000..92d4f2e7 --- /dev/null +++ b/mach/pmds/libsys/head_em.s @@ -0,0 +1,58 @@ +.define CERASE,CKILL,CSTOP,CSTART +.define .lino,.filn + +.define F_DUM,EXIT + +.define begtext,begdata,begbss +.define EARRAY,ERANGE,ESET,EIDIVZ,EHEAP,EILLINS,ECASE +.define hol0,.reghp,.limhp,.trpim,.trppc +.define LINO_AD,FILN_AD + + +CERASE = 010 +CKILL = 030 +CSTART = 021 +CSTOP = 023 +F_DUM = 0 + + +LINO_AD = 0 +FILN_AD = 4 + +EARRAY = 0 +ERANGE = 1 +ESET = 2 +EIDIVZ = 6 +EHEAP = 17 +EILLINS = 18 +ECASE = 20 + + .text +begtext: + add.l #2,sp !convert argc from 4-byte to 2-byte + pea endbss + jsr _brk + add.l #4,sp + jsr _m_a_i_n + add #010,sp +EXIT: + + .data +begdata: +hol0: +.lino: + .short 0,0 ! lino +.filn: + .long 0 ! filn +.reghp: + .long endbss +.limhp: + .long endbss +.trppc: + .long 0 +.trpim: + .short 0 + + + .bss +begbss: diff --git a/mach/pmds/libsys/ioctl.s b/mach/pmds/libsys/ioctl.s new file mode 100644 index 00000000..fea85879 --- /dev/null +++ b/mach/pmds/libsys/ioctl.s @@ -0,0 +1,24 @@ +.define _ioctl +.extern _ioctl +.text +_ioctl: +tst.b -40(sp) +link a6,#-0 +move.w 10(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l 12(a6),-(sp) +move.l d2,-(sp) +move.l d1,-(sp) +jsr __Sioctl +lea 12(sp),sp +unlk a6 +rts +__Sioctl: trap #0 +.short 0x36 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/kill.s b/mach/pmds/libsys/kill.s new file mode 100644 index 00000000..d900ac2b --- /dev/null +++ b/mach/pmds/libsys/kill.s @@ -0,0 +1,23 @@ +.define _kill +.extern _kill +.text +_kill: +tst.b -40(sp) +link a6,#-0 +move.w 10(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l d1,-(sp) +jsr __Skill +add.l #8,sp +unlk a6 +rts +__Skill: trap #0 +.short 0x25 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/link.s b/mach/pmds/libsys/link.s new file mode 100644 index 00000000..e1531b95 --- /dev/null +++ b/mach/pmds/libsys/link.s @@ -0,0 +1,9 @@ +.define _link +.extern _link +_link: trap #0 +.short 0x9 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/lseek.s b/mach/pmds/libsys/lseek.s new file mode 100644 index 00000000..8be8d2bd --- /dev/null +++ b/mach/pmds/libsys/lseek.s @@ -0,0 +1,23 @@ +.define _lseek +.extern _lseek +.text +_lseek: +tst.b -40(sp) +link a6,#-0 +move.w 14(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l 10(a6),-(sp) +move.l d1,-(sp) +jsr __Slseek +lea 12(sp),sp +unlk a6 +rts +__Slseek: trap #0 +.short 0x13 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/mknod.s b/mach/pmds/libsys/mknod.s new file mode 100644 index 00000000..306035fd --- /dev/null +++ b/mach/pmds/libsys/mknod.s @@ -0,0 +1,24 @@ +.define _mknod +.extern _mknod +.text +_mknod: +tst.b -40(sp) +link a6,#-0 +move.w 14(a6), d2 +ext.l d2 +move.w 12(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l d1,-(sp) +move.l 8(a6),-(sp) +jsr __Smknod +lea 12(sp),sp +unlk a6 +rts +__Smknod: trap #0 +.short 0xE + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/mount.s b/mach/pmds/libsys/mount.s new file mode 100644 index 00000000..84967835 --- /dev/null +++ b/mach/pmds/libsys/mount.s @@ -0,0 +1,22 @@ +.define _mount +.extern _mount +.text +_mount: +tst.b -40(sp) +link a6,#-0 +move.w 16(a6), d2 +ext.l d2 +move.l d2,-(sp) +move.l 12(a6),-(sp) +move.l 8(a6),-(sp) +jsr __Smount +lea 12(sp),sp +unlk a6 +rts +__Smount: trap #0 +.short 0x15 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/nice.s b/mach/pmds/libsys/nice.s new file mode 100644 index 00000000..b264a5d6 --- /dev/null +++ b/mach/pmds/libsys/nice.s @@ -0,0 +1,20 @@ +.define _nice +.extern _nice +.text +_nice: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l d2,-(sp) +jsr __Snice +add.l #4,sp +unlk a6 +rts +__Snice: trap #0 +.short 0x22 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/open.s b/mach/pmds/libsys/open.s new file mode 100644 index 00000000..6a947622 --- /dev/null +++ b/mach/pmds/libsys/open.s @@ -0,0 +1,20 @@ +.define _open +.extern _open +.text +_open: +tst.b -40(sp) +link a6,#-0 +move.w 12(a6), d2 +ext.l d2 +move.l d2,-(sp) +move.l 8(a6),-(sp) +jsr __Sopen +add.l #8,sp +unlk a6 +rts +__Sopen: trap #0 +.short 0x5 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/pause.s b/mach/pmds/libsys/pause.s new file mode 100644 index 00000000..3ce0e8c9 --- /dev/null +++ b/mach/pmds/libsys/pause.s @@ -0,0 +1,8 @@ +.define _pause +.extern _pause +_pause: trap #0 +.short 29 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/pipe.s b/mach/pmds/libsys/pipe.s new file mode 100644 index 00000000..0b57d35f --- /dev/null +++ b/mach/pmds/libsys/pipe.s @@ -0,0 +1,12 @@ +.define _pipe +.extern _pipe +_pipe: trap #0 +.short 0x2A + bcc 1f + jmp cerror +1: + move.l 4(sp),a0 + move.w d0,(a0)+ + move.w d1,(a0) + clr.l d0 + rts diff --git a/mach/pmds/libsys/profil.s b/mach/pmds/libsys/profil.s new file mode 100644 index 00000000..475087c0 --- /dev/null +++ b/mach/pmds/libsys/profil.s @@ -0,0 +1,23 @@ +.define _profil +.extern _profil +.text +_profil: +tst.b -40(sp) +link a6,#-0 +move.w 16(a6), d2 +ext.l d2 +move.w 14(a6), d1 +ext.l d1 +move.w 12(a6), d0 +ext.l d0 +move.l d2,-(sp) +move.l d1,-(sp) +move.l d0,-(sp) +move.l 8(a6),-(sp) +jsr __Sprofil +lea 16(sp),sp +unlk a6 +rts +__Sprofil: trap #0 +.short 0x2C + rts diff --git a/mach/pmds/libsys/read.s b/mach/pmds/libsys/read.s new file mode 100644 index 00000000..ccf421ca --- /dev/null +++ b/mach/pmds/libsys/read.s @@ -0,0 +1,23 @@ +.define _read +.extern _read +.text +_read: +tst.b -40(sp) +link a6,#-0 +move.w 14(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l 10(a6),-(sp) +move.l d1,-(sp) +jsr __Sread +lea 12(sp),sp +unlk a6 +rts +__Sread: trap #0 +.short 0x3 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds/libsys/sbrk.s b/mach/pmds/libsys/sbrk.s new file mode 100644 index 00000000..4ec68dce --- /dev/null +++ b/mach/pmds/libsys/sbrk.s @@ -0,0 +1,50 @@ +.define _brk +.define _sbrk +.extern _brk +.text +_brk: +tst.b -40(sp) +link a6,#-0 +move.l 8(a6),-(sp) +jsr __Sbrk +add.l #4,sp +unlk a6 +rts +.extern _sbrk +_sbrk: +tst.b -40(sp) +link a6,#-0 +move.w 8(a6), d2 +ext.l d2 +move.l d2,-(sp) +jsr __Ssbrk +add.l #4,sp +unlk a6 +rts +__Ssbrk: tst.b -8(sp) + move.l 4(sp),d0 + beq 1f + add.l nd,d0 + move.l d0,-(sp) + clr.l -(sp) + trap #0 +.short 0x11 + add.l #8,sp + bcc 1f + jmp cerror +1: + move.l nd,d0 + move.l 4(sp),d1 + add.l d1,nd + rts +__Sbrk: trap #0 +.short 0x11 + bcc 1f + jmp cerror +1: + move.l 4(sp),nd + clr.l d0 + rts +.data +nd: .long endbss +.text diff --git a/mach/pmds/libsys/signal.s b/mach/pmds/libsys/signal.s new file mode 100644 index 00000000..22fdd1d4 --- /dev/null +++ b/mach/pmds/libsys/signal.s @@ -0,0 +1,52 @@ +.define _signal +.extern _signal +NSIG=32 +_signal: + move.w 4(sp), d0 + ext.l d0 + cmp.l #NSIG,d0 + bcc 1f + move.l 6(sp),d1 + move.l d0,a0 + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a1 + move.l d1,(a0) + beq 2f + btst #0,d1 + bne 2f + move.l #enter,d1 +2: + move.l d1,-(sp) + move.l d0,-(sp) + clr.l -(sp) + trap #0 +.short 48 + add.l #12,sp + bcs 3f + btst #0,d0 + bne 4f + move.l a1,d0 +4: + rts +1: + move.l #22,d0 +3: + jmp cerror + +enter: + movem.l d0/d1/a0/a1,-(sp) + move.l 16(sp),a0 + move.l a0,-(sp) + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a0 + jsr (a0) + add.l #4,sp + movem.l (sp)+,d0/d1/a0/a1 + add.l #4,sp + rtr +.bss +dvect: .space 4*NSIG diff --git a/mach/pmds/libsys/stat.s b/mach/pmds/libsys/stat.s new file mode 100644 index 00000000..45dfa755 --- /dev/null +++ b/mach/pmds/libsys/stat.s @@ -0,0 +1,9 @@ +.define _stat +.extern _stat +_stat: trap #0 +.short 0x12 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/stty.s b/mach/pmds/libsys/stty.s new file mode 100644 index 00000000..46a497cd --- /dev/null +++ b/mach/pmds/libsys/stty.s @@ -0,0 +1,13 @@ +.define _stty +.extern _stty +.text +_stty: +tst.b -40(sp) +link a6,#-0 +move.l 10(a6),-(sp) +move.w #29705,-(sp) +move.w 8(a6),-(sp) +jsr _ioctl +add.l #8,sp +unlk a6 +rts diff --git a/mach/pmds/libsys/time.s b/mach/pmds/libsys/time.s new file mode 100644 index 00000000..dce23657 --- /dev/null +++ b/mach/pmds/libsys/time.s @@ -0,0 +1,21 @@ +.define _time +.define _ftime +.extern _time +_time: + trap #0 +.short 0xD + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.l d0,(a0) +1: + rts +.extern _ftime +_ftime: + trap #0 +.short 0x23 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/unlink.s b/mach/pmds/libsys/unlink.s new file mode 100644 index 00000000..2093ce74 --- /dev/null +++ b/mach/pmds/libsys/unlink.s @@ -0,0 +1,9 @@ +.define _unlink +.extern _unlink +_unlink: trap #0 +.short 0xA + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds/libsys/wait.s b/mach/pmds/libsys/wait.s new file mode 100644 index 00000000..fa84833c --- /dev/null +++ b/mach/pmds/libsys/wait.s @@ -0,0 +1,13 @@ +.define _wait +.extern _wait +_wait: trap #0 +.short 0x7 + bcc 1f + jmp cerror +1: + tst.l 4(sp) + beq 2f + move.l 4(sp),a0 + move.w d1,(a0) +2: + rts diff --git a/mach/pmds/libsys/write.s b/mach/pmds/libsys/write.s new file mode 100644 index 00000000..8789104e --- /dev/null +++ b/mach/pmds/libsys/write.s @@ -0,0 +1,23 @@ +.define _write +.extern _write +.text +_write: +tst.b -40(sp) +link a6,#-0 +move.w 14(a6), d2 +ext.l d2 +move.w 8(a6), d1 +ext.l d1 +move.l d2,-(sp) +move.l 10(a6),-(sp) +move.l d1,-(sp) +jsr __Swrite +lea 12(sp),sp +unlk a6 +rts +__Swrite: trap #0 +.short 0x4 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/LIST b/mach/pmds4/libsys/LIST new file mode 100644 index 00000000..df1f06ac --- /dev/null +++ b/mach/pmds4/libsys/LIST @@ -0,0 +1,36 @@ +tail_mon +chmod.s +close.s +creat.s +exec.s +fork.s +fstat.s +getgid.s +getpid.s +getuid.s +ioctl.s +kill.s +link.s +lseek.s +open.s +pipe.s +read.s +sbrk.s +stat.s +unlink.s +wait.s +write.s +cerror.s +access.s +alarm.s +chown.s +dup.s +mknod.s +mount.s +nice.s +profil.s +signal.s +exit1.s +exit2.s +time.s +cleanup.s diff --git a/mach/pmds4/libsys/access.s b/mach/pmds4/libsys/access.s new file mode 100644 index 00000000..1618ec88 --- /dev/null +++ b/mach/pmds4/libsys/access.s @@ -0,0 +1,10 @@ +.define _access +.extern _access +rts +_access: trap #0 +.short 0x21 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/alarm.s b/mach/pmds4/libsys/alarm.s new file mode 100644 index 00000000..4e8e6982 --- /dev/null +++ b/mach/pmds4/libsys/alarm.s @@ -0,0 +1,6 @@ +.define _alarm +.extern _alarm +.text +_alarm: trap #0 +.short 0x1B + rts diff --git a/mach/pmds4/libsys/cerror.s b/mach/pmds4/libsys/cerror.s new file mode 100644 index 00000000..d9fff34c --- /dev/null +++ b/mach/pmds4/libsys/cerror.s @@ -0,0 +1,9 @@ +.define cerror +.extern cerror +cerror: move.l d0,_errno + move.l #-1,d0 + rts +.bss +_errno: + .space 4 +.text diff --git a/mach/pmds4/libsys/chmod.s b/mach/pmds4/libsys/chmod.s new file mode 100644 index 00000000..d51b23b6 --- /dev/null +++ b/mach/pmds4/libsys/chmod.s @@ -0,0 +1,9 @@ +.define _chmod +.extern _chmod +_chmod: trap #0 +.short 0xF + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/chown.s b/mach/pmds4/libsys/chown.s new file mode 100644 index 00000000..dd96bb18 --- /dev/null +++ b/mach/pmds4/libsys/chown.s @@ -0,0 +1,10 @@ +.define _chown +.extern _chown +.text +_chown: trap #0 +.short 0x10 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/cleanup.s b/mach/pmds4/libsys/cleanup.s new file mode 100644 index 00000000..ce4a7635 --- /dev/null +++ b/mach/pmds4/libsys/cleanup.s @@ -0,0 +1,5 @@ +.define __cleanup +.extern __cleanup +.text +__cleanup: +rts diff --git a/mach/pmds4/libsys/close.s b/mach/pmds4/libsys/close.s new file mode 100644 index 00000000..3f330bc8 --- /dev/null +++ b/mach/pmds4/libsys/close.s @@ -0,0 +1,9 @@ +.define _close +.extern _close +_close: trap #0 +.short 0x6 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/creat.s b/mach/pmds4/libsys/creat.s new file mode 100644 index 00000000..ed29f451 --- /dev/null +++ b/mach/pmds4/libsys/creat.s @@ -0,0 +1,8 @@ +.define _creat +.extern _creat +_creat: trap #0 +.short 0x8 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/dup.s b/mach/pmds4/libsys/dup.s new file mode 100644 index 00000000..2adfabdd --- /dev/null +++ b/mach/pmds4/libsys/dup.s @@ -0,0 +1,13 @@ +.define _dup +.define _dup2 +.extern _dup +.text +.extern _dup2 +_dup2: or.l #64,4(sp) + +_dup: trap #0 +.short 0x29 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/exec.s b/mach/pmds4/libsys/exec.s new file mode 100644 index 00000000..8e38e94c --- /dev/null +++ b/mach/pmds4/libsys/exec.s @@ -0,0 +1,13 @@ +.define _execl +.define _execve +.extern _execl +.extern _execve +_execl: tst.b -48(sp) + link a6,#0 + move.l _environ,-(sp) + pea 12(a6) + move.l 8(a6),-(sp) + jsr _execve +_execve: trap #0 +.short 59 + jmp cerror diff --git a/mach/pmds4/libsys/exit1.s b/mach/pmds4/libsys/exit1.s new file mode 100644 index 00000000..3824a590 --- /dev/null +++ b/mach/pmds4/libsys/exit1.s @@ -0,0 +1,12 @@ +.define _exit +.extern _exit +.text +_exit: +tst.b -40(sp) +link a6,#-0 +jsr __cleanup +move.l 8(a6),-(sp) +jsr __exit +add.l #4,sp +unlk a6 +rts diff --git a/mach/pmds4/libsys/exit2.s b/mach/pmds4/libsys/exit2.s new file mode 100644 index 00000000..5cbdc68f --- /dev/null +++ b/mach/pmds4/libsys/exit2.s @@ -0,0 +1,4 @@ +.define __exit +.extern __exit +__exit: trap #0 +.short 0x1 diff --git a/mach/pmds4/libsys/fork.s b/mach/pmds4/libsys/fork.s new file mode 100644 index 00000000..b338b3e1 --- /dev/null +++ b/mach/pmds4/libsys/fork.s @@ -0,0 +1,11 @@ +.define _fork +.extern _fork +_fork: trap #0 +.short 0x2 + bra 1f + bcc 2f + jmp cerror +2: + clr.l d0 +1: + rts diff --git a/mach/pmds4/libsys/fstat.s b/mach/pmds4/libsys/fstat.s new file mode 100644 index 00000000..f574f28b --- /dev/null +++ b/mach/pmds4/libsys/fstat.s @@ -0,0 +1,9 @@ +.define _fstat +.extern _fstat +_fstat: trap #0 +.short 0x1C + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/getgid.s b/mach/pmds4/libsys/getgid.s new file mode 100644 index 00000000..098977ad --- /dev/null +++ b/mach/pmds4/libsys/getgid.s @@ -0,0 +1,12 @@ +.define _getgid +.define _getegid +.extern _getgid +.extern _getegid +_getgid: trap #0 +.short 0x2F + rts + +_getegid: trap #0 +.short 0x2F + move.l d1,d0 + rts diff --git a/mach/pmds4/libsys/getpid.s b/mach/pmds4/libsys/getpid.s new file mode 100644 index 00000000..75894271 --- /dev/null +++ b/mach/pmds4/libsys/getpid.s @@ -0,0 +1,5 @@ +.define _getpid +.extern _getpid +_getpid: trap #0 +.short 0x14 + rts diff --git a/mach/pmds4/libsys/getuid.s b/mach/pmds4/libsys/getuid.s new file mode 100644 index 00000000..53f6b0be --- /dev/null +++ b/mach/pmds4/libsys/getuid.s @@ -0,0 +1,12 @@ +.define _getuid +.define _geteuid +.extern _getuid +.extern _geteuid +_getuid: trap #0 +.short 0x18 + rts + +_geteuid: trap #0 +.short 0x18 + move.l d1,d0 + rts diff --git a/mach/pmds4/libsys/head_em.s b/mach/pmds4/libsys/head_em.s new file mode 100644 index 00000000..f44498c8 --- /dev/null +++ b/mach/pmds4/libsys/head_em.s @@ -0,0 +1,60 @@ +.define CERASE,CKILL,CSTOP,CSTART +.define .lino,.filn + +.define F_DUM,EXIT + +.define begtext,begdata,begbss +.define EARRAY,ERANGE,ESET,EIDIVZ,EHEAP,EILLINS,ECASE +.define hol0,.reghp,.limhp,.trpim,.trppc +.define LINO_AD,FILN_AD + + +CERASE = 010 +CKILL = 030 +CSTART = 021 +CSTOP = 023 +F_DUM = 0 + + +LINO_AD = 0 +FILN_AD = 4 + +EARRAY = 0 +ERANGE = 1 +ESET = 2 +EIDIVZ = 6 +EHEAP = 17 +EILLINS = 18 +ECASE = 20 + + .text +begtext: + pea endbss + jsr _brk + add.l #4,sp + jsr _m_a_i_n + add #012,sp +EXIT: + + jsr __exit + + + .data +begdata: +hol0: +.lino: + .long 0 ! lino +.filn: + .long 0 ! filn +.reghp: + .long endbss +.limhp: + .long endbss +.trppc: + .long 0 +.trpim: + .long 0 ! was short + + + .bss +begbss: diff --git a/mach/pmds4/libsys/ioctl.s b/mach/pmds4/libsys/ioctl.s new file mode 100644 index 00000000..4d4a772c --- /dev/null +++ b/mach/pmds4/libsys/ioctl.s @@ -0,0 +1,9 @@ +.define _ioctl +.extern _ioctl +_ioctl: trap #0 +.short 0x36 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/kill.s b/mach/pmds4/libsys/kill.s new file mode 100644 index 00000000..191f044f --- /dev/null +++ b/mach/pmds4/libsys/kill.s @@ -0,0 +1,9 @@ +.define _kill +.extern _kill +_kill: trap #0 +.short 0x25 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/link.s b/mach/pmds4/libsys/link.s new file mode 100644 index 00000000..e1531b95 --- /dev/null +++ b/mach/pmds4/libsys/link.s @@ -0,0 +1,9 @@ +.define _link +.extern _link +_link: trap #0 +.short 0x9 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/lseek.s b/mach/pmds4/libsys/lseek.s new file mode 100644 index 00000000..b3e26e73 --- /dev/null +++ b/mach/pmds4/libsys/lseek.s @@ -0,0 +1,8 @@ +.define _lseek +.extern _lseek +_lseek: trap #0 +.short 0x13 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/mknod.s b/mach/pmds4/libsys/mknod.s new file mode 100644 index 00000000..bc3cd677 --- /dev/null +++ b/mach/pmds4/libsys/mknod.s @@ -0,0 +1,10 @@ +.define _mknod +.extern _mknod +.text +_mknod: trap #0 +.short 0xE + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/mount.s b/mach/pmds4/libsys/mount.s new file mode 100644 index 00000000..6cb2c42c --- /dev/null +++ b/mach/pmds4/libsys/mount.s @@ -0,0 +1,10 @@ +.define _mount +.extern _mount +.text +_mount: trap #0 +.short 0x15 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/nice.s b/mach/pmds4/libsys/nice.s new file mode 100644 index 00000000..2737392d --- /dev/null +++ b/mach/pmds4/libsys/nice.s @@ -0,0 +1,10 @@ +.define _nice +.extern _nice +.text +_nice: trap #0 +.short 0x22 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/open.s b/mach/pmds4/libsys/open.s new file mode 100644 index 00000000..ef2b038f --- /dev/null +++ b/mach/pmds4/libsys/open.s @@ -0,0 +1,8 @@ +.define _open +.extern _open +_open: trap #0 +.short 0x5 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/pipe.s b/mach/pmds4/libsys/pipe.s new file mode 100644 index 00000000..6f011c01 --- /dev/null +++ b/mach/pmds4/libsys/pipe.s @@ -0,0 +1,12 @@ +.define _pipe +.extern _pipe +_pipe: trap #0 +.short 0x2A + bcc 1f + jmp cerror +1: + move.l 4(sp),a0 + move.l d0,(a0)+ + move.l d1,(a0) + clr.l d0 + rts diff --git a/mach/pmds4/libsys/profil.s b/mach/pmds4/libsys/profil.s new file mode 100644 index 00000000..0651fdba --- /dev/null +++ b/mach/pmds4/libsys/profil.s @@ -0,0 +1,6 @@ +.define _profil +.extern _profil +.text +_profil: trap #0 +.short 0x2C + rts diff --git a/mach/pmds4/libsys/read.s b/mach/pmds4/libsys/read.s new file mode 100644 index 00000000..6609752c --- /dev/null +++ b/mach/pmds4/libsys/read.s @@ -0,0 +1,8 @@ +.define _read +.extern _read +_read: trap #0 +.short 0x3 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/pmds4/libsys/sbrk.s b/mach/pmds4/libsys/sbrk.s new file mode 100644 index 00000000..aae02474 --- /dev/null +++ b/mach/pmds4/libsys/sbrk.s @@ -0,0 +1,31 @@ +.define _sbrk +.define _brk +.extern _sbrk +.extern _brk +_sbrk: tst.b -8(sp) + move.l 4(sp),d0 + beq 1f + add.l nd,d0 + move.l d0,-(sp) + clr.l -(sp) + trap #0 +.short 0x11 + add.l #8,sp + bcc 1f + jmp cerror +1: + move.l nd,d0 + move.l 4(sp),d1 + add.l d1,nd + rts +_brk: trap #0 +.short 0x11 + bcc 1f + jmp cerror +1: + move.l 4(sp),nd + clr.l d0 + rts +.data +nd: .long endbss +.text diff --git a/mach/pmds4/libsys/signal.s b/mach/pmds4/libsys/signal.s new file mode 100644 index 00000000..22fdd1d4 --- /dev/null +++ b/mach/pmds4/libsys/signal.s @@ -0,0 +1,52 @@ +.define _signal +.extern _signal +NSIG=32 +_signal: + move.w 4(sp), d0 + ext.l d0 + cmp.l #NSIG,d0 + bcc 1f + move.l 6(sp),d1 + move.l d0,a0 + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a1 + move.l d1,(a0) + beq 2f + btst #0,d1 + bne 2f + move.l #enter,d1 +2: + move.l d1,-(sp) + move.l d0,-(sp) + clr.l -(sp) + trap #0 +.short 48 + add.l #12,sp + bcs 3f + btst #0,d0 + bne 4f + move.l a1,d0 +4: + rts +1: + move.l #22,d0 +3: + jmp cerror + +enter: + movem.l d0/d1/a0/a1,-(sp) + move.l 16(sp),a0 + move.l a0,-(sp) + add.l a0,a0 + add.l a0,a0 + add.l #dvect,a0 + move.l (a0),a0 + jsr (a0) + add.l #4,sp + movem.l (sp)+,d0/d1/a0/a1 + add.l #4,sp + rtr +.bss +dvect: .space 4*NSIG diff --git a/mach/pmds4/libsys/stat.s b/mach/pmds4/libsys/stat.s new file mode 100644 index 00000000..45dfa755 --- /dev/null +++ b/mach/pmds4/libsys/stat.s @@ -0,0 +1,9 @@ +.define _stat +.extern _stat +_stat: trap #0 +.short 0x12 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/time.s b/mach/pmds4/libsys/time.s new file mode 100644 index 00000000..dce23657 --- /dev/null +++ b/mach/pmds4/libsys/time.s @@ -0,0 +1,21 @@ +.define _time +.define _ftime +.extern _time +_time: + trap #0 +.short 0xD + tst.l 4(sp) + beq 1f + move.l 4(sp),a0 + move.l d0,(a0) +1: + rts +.extern _ftime +_ftime: + trap #0 +.short 0x23 + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/unlink.s b/mach/pmds4/libsys/unlink.s new file mode 100644 index 00000000..2093ce74 --- /dev/null +++ b/mach/pmds4/libsys/unlink.s @@ -0,0 +1,9 @@ +.define _unlink +.extern _unlink +_unlink: trap #0 +.short 0xA + bcc 1f + jmp cerror +1: + clr.l d0 + rts diff --git a/mach/pmds4/libsys/wait.s b/mach/pmds4/libsys/wait.s new file mode 100644 index 00000000..7a8a6ebb --- /dev/null +++ b/mach/pmds4/libsys/wait.s @@ -0,0 +1,13 @@ +.define _wait +.extern _wait +_wait: trap #0 +.short 0x7 + bcc 1f + jmp cerror +1: + tst.l 4(sp) + beq 2f + move.l 4(sp),a0 + move.l d1,(a0) +2: + rts diff --git a/mach/pmds4/libsys/write.s b/mach/pmds4/libsys/write.s new file mode 100644 index 00000000..cb87ca0f --- /dev/null +++ b/mach/pmds4/libsys/write.s @@ -0,0 +1,8 @@ +.define _write +.extern _write +_write: trap #0 +.short 0x4 + bcc 1f + jmp cerror +1: + rts diff --git a/mach/proto/cg/Makefile b/mach/proto/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/proto/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/proto/cg/assert.h b/mach/proto/cg/assert.h new file mode 100644 index 00000000..3cc93b88 --- /dev/null +++ b/mach/proto/cg/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/mach/proto/cg/codegen.c b/mach/proto/cg/codegen.c new file mode 100644 index 00000000..2619f856 --- /dev/null +++ b/mach/proto/cg/codegen.c @@ -0,0 +1,672 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 +#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;i1) { + /* + * More than 1 tokenpattern is a candidate. + * Decision has to be made by lookahead. + */ + SAVEST; + mincost = costlimit-totalcost+1; + for(i=0;icostlimit) { + 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>5)&07; + for(i=0;i=fakestack) { + size=tsize(tp); + while (i= 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=fakestack) { + if (!match(tp,&machsets[tokexp[i]],0)) { + cp = findcoerc(tp, &machsets[tokexp[i]]); + if (cp==0) { + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { + assert(nregneededstackheight) { + stackpad = tokpatlen-stackheight; + for (j=stackheight-1;j>=0;j--) + fakestack[j+stackpad] = fakestack[j]; + for (j=0;j=fakestack) { + cp = findcoerc((token_p) 0, &machsets[tokexp[i]]); + if (cp==0) { + assert(!toplevel); + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { + assert(nregneededp_next; + for (i=0,t=0;ip_rar[i]); + if (tcostlimit) { + if (besttup) + myfree(besttup); + if (stackpad!=tokpatlen) { + if (stackpad) { + if (costlimitp_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;rpr_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;it_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;it_type[i]==EV_REG) + chrefcount(token.t_att[i].ar,-1,TRUE); + } + break; + case DO_REALLOCATE: + DEBUG("REALLOCATE"); + for(rp=machregs;rpr_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;icostlimit) { + 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>5)&07; + j=emp-emlines; + if (emrepllen>j) { + assert(nemlines+emrepllen-j=0;i--) + emlines[i+emrepllen-j] = emlines[i]; + nemlines += emrepllen-j; + emp += emrepllen-j; + } + emp -= emrepllen; + for (i=0;i +#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;iex_rnode>=0 &&node->ex_rnodeex_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<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_conex_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); + } +} diff --git a/mach/proto/cg/data.h b/mach/proto/cg/data.h new file mode 100644 index 00000000..ecfe7f67 --- /dev/null +++ b/mach/proto/cg/data.h @@ -0,0 +1,54 @@ +/* $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; diff --git a/mach/proto/cg/equiv.c b/mach/proto/cg/equiv.c new file mode 100644 index 00000000..0e677d37 --- /dev/null +++ b/mach/proto/cg/equiv.c @@ -0,0 +1,105 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "equiv.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ip_next) { + for (i=0; ip_rar[i]]) + goto diff; + for (i=0; ip_rar[i],pp->p_rar[j])) + goto diff; + return; + diff: ; + } + pp = (struct perm *) myalloc(sizeof ( *pp )); + pp->p_next = perms; + for (i=0; ip_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); + } + } +} diff --git a/mach/proto/cg/equiv.h b/mach/proto/cg/equiv.h new file mode 100644 index 00000000..f1dc6c85 --- /dev/null +++ b/mach/proto/cg/equiv.h @@ -0,0 +1,8 @@ +/* $Header$ */ + +#define MAXCREG 4 + +struct perm { + struct perm *p_next; + int p_rar[MAXCREG]; +}; diff --git a/mach/proto/cg/extern.h b/mach/proto/cg/extern.h new file mode 100644 index 00000000..5e84bf52 --- /dev/null +++ b/mach/proto/cg/extern.h @@ -0,0 +1,49 @@ +/* $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 diff --git a/mach/proto/cg/fillem.c b/mach/proto/cg/fillem.c new file mode 100644 index 00000000..074d4454 --- /dev/null +++ b/mach/proto/cg/fillem.c @@ -0,0 +1,668 @@ +#ifndef NORCSID +static char rcsid2[] = "$Header$"; +#endif + +#include +#include "assert.h" +#include +#include +#include +#include +#include +#include "mach.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#include "data.h" +#include "result.h" +#ifdef REGVARS +#include "regvar.h" +#include +#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)-empem_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= 0) + r_off += TEM_BSIZE; + getarg(ptyp(sp_cst2)); + r_size = argval; + getarg(ptyp(sp_cst2)); + r_type = argval; + if (r_typereg_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" diff --git a/mach/proto/cg/gencode.c b/mach/proto/cg/gencode.c new file mode 100644 index 00000000..6fc93d49 --- /dev/null +++ b/mach/proto/cg/gencode.c @@ -0,0 +1,194 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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].art_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; + } + } + } +} diff --git a/mach/proto/cg/glosym.c b/mach/proto/cg/glosym.c new file mode 100644 index 00000000..cf8f0297 --- /dev/null +++ b/mach/proto/cg/glosym.c @@ -0,0 +1,52 @@ +#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); +} diff --git a/mach/proto/cg/glosym.h b/mach/proto/cg/glosym.h new file mode 100644 index 00000000..7fb4c7cf --- /dev/null +++ b/mach/proto/cg/glosym.h @@ -0,0 +1,9 @@ +/* $Header$ */ + +typedef struct glosym { + struct glosym *gl_next; + string gl_name; + word gl_rom[MAXROM+1]; +} glosym_t,*glosym_p; + +glosym_p lookglo(); diff --git a/mach/proto/cg/main.c b/mach/proto/cg/main.c new file mode 100644 index 00000000..08d5c46c --- /dev/null +++ b/mach/proto/cg/main.c @@ -0,0 +1,84 @@ +#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); +} diff --git a/mach/proto/cg/move.c b/mach/proto/cg/move.c new file mode 100644 index 00000000..3230aa8a --- /dev/null +++ b/mach/proto/cg/move.c @@ -0,0 +1,111 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;rpr_contents.t_token == 0) + continue; + assert(rp->r_contents.t_token > 0); + tdp = &tokens[rp->r_contents.t_token]; + for (i=0;it_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;mpm_set1],mp->m_expr1)) + continue; + if (match(tp2,&machsets[mp->m_set2],mp->m_expr2)) + break; + /* + * Correct move rule is found + */ + } + assert(mpm_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); +} diff --git a/mach/proto/cg/nextem.c b/mach/proto/cg/nextem.c new file mode 100644 index 00000000..4aab43f2 --- /dev/null +++ b/mach/proto/cg/nextem.c @@ -0,0 +1,131 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#include +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 +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;iemlines) { + nemlines -= emp-emlines; + for (i=0,ep=emlines;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); +} diff --git a/mach/proto/cg/param.h b/mach/proto/cg/param.h new file mode 100644 index 00000000..24326015 --- /dev/null +++ b/mach/proto/cg/param.h @@ -0,0 +1,19 @@ +/* $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 diff --git a/mach/proto/cg/reg.c b/mach/proto/cg/reg.c new file mode 100644 index 00000000..4482dce1 --- /dev/null +++ b/mach/proto/cg/reg.c @@ -0,0 +1,175 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ir_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;ir_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;rpr_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;ir_contents.t_att[i].aw = 0; + + /* Now erase recursively all registers containing + * something using this one + */ + for (rp=machregs;rpr_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;it_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;rpr_contents.t_token = 0; + for (i=0;ir_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;ir_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;rpr_tcount==0); + } + for (tp=fakestack;tpt_token == -1) + inctcount(tp->t_att[0].ar); + else { + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i]==EV_REG) + inctcount(tp->t_att[i].ar); + } + } +#ifdef REGVARS +#include + for(i=reg_any;i<=reg_float;i++) { + int j; + for(j=0;jr_refcount==rp->r_tcount); + rp->r_tcount=0; + } +} +#endif diff --git a/mach/proto/cg/regvar.c b/mach/proto/cg/regvar.c new file mode 100644 index 00000000..196bf3b4 --- /dev/null +++ b/mach/proto/cg/regvar.c @@ -0,0 +1,151 @@ +#include "assert.h" +#include "param.h" +#include "tables.h" + +#ifdef REGVARS + +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "types.h" +#include +#include "data.h" +#include "regvar.h" +#include +#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_scorerv_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_scorer_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;ira_rv = 0; + ra->ra_score = 0; + } + } +} + +#endif REGVARS + +/* nothing after this */ diff --git a/mach/proto/cg/regvar.h b/mach/proto/cg/regvar.h new file mode 100644 index 00000000..716a68f2 --- /dev/null +++ b/mach/proto/cg/regvar.h @@ -0,0 +1,19 @@ +/* $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[]; diff --git a/mach/proto/cg/result.h b/mach/proto/cg/result.h new file mode 100644 index 00000000..e4fa6299 --- /dev/null +++ b/mach/proto/cg/result.h @@ -0,0 +1,19 @@ +/* $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(); diff --git a/mach/proto/cg/salloc.c b/mach/proto/cg/salloc.c new file mode 100644 index 00000000..0543c96a --- /dev/null +++ b/mach/proto/cg/salloc.c @@ -0,0 +1,150 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;iem_soper,used); + for (tp= fakestack;tp<&fakestack[stackheight];tp++) { + if (tp->t_token== -1) + continue; + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_STR) + chkstr(tp->t_att[i].as,used); + } + for (rp= machregs; rpr_contents; + assert(tp->t_token != -1); + tdp= &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_STR) + chkstr(tp->t_att[i].as,used); + } + for (i=0;ilow) { + middle= (low+high)>>1; + if (str==stab[middle]) { + used[middle]=1; + return; + } + if (str +#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); +} diff --git a/mach/proto/cg/state.h b/mach/proto/cg/state.h new file mode 100644 index 00000000..82041690 --- /dev/null +++ b/mach/proto/cg/state.h @@ -0,0 +1,24 @@ +/* $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 diff --git a/mach/proto/cg/subr.c b/mach/proto/cg/subr.c new file mode 100644 index 00000000..a3801ffc --- /dev/null +++ b/mach/proto/cg/subr.c @@ -0,0 +1,547 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;it_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;iin_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;iin_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;it_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;itoksize) + return(100); + if (expsizet_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;it_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 && ic2_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-1c2_codep],ply,toplevel,MAXINT,0); + tokpatlen = tpl; + for (i=0;ic2_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;ic1_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;ic1_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;ic3_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); +} diff --git a/mach/proto/cg/types.h b/mach/proto/cg/types.h new file mode 100644 index 00000000..dad9a51d --- /dev/null +++ b/mach/proto/cg/types.h @@ -0,0 +1,33 @@ +/* $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 diff --git a/mach/proto/cg/var.c b/mach/proto/cg/var.c new file mode 100644 index 00000000..48de9ba1 --- /dev/null +++ b/mach/proto/cg/var.c @@ -0,0 +1,41 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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; diff --git a/mach/proto/libg/Makefile b/mach/proto/libg/Makefile new file mode 100644 index 00000000..4785674f --- /dev/null +++ b/mach/proto/libg/Makefile @@ -0,0 +1,41 @@ +# $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) diff --git a/mach/proto/libg/barrier.c b/mach/proto/libg/barrier.c new file mode 100644 index 00000000..354d0860 --- /dev/null +++ b/mach/proto/libg/barrier.c @@ -0,0 +1 @@ +main() { printf("Hello world\n") ; } diff --git a/mach/proto/ncg/Makefile b/mach/proto/ncg/Makefile new file mode 100644 index 00000000..e3ceffce --- /dev/null +++ b/mach/proto/ncg/Makefile @@ -0,0 +1,178 @@ +# $Header$ + +PREFLAGS=-I../../../h -I. +PFLAGS= +CFLAGS=$(PREFLAGS) $(PFLAGS) +LDFLAGS=-i $(PFLAGS) +LINTOPTS=-hbxac +LIBS=../../../lib/em_data.a +CDIR=../../proto/ncg +CGG=../../../lib/ncgg +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 $(CGG) + $(CGG) table + -cmp tables.h tables.H || cp tables.H tables.h + +lint: $(CFILES) + lint $(LINTOPTS) $(PREFLAGS) $(CFILES) +clean: + rm -f *.o tables.c tables.h debug.out cg tables.H + +codegen.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 +main.o: tables.h +move.o: $(CDIR)/assert.h ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.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 ../../../h/cgg_cg.h +var.o: $(CDIR)/param.h +var.o: $(CDIR)/result.h +var.o: tables.h +var.o: $(CDIR)/types.h diff --git a/mach/proto/ncg/assert.h b/mach/proto/ncg/assert.h new file mode 100644 index 00000000..3cc93b88 --- /dev/null +++ b/mach/proto/ncg/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if(!(x)) badassertion("x",__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/mach/proto/ncg/codegen.c b/mach/proto/ncg/codegen.c new file mode 100644 index 00000000..510dd914 --- /dev/null +++ b/mach/proto/ncg/codegen.c @@ -0,0 +1,876 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 ALLOW_NEXTEM /* code generator is allowed new try of NEXTEM + in exceptional cases */ + +#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(); +string ad2str(); + +#ifdef NDEBUG +#define DEBUG(string) +#else +#include +#define DEBUG(string) {if(Debug) fprintf(stderr,"%-*d%s\n",4*level,level,string);} +#endif + +#define BROKE() {assert(origcp!=startupcode);DEBUG("BROKE");totalcost=INFINITY;goto doreturn;} +#define CHKCOST() {if (totalcost>=costlimit) BROKE();} + +#ifdef TABLEDEBUG +int tablelines[MAXTDBUG]; +int ntableline; +int set_fd,set_size; +short *set_val; +char *set_flag; +#endif + +unsigned codegen(codep,ply,toplevel,costlimit,forced) byte *codep; unsigned costlimit; { +#ifndef NDEBUG + byte *origcp=codep; + static int level=0; +#endif + unsigned totalcost = 0; + int inscoerc=0; + int procarg[2]; +#ifdef ALLOW_NEXTEM + int paniced; + char *savebp; +#endif + state_t state; +#define SAVEST savestatus(&state) +#define RESTST restorestatus(&state) +#define FREEST /* nothing */ +#ifdef TABLEDEBUG + extern char *tablename; +#endif + +#ifndef NDEBUG + level++; + DEBUG("Entering codegen"); +#endif + for (;;) { + switch( (*codep++)&037 ) { + default: + assert(FALSE); + /* NOTREACHED */ +#ifdef TABLEDEBUG + case DO_DLINE: { + int n; + + getint(n,codep); + tablelines[ntableline++] = n; + if (ntableline>=MAXTDBUG) + ntableline -= MAXTDBUG; + if (set_fd) + set_val[n>>4] &= ~(1<<(n&017)); +#ifndef NDEBUG + if (Debug) + fprintf(stderr,"code from \"%s\", line %d\n",tablename,n); +#endif + break; + } +#endif + case DO_NEXTEM: { + byte *bp; + int n; + unsigned mindistance,dist; + register i; + int cindex; + int npos,pos[MAXRULE]; + unsigned mincost,t; + + DEBUG("NEXTEM"); + tokpatlen = 0; + nallreg=0; + if (toplevel) { + garbage_collect(); + totalcost=0; + } else { + if (--ply <= 0) + goto doreturn; + } + if (stackheight>MAXFSTACK-7) { +#ifndef NDEBUG + if (Debug) + fprintf(stderr,"Fakestack overflow threatens(%d), action ...\n",stackheight); +#endif + totalcost += stackupto(&fakestack[6],ply,toplevel); + } +#ifndef ALLOW_NEXTEM + bp = nextem(toplevel); +#else + paniced=0; + savebp = nextem(toplevel); + panic: + bp = savebp; +#endif + 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++; + if (n==0) { /* "procedure" */ + getint(i,bp); + getint(procarg[0],bp); + getint(procarg[1],bp); + bp= &pattern[i]; + n = *bp++; + DEBUG("PROC_CALL"); + } + assert(n>0 && n<=MAXRULE); + if (n>1) { + mindistance = MAXINT; npos=0; + for(i=0;i1) { + /* + * More than 1 tokenpattern is a candidate. + * Decision has to be made by lookahead. + */ + SAVEST; + mincost = costlimit-totalcost+1; + for(i=0;icostlimit) + 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: { + register i; + int temp; + + DEBUG("XMATCH"); + tokpatlen=(codep[-1]>>5)&07; + for (i=0;i>5)&07; + for(i=0;i=fakestack) { + size=tsize(tp); + while (i= 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=fakestack) { + if (!match(tp,&machsets[tokexp[i]],0)) { + cp = findcoerc(tp, &machsets[tokexp[i]]); +#ifndef NDEBUG +if (Debug>1) fprintf(stderr,"findcoerc returns %d at position %d\n",cp,i); +#endif + if (cp==0) { + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { +#ifndef NDEBUG +if(Debug>1) fprintf(stderr,"Register of type %d needed, remembering...\n",cp->c3_prop); +#endif + assert(nregneededstackheight) { +#ifndef NDEBUG +if(Debug>1) fprintf(stderr,"Pattern too long, %d with only %d items on stack\n", + tokpatlen,stackheight); +#endif + stackpad = tokpatlen-stackheight; + for (j=stackheight-1;j>=0;j--) + fakestack[j+stackpad] = fakestack[j]; + for (j=0;j=fakestack;i++,tp--) { + cp = findcoerc((token_p) 0, &machsets[tokexp[i]]); + if (cp==0) { + for (j=0;jc3_prop==0) { + totalcost+=docoerc(tp,cp,ply,toplevel,0); + CHKCOST(); + } else { + assert(nregneeded1) fprintf(stderr,"Next tuple %d,%d,%d,%d\n", + tup->p_rar[0], + tup->p_rar[1], + tup->p_rar[2], + tup->p_rar[3]); +#endif + ntup = tup->p_next; + for (i=0,t=0;ip_rar[i]); + if (t2) + fprintf(stderr,"Continuing match after coercions\n"); +#endif + t += codegen(codep,ply,FALSE,mincost-t,0); + } + if (tcostlimit) { + if (besttup) + myfree(besttup); +normalfailed: if (stackpad!=tokpatlen) { + if (stackpad) { + if (costlimitp_rar[i]); + myfree(besttup); + break; + } + case DO_REMOVE: { + int texpno,nodeno; + token_p tp; + struct reginfo *rp; + + 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;rpr_contents,&machsets[texpno],nodeno)) + rp->r_contents.t_token=0; + break; + } + case DO_RREMOVE: { /* register remove */ + register i; + int nodeno; + token_p tp; + tkdef_p tdp; + result_t result; + + DEBUG("RREMOVE"); + getint(nodeno,codep); + result=compute(&enodes[nodeno]); + if (result.e_typ!=EV_REG) + break; + 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;it_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: { + register i; + tkdef_p tdp; + int tinstno; + token_t token; + + 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;it_type[i]==EV_REG) + chrefcount(token.t_att[i].ar,-1,TRUE); + } + break; + } + case DO_REALLOCATE: { + struct reginfo *rp; + + DEBUG("REALLOCATE"); + for(rp=machregs+1;rpr_tcount) { + rp->r_refcount -= rp->r_tcount; + rp->r_tcount = 0; + } + break; + } + case DO_ALLOCATE: { + register i; + int j; + int tinstno; + int npos,npos2,pos[NREGS],pos2[NREGS]; + unsigned mincost,t; + struct reginfo *rp,**rpp; + token_t token,mtoken,token2; + int propno; + int exactmatch; + int decision; + + if (codep[-1]&32) { + getint(propno,codep); + getint(tinstno,codep); + DEBUG("ALLOCATE,INIT"); + } else { + getint(propno,codep); + tinstno=0; + DEBUG("ALLOCATE,EMPTY"); + } + 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) { + BROKE(); + } else + fatal("No regs available"); + } + totalcost += stackupto( &fakestack[0],ply,toplevel); + CHKCOST(); + } + } while (npos==0); + if (!exactmatch) { + npos2=npos; + for(i=0;icostlimit) + BROKE(); + } + } else { + decision = forced; + if (getrefcount(decision)!=0) + 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_INSTR: { + register i; + int n; + int tinstno; + token_t token; + int stringno; + + DEBUG("INSTR"); + n=((codep[-1]>>5)&07); + getint(stringno,codep); + if (toplevel) { + swtxt(); + if (stringno>10000) { + assert(stringno== 10001 || stringno== 10002); + genstr(procarg[stringno-10001]); + } else + genstr(stringno); + } + for(i=0;i0) + totalcost += tokens[token.t_token].t_cost.ct_space; + } + if (toplevel) + gennl(); + break; + } + case DO_MOVE: { + int tinstno; + token_t token,token2; + + 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_TEST: { + int tinstno; + token_t token; + + DEBUG("TEST"); + getint(tinstno,codep); + instance(tinstno,&token); + totalcost += test(&token,ply,toplevel,costlimit-totalcost+1); + CHKCOST(); + break; + } + case DO_SETCC: { + int tinstno; + token_t token; + + DEBUG("SETCC"); + getint(tinstno,codep); + instance(tinstno,&token); + setcc(&token); + break; + } + case DO_ERASE: { + int nodeno; + result_t result; + + DEBUG("ERASE"); + getint(nodeno,codep); + result=compute(&enodes[nodeno]); + assert(result.e_typ!=EV_INT && result.e_typ!=EV_ADDR); + if (result.e_typ==EV_REG) + erasereg(result.e_v.e_reg); + break; + } + case DO_TOKREPLACE: { + register i; + int tinstno; + int repllen; + token_t reptoken[MAXREPLLEN]; + + DEBUG("TOKREPLACE"); + assert(stackheight>=tokpatlen); + repllen=(codep[-1]>>5)&07; +#ifndef NDEBUG + if (Debug>2) + fprintf(stderr,"Stackheight=%d, tokpatlen=%d, repllen=%d %s\n", + stackheight,tokpatlen,repllen,inscoerc ? "(inscoerc)":""); +#endif + for(i=0;i>5)&07; + j=emp-emlines; + if (emrepllen>j) { + assert(nemlines+emrepllen-j=0;i--) + emlines[i+emrepllen-j] = emlines[i]; + nemlines += emrepllen-j; + emp += emrepllen-j; + } + emp -= emrepllen; + for (i=0;i>4]&(1<<(i&017))) + fprintf(stderr,"\"%s\", line %d\n",tablename,i); + } + } +} +#endif diff --git a/mach/proto/ncg/compute.c b/mach/proto/ncg/compute.c new file mode 100644 index 00000000..4682fb71 --- /dev/null +++ b/mach/proto/ncg/compute.c @@ -0,0 +1,366 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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) register string s1,s2; { + register string s; + + if (s1==0) return(s2); + if (s2==0) return(s1); + s=salloc(strlen(s1)+strlen(s2)+1); + strcpy(s,s1); + strcat(s,"+"); + strcat(s,s2); + return(s); +} + +string mystrcpy(s) register string s; { + register string r; + + r=salloc(strlen(s)); + strcpy(r,s); + return(r); +} + +char digstr[21][15]; + +string tostring(n) register 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) register node_p node; { + result_t leaf1,leaf2,result; + register 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_ADDR: + result.e_v.e_addr = tp->t_att[node->ex_rnode-1].aa; + 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;iex_rnode>=0 &&node->ex_rnodeex_lnode]; + if (leaf2.e_typ != EV_ADDR) + return(undefres); + if (leaf2.e_v.e_addr.ea_off!=0) + return(undefres); + gp = lookglo(leaf2.e_v.e_addr.ea_str); + if (gp == (glosym_p) 0) + return(undefres); + if ((gp->gl_rom[MAXROM]&(1<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_ADDR && leaf2.e_typ == EV_ADDR); + result.e_v.e_con = + (strcmp(leaf1.e_v.e_addr.ea_str,leaf2.e_v.e_addr.ea_str)==0 && + leaf1.e_v.e_addr.ea_off==leaf2.e_v.e_addr.ea_off); + 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_ADDR && leaf2.e_typ == EV_ADDR); + result.e_v.e_con = + !(strcmp(leaf1.e_v.e_addr.ea_str,leaf2.e_v.e_addr.ea_str)==0 && + leaf1.e_v.e_addr.ea_off==leaf2.e_v.e_addr.ea_off); + 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_conex_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_ADDR && leaf2.e_typ == EV_ADDR); + result.e_typ = EV_ADDR; + result.e_v.e_addr.ea_str = mycat(leaf1.e_v.e_addr.ea_str,leaf2.e_v.e_addr.ea_str); + result.e_v.e_addr.ea_off = leaf1.e_v.e_addr.ea_off+leaf2.e_v.e_addr.ea_off; + 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_STRING: + result.e_typ = EV_ADDR; + result.e_v.e_addr.ea_str = codestrings[node->ex_lnode]; + result.e_v.e_addr.ea_off = 0; + 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_ADDR; + result.e_v.e_addr.ea_str = 0; + result.e_v.e_addr.ea_off = leaf1.e_v.e_con; + return(result); +#ifdef REGVARS + case EX_INREG: + assert(leaf1.e_typ == EV_INT); + if ((result.e_v.e_con = isregvar((long) leaf1.e_v.e_con))>0) + result.e_v.e_con = machregs[result.e_v.e_con].r_size; + 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); + } +} diff --git a/mach/proto/ncg/data.h b/mach/proto/ncg/data.h new file mode 100644 index 00000000..809baeb0 --- /dev/null +++ b/mach/proto/ncg/data.h @@ -0,0 +1,64 @@ +/* $Header$ */ + +typedef struct cost { + short ct_space; + short ct_time; +} cost_t,*cost_p; + +typedef struct { + string ea_str; + word ea_off; +} addr_t; + +typedef struct { + int t_token; /* kind of token, -1 for register */ + union { + word aw; /* integer type */ + addr_t aa; /* address 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; diff --git a/mach/proto/ncg/equiv.c b/mach/proto/ncg/equiv.c new file mode 100644 index 00000000..54a695a3 --- /dev/null +++ b/mach/proto/ncg/equiv.c @@ -0,0 +1,105 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "equiv.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ip_next) { + for (i=0; ip_rar[i]]) + goto diff; + for (i=0; ip_rar[i],pp->p_rar[j])) + goto diff; + return; + diff: ; + } + pp = (struct perm *) myalloc(sizeof ( *pp )); + pp->p_next = perms; + for (i=0; ip_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); + } + } +} diff --git a/mach/proto/ncg/equiv.h b/mach/proto/ncg/equiv.h new file mode 100644 index 00000000..f1dc6c85 --- /dev/null +++ b/mach/proto/ncg/equiv.h @@ -0,0 +1,8 @@ +/* $Header$ */ + +#define MAXCREG 4 + +struct perm { + struct perm *p_next; + int p_rar[MAXCREG]; +}; diff --git a/mach/proto/ncg/extern.h b/mach/proto/ncg/extern.h new file mode 100644 index 00000000..a50224e6 --- /dev/null +++ b/mach/proto/ncg/extern.h @@ -0,0 +1,50 @@ +/* $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 test_t tests[]; /* test 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 diff --git a/mach/proto/ncg/fillem.c b/mach/proto/ncg/fillem.c new file mode 100644 index 00000000..5e87991b --- /dev/null +++ b/mach/proto/ncg/fillem.c @@ -0,0 +1,676 @@ +#ifndef NORCSID +static char rcsid2[] = "$Header$"; +#endif + +#include +#include "assert.h" +#include +#include +#include +#include +#include +#include "mach.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#include "data.h" +#include "result.h" +#ifdef REGVARS +#include "regvar.h" +#include +#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() { + register int t,i; + register struct emline *lp; + + while ((emlines+nemlines)-empem_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); +#ifndef NDEBUG + { extern int Debug; extern char * strtdebug; + if (strcmp(strtdebug,argstr)==0) + Debug = strtdebug[-2]-'0'; + } +#endif + return; + case sp_dlb1: + case sp_dlb2: + case sp_dnam: + strarg(savetab1); + savelab(); + return; + case sp_fpseu: + break; + case EOF: + swtxt(); + in_finish(); + out_finish(); + 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= 0) + r_off += TEM_BSIZE; + getarg(ptyp(sp_cst2)); + r_size = argval; + getarg(ptyp(sp_cst2)); + r_type = argval; + if (r_typereg_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" diff --git a/mach/proto/ncg/gencode.c b/mach/proto/ncg/gencode.c new file mode 100644 index 00000000..d2ee010a --- /dev/null +++ b/mach/proto/ncg/gencode.c @@ -0,0 +1,143 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#include "data.h" +#include "result.h" +#include "extern.h" + +/* + * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. + * + * This product is part of the Amsterdam Compiler Kit. + * + * Permission to use, sell, duplicate or disclose this software must be + * obtained in writing. Requests for such permissions may be sent to + * + * Dr. Andrew S. Tanenbaum + * Wiskundig Seminarium + * Vrije Universiteit + * Postbox 7161 + * 1007 MC Amsterdam + * The Netherlands + * + * Author: Hans van Staveren + */ + +string mystrcpy(); + +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); +#ifdef TABLEDEBUG + termlset(); +#endif +} + +tstoutput() { + + if (ferror(codefile)) + error("Write error on output"); +} + +genstr(stringno) { + + fputs(codestrings[stringno],codefile); +} + +string ad2str(ad) addr_t ad; { + static char buf[100]; + + if (ad.ea_str==0) + ad.ea_str=""; + sprintf(buf,"%s%c%ld",ad.ea_str,ad.ea_off>=0 ? '+' : ' ',(long)ad.ea_off); + return(mystrcpy(buf)); +} + +praddr(ad) addr_t ad; { + + if (ad.ea_str==0) + fprintf(codefile,WRD_FMT,ad.ea_off); + else { + fprintf(codefile,"%s",ad.ea_str); + if (ad.ea_off<0) + fprintf(codefile,WRD_FMT,ad.ea_off); + else if(ad.ea_off>0) { + fputc('+',codefile); + fprintf(codefile,WRD_FMT,ad.ea_off); + } + } +} + +gennl() { + fputc('\n',codefile); +} + +prtoken(tp,leadingchar) token_p tp; { + register c; + register char *code; + register tkdef_p tdp; + + fputc(leadingchar,codefile); + if (tp->t_token == -1) { + fprintf(codefile,"%s",codestrings[machregs[tp->t_att[0].ar].r_repr]); + return; + } + 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_ADDR: + praddr(tp->t_att[c-1].aa); + break; + case EV_REG: + fprintf(codefile,"%s",codestrings[machregs[tp->t_att[c-1].ar].r_repr]); + break; + } + } + } +} diff --git a/mach/proto/ncg/glosym.c b/mach/proto/ncg/glosym.c new file mode 100644 index 00000000..cf8f0297 --- /dev/null +++ b/mach/proto/ncg/glosym.c @@ -0,0 +1,52 @@ +#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); +} diff --git a/mach/proto/ncg/glosym.h b/mach/proto/ncg/glosym.h new file mode 100644 index 00000000..7fb4c7cf --- /dev/null +++ b/mach/proto/ncg/glosym.h @@ -0,0 +1,9 @@ +/* $Header$ */ + +typedef struct glosym { + struct glosym *gl_next; + string gl_name; + word gl_rom[MAXROM+1]; +} glosym_t,*glosym_p; + +glosym_p lookglo(); diff --git a/mach/proto/ncg/main.c b/mach/proto/ncg/main.c new file mode 100644 index 00000000..f8f7d007 --- /dev/null +++ b/mach/proto/ncg/main.c @@ -0,0 +1,99 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "param.h" +#include "tables.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; +char *strtdebug=""; +#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': + if ((Debug = argv[0][2]) != 0) { + Debug -= '0'; + if (argv[0][3] == '@') { + Debug = 0; + strtdebug = &argv[0][4]; + } + } else + Debug++; + break; +#endif +#ifdef TABLEDEBUG + case 'u': + case 'U': + initlset(argv[0]+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]); + readcodebytes(); + itokcost(); + codegen(startupcode,maxply,TRUE,MAXINT,0); + error("Bombed out of codegen"); +} + +unsigned ggd(a,b) register unsigned a,b; { + register unsigned c; + + do { + c = a%b; a=b; b=c; + } while (c!=0); + return(a); +} diff --git a/mach/proto/ncg/move.c b/mach/proto/ncg/move.c new file mode 100644 index 00000000..4c2e7fa8 --- /dev/null +++ b/mach/proto/ncg/move.c @@ -0,0 +1,149 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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); + erasereg(tp2->t_att[0].ar); + machregs[tp2->t_att[0].ar].r_contents = + machregs[tp1->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+1;rpr_contents.t_token == 0) + continue; + assert(rp->r_contents.t_token > 0); + tdp = &tokens[rp->r_contents.t_token]; + for (i=0;it_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->m_set1>=0;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->m_set1>=0); + /* + * 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. + */ + + fakestack[stackheight] = *tp2; + fakestack[stackheight+1] = *tp1; + stackheight += 2; + t = codegen(&coderules[mp->m_cindex],ply,toplevel,maxcost,0); + stackheight -= 2; + return(t); +} + +#define cocoreg machregs[0].r_contents + +setcc(tp) token_p tp; { + + cocoreg = *tp; +} + +test(tp,ply,toplevel,maxcost) token_p tp; unsigned maxcost; { + register test_p mp; + register unsigned t; + register struct reginfo *rp; + tkdef_p tdp; + int i; + unsigned codegen(); + + if (cocoreg.t_token!=0) { + if (eqtoken(tp,&cocoreg)) + return(0); + if (tp->t_token == -1) { + if (eqtoken(&machregs[tp->t_att[0].ar].r_contents,&cocoreg)) + return(0); + } + } + /* + * If we arrive here the test must really be executed + */ + for (mp=tests;mp->t_set>=0;mp++) { + if (match(tp,&machsets[mp->t_set],mp->t_expr)) + break; + /* + * Correct move rule is found + */ + } + assert(mp->t_set>=0); + /* + * To get correct interpretation of things like %[1] + * in test code we stack tp. This little trick + * saves a lot of testing in other places. + */ + + fakestack[stackheight] = *tp; + stackheight++; + t = codegen(&coderules[mp->t_cindex],ply,toplevel,maxcost,0); + stackheight--; + return(t); +} diff --git a/mach/proto/ncg/nextem.c b/mach/proto/ncg/nextem.c new file mode 100644 index 00000000..4b74b440 --- /dev/null +++ b/mach/proto/ncg/nextem.c @@ -0,0 +1,133 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#include +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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 +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;iemlines) { + nemlines -= emp-emlines; + for (i=0,ep=emlines;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); +} diff --git a/mach/proto/ncg/param.h b/mach/proto/ncg/param.h new file mode 100644 index 00000000..073d0da7 --- /dev/null +++ b/mach/proto/ncg/param.h @@ -0,0 +1,20 @@ +/* $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 +#define MAXTDBUG 32 diff --git a/mach/proto/ncg/reg.c b/mach/proto/ncg/reg.c new file mode 100644 index 00000000..fc3546c6 --- /dev/null +++ b/mach/proto/ncg/reg.c @@ -0,0 +1,175 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;ir_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;ir_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+1;rpr_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;ir_contents.t_att[i].aw = 0; + + /* Now erase recursively all registers containing + * something using this one + */ + for (rp=machregs;rpr_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;it_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;rpr_contents.t_token = 0; + for (i=0;ir_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;ir_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+1;rpr_tcount==0); + } + for (tp=fakestack;tpt_token == -1) + inctcount(tp->t_att[0].ar); + else { + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i]==EV_REG) + inctcount(tp->t_att[i].ar); + } + } +#ifdef REGVARS +#include + for(i=reg_any;i<=reg_float;i++) { + int j; + for(j=0;jr_refcount==rp->r_tcount); + rp->r_tcount=0; + } +} +#endif diff --git a/mach/proto/ncg/regvar.c b/mach/proto/ncg/regvar.c new file mode 100644 index 00000000..9805d0ec --- /dev/null +++ b/mach/proto/ncg/regvar.c @@ -0,0 +1,151 @@ +#include "assert.h" +#include "param.h" +#include "tables.h" + +#ifdef REGVARS + +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "types.h" +#include +#include "data.h" +#include "regvar.h" +#include +#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; { + register 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) register struct regvar *rvlp; { + int score; + register i; + register 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_scorerv_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_scorer_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;ira_rv = 0; + ra->ra_score = 0; + } + } +} + +#endif REGVARS + +/* nothing after this */ diff --git a/mach/proto/ncg/regvar.h b/mach/proto/ncg/regvar.h new file mode 100644 index 00000000..716a68f2 --- /dev/null +++ b/mach/proto/ncg/regvar.h @@ -0,0 +1,19 @@ +/* $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[]; diff --git a/mach/proto/ncg/result.h b/mach/proto/ncg/result.h new file mode 100644 index 00000000..15f9e8a2 --- /dev/null +++ b/mach/proto/ncg/result.h @@ -0,0 +1,19 @@ +/* $Header$ */ + +struct result { + int e_typ; /* EV_INT,EV_REG,EV_STR */ + union { + word e_con; + int e_reg; + addr_t e_addr; + } e_v; /* value */ +}; + +#define EV_UNDEF 0 +#define EV_INT 1 +#define EV_REG 2 +#define EV_ADDR 3 + +typedef struct result result_t; + +extern result_t compute(); diff --git a/mach/proto/ncg/salloc.c b/mach/proto/ncg/salloc.c new file mode 100644 index 00000000..45377d45 --- /dev/null +++ b/mach/proto/ncg/salloc.c @@ -0,0 +1,150 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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;iem_soper,used); + for (tp= fakestack;tp<&fakestack[stackheight];tp++) { + if (tp->t_token== -1) + continue; + tdp = &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_ADDR) + chkstr(tp->t_att[i].aa.ea_str,used); + } + for (rp= machregs+1; rpr_contents; + assert(tp->t_token != -1); + tdp= &tokens[tp->t_token]; + for (i=0;it_type[i] == EV_ADDR) + chkstr(tp->t_att[i].aa.ea_str,used); + } + for (i=0;ilow) { + middle= (low+high)>>1; + if (str==stab[middle]) { + used[middle]=1; + return; + } + if (str +#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 */ + +savestatus(sp) register state_p sp; { + + 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; +} + +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); +} + +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); +} diff --git a/mach/proto/ncg/state.h b/mach/proto/ncg/state.h new file mode 100644 index 00000000..45e2ba48 --- /dev/null +++ b/mach/proto/ncg/state.h @@ -0,0 +1,18 @@ +/* $Header$ */ + +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; diff --git a/mach/proto/ncg/subr.c b/mach/proto/ncg/subr.c new file mode 100644 index 00000000..b04086d5 --- /dev/null +++ b/mach/proto/ncg/subr.c @@ -0,0 +1,617 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "assert.h" +#include +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#include "data.h" +#include "result.h" +#include "extern.h" + +/* + * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. + * + * This product is part of the Amsterdam Compiler Kit. + * + * Permission to use, sell, duplicate or disclose this software must be + * obtained in writing. Requests for such permissions may be sent to + * + * Dr. Andrew S. Tanenbaum + * Wiskundig Seminarium + * Vrije Universiteit + * Postbox 7161 + * 1007 MC Amsterdam + * The Netherlands + * + * Author: Hans van Staveren + */ + +string myalloc(); +unsigned codegen(); + +match(tp,tep,optexp) register token_p tp; register set_p tep; { + register bitno; + token_p ct; + result_t result; + + if (tp->t_token == -1) { /* register frame */ + bitno = tp->t_att[0].ar; + 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; + 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) register token_p token; { + register inst_p inp; + int i; + register token_p tp; + struct reginfo *rp; + int regno; + result_t result; + + if (instno==0) { + token->t_token = 0; + for(i=0;it_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 + assert(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 + assert(FALSE); +#endif + } + return; + case IN_MEMB: + tp= &fakestack[stackheight-inp->in_info[0]]; + assert(inp->in_info[1]!=0); + assert(tp->t_token>0); + token->t_token= -1; + 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; + 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; + 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; +#ifdef REGVARS + case IN_S_DESCR: + case IN_D_DESCR: + result=compute(&enodes[inp->in_info[1]]); + assert(result.e_typ==EV_INT); + if ((regno=isregvar(result.e_v.e_con)) > 0) { + token->t_token = -1; + token->t_att[0].ar = regno; + for(i=1;it_att[i].aw = 0; + return; + } + /* fall through */ +#endif + case IN_DESCR: + token->t_token=inp->in_info[0]; + for (i=0;iin_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_ADDR) + token->t_att[i].aa= result.e_v.e_addr; + else + token->t_att[i].ar=result.e_v.e_reg; + } + return; + } +} + +cinstance(instno,token,tp,regno) register token_p token,tp; { + register 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 + assert(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 + assert(FALSE); +#endif + } + return; + case IN_MEMB: + assert(inp->in_info[0] == 1); + token->t_token= -1; + assert(tp->t_token>0); + 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; + 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; +#ifdef REGVARS + case IN_S_DESCR: + case IN_D_DESCR: + result=compute(&enodes[inp->in_info[1]]); + assert(result.e_typ==EV_INT); + if ((regno=isregvar(result.e_v.e_con)) > 0) { + token->t_token = -1; + token->t_att[0].ar = regno; + for(i=1;it_att[i].aw = 0; + return; + } + /* fall through */ +#endif + case IN_DESCR: + sh = stackheight; + stackheight = tp - fakestack + 1; + token->t_token=inp->in_info[0]; + for (i=0;iin_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_ADDR) + token->t_att[i].aa= result.e_v.e_addr; + 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;it_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_ADDR: + if (strcmp(tp1->t_att[i].aa.ea_str, tp2->t_att[i].aa.ea_str)) + return(0); + if (tp1->t_att[i].aa.ea_off!=tp2->t_att[i].aa.ea_off) + 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]; +#ifndef NDEBUG + if (*bp==DO_DLINE) { + ++bp; + getint(i,bp); + } +#endif + 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;itoksize) + return(100); + if (expsizet_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: + case IN_S_DESCR: + case IN_D_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;it_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; register int *ip; { + register c2_p cp; + token_t savestack[MAXSAVE]; + int ok; + register i; + int diff; + token_p stp; + int tpl; + + for (cp=c2coercs;cp->c2_texpno>=0; cp++) { + if (!match(tp,&machsets[cp->c2_texpno],0)) + continue; + ok=1; + for (i=0; ok && ic2_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-1c2_codep],ply,toplevel,MAXINT,0); + tokpatlen = tpl; + for (i=0;ic2_nsplit); +} +#endif MAXSPLIT + +unsigned docoerc(tp,cp,ply,toplevel,forced) token_p tp; register c3_p cp; { + token_t savestack[MAXSAVE]; + token_p stp; + register int i,diff; + unsigned cost; + int tpl; /* saved tokpatlen */ + + stp = &fakestack[stackheight-1]; + diff = stp -tp; + assert(diff<=MAXSAVE); +#ifndef NDEBUG + if (diff!=0 && Debug>1) + fprintf(stderr,"Saving %d items from fakestack\n",diff); +#endif + 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; +#ifndef NDEBUG + if (diff!=0 && Debug>1) + fprintf(stderr,"Restoring %d items to fakestack(%d)\n",diff,stackheight); +#endif + for (i=0;ic1_texpno>=0; 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;ic1_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); + tokpatlen = tpl; + for (i=0;ic3_texpno>=0; cp++) { + if (tp!=(token_p) 0) { + if (cp->c3_texpno==0) + continue; + if (!match(tp,&machsets[cp->c3_texpno],cp->c3_expr)) + 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 */ +} + +itokcost() { + register tkdef_p tdp; + + for(tdp=tokens+1;tdp->t_size!=0;tdp++) + tdp->t_cost.ct_space = costcalc(tdp->t_cost); +} + +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"); +#ifdef TABLEDEBUG + ruletrace(); +#endif + out_finish(); + abort(); + exit(-1); +} + +#ifdef TABLEDEBUG + +ruletrace() { + register i; + extern int tablelines[MAXTDBUG]; + extern int ntableline; + extern char *tablename; + + fprintf(stderr,"Last code rules used\n"); + i=ntableline-1; + while(i!=ntableline) { + if (i<0) + i += MAXTDBUG; + if (tablelines[i]!=0) + fprintf(stderr,"\%d: \"%s\", line %d\n",i,tablename,tablelines[i]); + i--; + } +} +#endif + +#ifndef NDEBUG +badassertion(asstr,file,line) char *asstr, *file; { + + fatal("\"%s\", line %d:Assertion \"%s\" failed",file,line,asstr); +} +#endif + +max(a,b) { + + return(a>b ? a : b); +} diff --git a/mach/proto/ncg/types.h b/mach/proto/ncg/types.h new file mode 100644 index 00000000..ee666132 --- /dev/null +++ b/mach/proto/ncg/types.h @@ -0,0 +1,27 @@ +/* $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 +#else +#define word int +#endif diff --git a/mach/proto/ncg/var.c b/mach/proto/ncg/var.c new file mode 100644 index 00000000..6ba1d460 --- /dev/null +++ b/mach/proto/ncg/var.c @@ -0,0 +1,41 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include "param.h" +#include "tables.h" +#include "types.h" +#include +#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; diff --git a/mach/s2650/Action b/mach/s2650/Action new file mode 100644 index 00000000..85f97117 --- /dev/null +++ b/mach/s2650/Action @@ -0,0 +1,3 @@ +name "Signetics 6502 assembler" +dir as +end diff --git a/mach/vax4/Action b/mach/vax4/Action new file mode 100644 index 00000000..0e68d9c2 --- /dev/null +++ b/mach/vax4/Action @@ -0,0 +1,19 @@ +name "Vax 4-4 backend" +dir cg +end +name "Vax 4-4 C libraries" +system vax* +dir libcc +end +name "Vax 4-4 EM library" +system vax* +dir libem +end +name "Vax 4-4 Pascal library" +system vax* +dir libpc +end +name "Vax 4-4 Basic library" +system vax* +dir libbc +end diff --git a/mach/vax4/cg/Makefile b/mach/vax4/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/vax4/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/vax4/cg/READ_ME b/mach/vax4/cg/READ_ME new file mode 100644 index 00000000..6d6d3610 --- /dev/null +++ b/mach/vax4/cg/READ_ME @@ -0,0 +1,8 @@ +--------- $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). diff --git a/mach/vax4/cg/mach.c b/mach/vax4/cg/mach.c new file mode 100644 index 00000000..ea144ae0 --- /dev/null +++ b/mach/vax4/cg/mach.c @@ -0,0 +1,253 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif lint +/* + * (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 + */ + +/* + * Byte order: | 3 | 2 | 1 | 0 | + */ +con_part(sz, w) + register int sz; + word w; +{ + /* + * Align new bytes on boundary of its on size. + */ + while (part_size % sz) part_size++; + + if (part_size == TEM_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_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); +} + +#ifndef REGVARS +prolog(nlocals) + full nlocals; +{ + fprintf(codefile,".word 00\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 not REGVARS + +char *segname[] = { + ".text", /* SEGTXT */ + ".data", /* SEGCON */ + ".data", /* SEGROM */ + ".data" /* SEGBSS */ +}; + +#ifdef REGVARS +static full nlocals; /* Number of local variables. */ + +#define NR_REG 8 /* Number of registers. */ +#define FIRST_REG 4 +#define LAST_REG (FIRST_REG + NR_REG - 1) + +/* + * Save number of locals. + */ +prolog(n) +{ + 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; + +/* + * Initialize saving of registers. + */ +i_regsave() +{ + p_reg = a_reg; +} + +/* + * Called for each register to be saved. + * Save the parameters in the struct. + */ +regsave(str, off, size) + char *str; + long off; + int size; +{ + 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 + ); +} + +/* + * Generate code to save the registers. + */ +f_regsave() +{ + register struct s_reg *p; + register int mask; + register int i; + register int count; + + mask = 0; + count = p_reg - a_reg; + /* + * For each register to be saved, set a bit in the + * mask corresponding to its number. + */ + for (p = a_reg; p < p_reg; p++) { + i = atoi(p->sr_str + 1); + if (p->sr_size <= 4) + mask |= (1 << i); + else { + mask |= (3 << i); + count++; + } + } + /* + * Now generate code to save registers. + */ + fprintf(codefile, ".word 0%o\n", mask); + /* + * Emit code to initialize parameters in registers. + */ + for (p = a_reg; p < p_reg; p++) + if (p->sr_off >= 0) + fprintf(codefile, + "mov%c\t%ld(ap), %s\n", + p->sr_size == 4 ? 'l' : 'q', + p->sr_off, + 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); + +} + +regreturn() { } + +regscore(off, size, typ, score, totyp) + long off; + int size, typ, totyp, score; +{ + register int i = score; + + /* + * If the offset doesn't fit in a byte, word-offset is used, + * which is one byte more expensive. + */ + if (off > 127 || off < -128) i *= 2; + /* + * Compute cost of initialization for parameters. + */ + if (off > 127) i -= 5; + else if (off >= 0) i -= 4; + /* + * Storing a pointer in a register sometimes saves an instruction. + */ + if (typ == reg_pointer) i += score; + else if (typ == reg_loop) i += 5; + /* + * Now adjust for the saving of the register. + * But this costs no space at all. + */ + return i - 1; +} + +#endif REGVARS diff --git a/mach/vax4/cg/mach.h b/mach/vax4/cg/mach.h new file mode 100644 index 00000000..ddd31eaa --- /dev/null +++ b/mach/vax4/cg/mach.h @@ -0,0 +1,25 @@ +/* $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 newplb(x) fprintf(codefile,".align 1\n%s:\n",x) +#define dlbdlb(s1,s2) fprintf(codefile,"%s = %s\n",s1,s2) +#define newlbss(l,x) fprintf(codefile,".lcomm\t%s,%d\n",l,x); + +#define cst_fmt "%ld" +#define off_fmt "%ld" +#define ilb_fmt "L%xL%x" +#define dlb_fmt "_%d" +#define hol_fmt "hol%d" + +#define fmt_id(fr,to) sprintf(to,"_%s",fr) + +#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 BSS_INIT 0 diff --git a/mach/vax4/cg/table b/mach/vax4/cg/table new file mode 100644 index 00000000..942fd12a --- /dev/null +++ b/mach/vax4/cg/table @@ -0,0 +1,4601 @@ +"$Header$" +#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 */ +#define FLOAT8 /* define if you want better 8-byte FP arithmetic */ + +#define NC nocoercions : +#define BSIZE 4 + +EM_PSIZE = 4 +EM_WSIZE = 4 +EM_BSIZE = BSIZE + +/**************************************************************** + * 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: +AP = ("ap",4),ArgumentPointer. +LB = ("fp",4),LocaLBase. +R0 = ("r0",4),REG. +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. +QR2 = ("r2",8,R2,R3),QREG. +#ifndef REGVARS +QR4 = ("r4",8,R4,R5),QREG. +QR6 = ("r6",8,R6,R7),QREG. +QR8 = ("r8",8,R8,R9),QREG. +QRA = ("r10",8,RA,RB),QREG. +#endif REGVARS +QR1 = ("r1",8,R1,R2),QREG. +#ifndef REGVARS +QR3 = ("r3",8,R3,R4),QREG. +QR5 = ("r5",8,R5,R6),QREG. +QR7 = ("r7",8,R7,R8),QREG. +QR9 = ("r9",8,R9,RA),QREG. +#endif REGVARS + +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 = {REGISTER reg; INT num,size;} 4 cost=(2,6) "%[num](%[reg])" +LOCAL2 = {REGISTER reg; INT num,size;} 4 cost=(2,6) "%[num](%[reg])" +LOCAL4 = {REGISTER reg; INT num,size;} 4 cost=(2,6) "%[num](%[reg])" +LOCAL8 = {REGISTER reg; INT num,size;} 8 cost=(2,9) "%[num](%[reg])" +ADDR_LOCAL = {REGISTER reg; INT num;} 4 cost=(2,6) "%[num](%[reg])" +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 +dups4 = CONST + regdef1 + displ1 + LOCAL1 + + REG + regdef2 + displ2 + LOCAL2 + + RREG + regdef4 + displ4 + LOCAL4 + DOUBLE +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 +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 + LocaLBase +reg8 = QREG +#else REGVARS +reg4 = REG +reg8 = QREG +#endif REGVARS +sreg4 = REG * SCRATCH +sreg8 = QREG * SCRATCH +bigsource4 = source1or2or4 + nonexist +bigsource8 = source8 + FCONST8 +all = bigsource4 + bigsource8 +scr = ALL - (EXTERNALS + LOCALS + ADDR_LOCAL + ADDR_EXTERNAL + CONST + + DOUBLE) +#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 $1 < 0 | | | {LOCAL4,LB,$1,4} | | +lol $1 >= 0 | | | {LOCAL4,AP,$1,4} | | +loe | | | {EXTERNAL4,$1} | | +#ifdef REGVARS +lil inreg($1)==2 | | REMREG($1) | {regdef4,regvar($1)} | | +#endif REGVARS +lil $1 < 0 | | | {displdef4,LB,tostring($1)} | | +lil $1 >= 0 | | | {displdef4,AP,tostring($1)} | | +lof | | | | adp $1 loi 4 | +lal $1 < 0 | | | {ADDR_LOCAL,LB,$1} | | +lal $1 >= 0 | | | {ADDR_LOCAL,AP,$1} | | +lae | | | {ADDR_EXTERNAL,$1} | | +lxl $1==0 | | | LB | | +lxl $1==1 | | | {LOCAL4,AP,BSIZE,4} | | +lxl $1 > 1 | | remove(scr) + move({CONST4,$1},R0) + "jsb\t.lxl" + erase(R0) | R0 | | +lxa $1==0 | | | {ADDR_LOCAL,AP,BSIZE} | | +lxa $1==1 | | | {LOCAL4,AP,BSIZE,4} | lpb | +lxa $1 > 1 | | remove(scr) + move({CONST4,$1},R0) + "jsb\t.lxa" + erase(R0) | R0 | | +loi $1==1 | NC adispl | | {displ1,%[1.reg],%[1.ind]} | | +... | NC ADDR_LOCAL | | {LOCAL1,%[1.reg],%[1.num],1} | | +... | NC LOCAL4 | | {displdef1,%[1.reg],tostring(%[1.num])} | | +... | NC regdef4 | | {displdef1,%[1.reg],"0"} | | +... | NC displ4 | | {displdef1,%[1.reg],%[1.ind]} | | +... | 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]} | | +... | reg4 | | {regdef1,%[1]} | | +loi $1==2 | NC adispl | | {displ2,%[1.reg],%[1.ind]} | | +... | NC ADDR_LOCAL | | {LOCAL2,%[1.reg],%[1.num],2} | | +... | NC LOCAL4 | | {displdef2,%[1.reg],tostring(%[1.num])} | | +... | NC regdef4 | | {displdef2,%[1.reg],"0"} | | +... | NC 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]} | | +... | reg4 | | {regdef2,%[1]} | | +loi $1==4 | NC adispl | | {displ4,%[1.reg],%[1.ind]} | | +... | NC ADDR_LOCAL | | {LOCAL4,%[1.reg],%[1.num],4} | | +... | NC LOCAL4 | | {displdef4,%[1.reg],tostring(%[1.num])} | | +... | NC regdef4 | | {displdef4,%[1.reg],"0"} | | +... | NC 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]} | | +... | reg4 | | {regdef4,%[1]} | | +loi $1==8 | NC adispl | | {displ8,%[1.reg],%[1.ind]} | | +... | NC ADDR_LOCAL | | {LOCAL8,%[1.reg],%[1.num],8} | | +... | NC LOCAL4 | | {displdef8,%[1.reg],tostring(%[1.num])} | | +... | NC regdef4 | | {displdef8,%[1.reg],"0"} | | +... | NC 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]} | | +... | reg4 | | {regdef8,%[1]} | | +loi $1>8 && $1<=16 + | NC ADDR_EXTERNAL | + | {EXTERNAL8,%[1.ind]+"+"+tostring($1-8)} + %[1] | loi $1-8 | +... | NC ADDR_LOCAL | + | {LOCAL8,%[1.reg],%[1.num]+$1-8,8} %[1] + | loi $1-8 | +... | reg4 | | {displ8,%[1],tostring($1-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 | STACK | + move({CONST1,4},R0) + "jsb\t.los" + erase(R0) | | | +los !defined($1) | source1or2or4 | + remove(ALL) + move(%[1],R0) + "jsb\t.los" + erase(R0) | | | +ldl $1<0 | | | {LOCAL8,LB,$1,8} | | +ldl $1>=0 | | | {LOCAL8,AP,$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)) | | | +... | STACK | + "movl\t(sp)+,%(regvar($1)%)" | | | (3,7) +#endif REGVARS +stl $1 < 0 | NC bigsource4 | + remove(displaced) + remove(LOCALS,%[num] <= $1+3 && %[num]+%[size] > $1) + move(%[1],{LOCAL4,LB,$1,4}) | | | +... | STACK | + "movl\t(sp)+,$1(fp)" | | | (5,14) +stl $1 >= 0 | NC bigsource4 | + remove(displaced) + remove(LOCALS,%[num] <= $1+3 && %[num]+%[size] > $1) + move(%[1],{LOCAL4,AP,$1,4}) | | | +... | STACK | + "movl\t(sp)+,$1(ap)" | | | (5,14) +ste | NC bigsource4 | + remove(externals) + move(%[1],{EXTERNAL4,$1}) | | | +... | STACK | + "movl\t(sp)+,$1" | | | (7,14) +#ifdef REGVARS +sil inreg($1)==2 | NC bigsource4 | + REMEXTANDLOC + move(%[1],{regdef4,regvar($1)}) | | | +... | STACK | + "movl\t(sp)+,(%(regvar($1)%))" | | | (3,10) +#endif REGVARS +sil $1 < 0 | NC bigsource4 | + REMEXTANDLOC + move(%[1],{displdef4,LB,tostring($1)}) | | | +... | STACK | + "movl\t(sp)+,*$1(fp)" | | | (5,17) +sil $1 >= 0 | NC bigsource4 | + REMEXTANDLOC + move(%[1],{displdef4,AP,tostring($1)}) | | | +... | STACK | + "movl\t(sp)+,*$1(ap)" | | | (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.reg],%[1.num],1}) | | | +... | NC 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]}) + | | | +... | reg4 source1or2or4 | + REMEXTANDLOC + move(%[2],{regdef1,%[1]}) | | | +... | NC nonexist1+aind1 STACK | + "cvtlb\t(sp)+,%[1]" | | | (3,7)+%[1] +sti $1==2 | NC adispl source1or2or4 | + REMEXTANDLOC + move(%[2],{displ2,%[1.reg],%[1.ind]}) | | | +... | NC ADDR_LOCAL source1or2or4 | + remove(displaced) + remove(LOCALS, + %[num]<=%[1.num] && %[num]+%[size]>%[1.num]) + move(%[2],{LOCAL2,%[1.reg],%[1.num],2}) | | | +... | NC 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]}) + | | | +... | reg4 source1or2or4 | + REMEXTANDLOC + move(%[2],{regdef2,%[1]}) | | | +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] | +... | NC LOCAL4 bigsource4 | + REMEXTANDLOC + move(%[2],{displdef4,%[1.reg],tostring(%[1.num])}) | | | +... | NC regdef4 bigsource4 | + REMEXTANDLOC + move(%[2],{displdef4,%[1.reg],"0"}) | | | +... | NC 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]}) + | | | +... | NC nonexist1+aind4 STACK | + "movl\t(sp)+,%[1]" | | | (3,7)+%[1] +... | reg4 bigsource4 | + REMEXTANDLOC + move(%[2],{regdef4,%[1]}) | | | +... | reg4 STACK | + "movl\t(sp)+,(%[1])" | | | (3,10) +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] | +... | NC displ4 bigsource8 | + REMEXTANDLOC + move(%[2],{displdef8,%[1.reg],%[1.ind]}) | | | +... | NC LOCAL4 bigsource8 | + REMEXTANDLOC + move(%[2],{displdef8,%[1.reg],tostring(%[1.num])}) | | | +... | NC regdef4 bigsource8 | + REMEXTANDLOC + move(%[2],{displdef8,%[1.reg],"0"}) | | | +... | 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]}) + | | | +... | reg4 bigsource8 | + REMEXTANDLOC + move(%[2],{regdef8,%[1]}) | | | +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 $1 < 0 | NC bigsource8 | + remove(displaced) + remove(LOCALS,%[num]<=$1+7 && %[num]+%[size]>$1) + move(%[1],{LOCAL8,LB,$1,8}) | | | +... | NC bigsource4 bigsource4 | + remove(displaced) + remove(LOCALS,%[num]<=$1+7 && %[num]+%[size]>$1) + move(%[1],{LOCAL4,LB,$1,4}) + move(%[2],{LOCAL4,LB,$1+4,4}) | | | +... | STACK | + "movq\t(sp)+,$1(fp)" | | | (5,14) +sdl $1 >= 0 | NC bigsource8 | + remove(displaced) + remove(LOCALS,%[num]<=$1+7 && %[num]+%[size]>$1) + move(%[1],{LOCAL8,AP,$1,8}) | | | +... | NC bigsource4 bigsource4 | + remove(displaced) + remove(LOCALS,%[num]<=$1+7 && %[num]+%[size]>$1) + move(%[1],{LOCAL4,AP,$1,4}) + move(%[2],{LOCAL4,AP,$1+4,4}) | | | +... | STACK | + "movq\t(sp)+,$1(ap)" | | | (5,14) +sde | NC bigsource8 | + remove(externals) + move(%[1],{EXTERNAL8,$1}) | | | +... | bigsource4 bigsource4 | + remove(externals) + move(%[1],{EXTERNAL4,$1}) + move(%[2],{EXTERNAL4,$1+"+4"}) | | | +... | STACK | + "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] +... | source4 source4 | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num]<=$2+3 && %[num]+%[size]>$2) + "addl3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +adi stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num]<=$2+3 && %[num]+%[size]>$2) + "addl3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "addl3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +adi sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "addl3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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] +... | source4 source4 | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "subl3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +sbi stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "subl3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "subl3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +sbi sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "subl3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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] +... | source4 source4 | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mull3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +mli stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mull3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "mull3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +mli sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "mull3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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] +... | source4 source4 | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "divl3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +dvi stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "divl3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "divl3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +dvi sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "divl3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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 && $2<0 + | 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,LB,$2,4}) | | | +rmi stl $1==4 && $2>=0 + | 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(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | 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 sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + allocate(REG) + "divl3\t%[1],%[2],%[a]" + "mull2\t%[1],%[a]" + "subl3\t%[a],%[2],*$2(ap)" + setcc({displdef4,AP,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 && $2<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mnegl\t%[1],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +ngi stl $1==4 && $2>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mnegl\t%[1],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 | + REMEXTANDLOC + "mnegl\t%[1],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +ngi sil $1==4 && $2>=0 + | source4 | + REMEXTANDLOC + "mnegl\t%[1],*$2(ap)" + setcc({displdef4,AP,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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "ashl\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +sli stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "ashl\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "ashl\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +sli sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "ashl\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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 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 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] +... | NC 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 && $2<0 + | source4 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,LB,$2,4}) | | | (9,11)+%[1]+%[2] +... | NC CONST source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "ashl\t$$%(0-%[1.num]%),%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | (6,7)+%[1]+%[2] +sri stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + allocate(%[1],REG) + "mnegl\t%[1],%[a]" + "ashl\t%[a],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | (9,11)+%[1]+%[2] +... | NC CONST source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "ashl\t$$%(0-%[1.num]%),%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | (6,7)+%[1]+%[2] +#ifdef REGVARS +sri sil $1==4 && inreg($2)==2 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mnegl\t%[1],%[a]" + "ashl\t%[a],%[2],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) | | | (9,14)+%[1]+%[2] +... | NC 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 && $2<0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mnegl\t%[1],%[a]" + "ashl\t%[a],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) + | | | (9,17)+%[1]+%[2] +... | NC CONST source4 | + REMEXTANDLOC + "ashl\t$$%(0-%[1.num]%),%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) + | | | (6,13)+%[1]+%[2] +sri sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mnegl\t%[1],%[a]" + "ashl\t%[a],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) + | | | (9,17)+%[1]+%[2] +... | NC CONST source4 | + REMEXTANDLOC + "ashl\t$$%(0-%[1.num]%),%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) + | | | (6,13)+%[1]+%[2] +sri ste $1==4 | source4 source4 | + remove(externals) + allocate(%[1],REG) + "mnegl\t%[1],%[a]" + "ashl\t%[a],%[2],$2" + setcc({EXTERNAL4,$2}) | | | (11,14)+%[1]+%[2] +... | NC 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 | STACK | + "jsb\t.dvu4" | R0 | | +dvu !defined($1) | source1or2or4 | + remove(ALL) + move(%[1],R0) + "jsb\t.dvu" + erase(R0) | | | +rmu $1==4 | STACK | + "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 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 source4 | + allocate(%[1],%[2],REG) + "addf3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,8)+%[1]+%[2] +#ifdef FLOAT4 +... | 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] +#ifdef REGVARS +adf stl $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "addf3\t%[1],%[2],%(regvar($2)%)" + erase(regvar($2)) | | | +#endif REGVARS +adf stl $1==4 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "addf3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +adf stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "addf3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +adf sil $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "addf3\t%[1],%[2],(%(regvar($2)%))" + setcc(regvar($2)) | | | +#endif REGVARS +adf sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + "addf3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +adf sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "addf3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +adf ste $1==4 | source4 source4 | + remove(externals) + "addf3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +#endif FLOAT4 +adf $1==8 | source8 source8 | + allocate(%[1],%[2],QREG) + "addd3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,14)+%[1]+%[2] +#ifdef FLOAT8 +... | 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] +adf sdl $1==8 && $2<0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "addd3\t%[1],%[2],$2(fp)" + setcc({LOCAL8,LB,$2,8}) | | | +adf sdl $1==8 && $2>=0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "addd3\t%[1],%[2],$2(ap)" + setcc({LOCAL8,AP,$2,8}) | | | +adf sde $1==8 | source8 source8 | + remove(externals) + "addd3\t%[1],%[2],$2" + setcc({EXTERNAL8,$2}) | | | +#endif FLOAT8 +adf !defined($1) | source4 | + remove(ALL) + move(%[1],R0) + "jsb\t.adf" | | | +sbf $1==4 | source4 source4 | + allocate(%[1],%[2],REG) + "subf3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,8)+%[1]+%[2] +#ifdef FLOAT4 +... | NC source4 sreg4 | + "subf2\t%[1],%[2]" + erase(%[2]) + setcc(%[2]) | %[2] | | (3,8) + %[1] +#ifdef REGVARS +sbf stl $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "subf3\t%[1],%[2],%(regvar($2)%)" + erase(regvar($2)) + setcc(regvar($2)) | | | +#endif REGVARS +sbf stl $1==4 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "subf3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +sbf stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "subf3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +sbf sil $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "subf3\t%[1],%[2],(%(regvar($2)%))" + setcc(regvar($2)) | | | +#endif REGVARS +sbf sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + "subf3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +sbf sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "subf3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +sbf ste $1==4 | source4 source4 | + remove(externals) + "subf3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +#endif FLOAT4 +sbf $1==8 | source8 source8 | + allocate(%[1],%[2],QREG) + "subd3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,14)+%[1]+%[2] +#ifdef FLOAT8 +... | source8 sreg8 | + "subd2\t%[1],%[2]" + erase(%[2]) + setcc(%[2]) | %[2] | | (3,14) + %[1] +sbf sdl $1==8 && $2<0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "subd3\t%[1],%[2],$2(fp)" + setcc({LOCAL8,LB,$2,8}) | | | +sbf sdl $1==8 && $2>=0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "subd3\t%[1],%[2],$2(ap)" + setcc({LOCAL8,AP,$2,8}) | | | +sbf sde $1==8 | source8 source8 | + remove(externals) + "subd3\t%[1],%[2],$2" + setcc({EXTERNAL8,$2}) | | | +#endif FLOAT8 +sbf !defined($1) | source1or2or4 | + remove(ALL) + move(%[1],R0) + "jsb\t.sbf" | | | +mlf $1==4 | source4 source4 | + allocate(%[1],%[2],REG) + "mulf3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,12)+%[1]+%[2] +#ifdef FLOAT4 +... | 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] +#ifdef REGVARS +mlf stl $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "mulf3\t%[1],%[2],%(regvar($2)%)" + erase(regvar($2)) | | | +#endif REGVARS +mlf stl $1==4 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "mulf3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +mlf stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "mulf3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +mlf sil $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "mulf3\t%[1],%[2],(%(regvar($2)%))" + setcc(regvar($2)) | | | +#endif REGVARS +mlf sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + "mulf3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +mlf sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "mulf3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +mlf ste $1==4 | source4 source4 | + remove(externals) + "mulf3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +#endif FLOAT4 +mlf $1==8 | source8 source8 | + allocate(%[1],%[2],QREG) + "muld3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,20)+%[1]+%[2] +#ifdef FLOAT8 +... | 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] +mlf sdl $1==8 && $2<0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "muld3\t%[1],%[2],$2(fp)" + setcc({LOCAL8,LB,$2,8}) | | | +mlf sdl $1==8 && $2>=0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "muld3\t%[1],%[2],$2(ap)" + setcc({LOCAL8,AP,$2,8}) | | | +mlf sde $1==8 | source8 source8 | + remove(externals) + "muld3\t%[1],%[2],$2" + setcc({EXTERNAL8,$2}) | | | +#endif FLOAT8 +mlf !defined($1) | source1or2or4 | + remove(ALL) + move(%[1],R0) + "jsb\t.mlf" | | | +dvf $1==4 | source4 source4 | + allocate(%[1],%[2],REG) + "divf3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,46)+%[1]+%[2] +#ifdef FLOAT4 +... | source4 sreg4 | + "divf2\t%[1],%[2]" + erase(%[2]) + setcc(%[2]) | %[2] | | (3,46) + %[1] +#ifdef REGVARS +dvf stl $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "divf3\t%[1],%[2],%(regvar($2)%)" + erase(regvar($2)) + setcc(regvar($2)) | | | +#endif REGVARS +dvf stl $1==4 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "divf3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +dvf stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "divf3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +dvf sil $1==4 && inreg($2)==2 + | source4 source4 | + remove(regvar($2)) + "divf3\t%[1],%[2],(%(regvar($2)%))" + setcc(regvar($2)) | | | +#endif REGVARS +dvf sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + "divf3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +dvf sil $1==4 &&$2>=0 + | source4 source4 | + REMEXTANDLOC + "divf3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +dvf ste $1==4 | source4 source4 | + remove(externals) + "divf3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +#endif FLOAT4 +dvf $1==8 | source8 source8 | + allocate(%[1],%[2],QREG) + "divd3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,80)+%[1]+%[2] +#ifdef FLOAT8 +... | source8 sreg8 | + "divd2\t%[1],%[2]" + erase(%[2]) + setcc(%[2]) | %[2] | | (3,80) + %[1] +dvf sdl $1==8 && $2<0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "divd3\t%[1],%[2],$2(fp)" + setcc({LOCAL8,LB,$2,8}) | | | +dvf sdl $1==8 && $2>=0 + | source8 source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "divd3\t%[1],%[2],$2(ap)" + setcc({LOCAL8,AP,$2,8}) | | | +dvf sde $1==8 | source8 source8 | + remove(externals) + "divd3\t%[1],%[2],$2" + setcc({EXTERNAL8,$2}) | | | +#endif FLOAT8 +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 +#ifdef REGVARS +ngf stl $1==4 && inreg($2)==2 + | source4 | + remove(regvar($2)) + "mnegf\t%[1],%(regvar($2)%)" + erase(regvar($2)) + setcc(regvar($2)) | | | +#endif REGVARS +ngf stl $1==4 && $2<0 + | source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "mnegf\t%[1],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +ngf stl $1==4 && $2>=0 + | source4 | + remove(displaced) + remove(LOCALS,%[num] <= $2+3 && %[num]+%[size] > $2) + "mnegf\t%[1],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +ngf sil $1==4 && inreg($2)==2 + | source4 | + remove(regvar($2)) + "mnegf\t%[1],(%(regvar($2)%))" + setcc(regvar($2)) | | | +#endif REGVARS +ngf sil $1==4 && $2<0 + | source4 | + REMEXTANDLOC + "mnegf\t%[1],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +ngf sil $1==4 && $2>=0 + | source4 | + REMEXTANDLOC + "mnegf\t%[1],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +ngf ste $1==4 | source4 | + remove(externals) + "mnegf\t%[1],$2" + setcc({EXTERNAL4,$2}) | | | +#endif FLOAT4 +ngf $1==8 | source8 | + allocate(%[1],QREG) + "mnegd\t%[1],%[a]" + setcc(%[a]) | %[a] | | +#ifdef FLOAT8 +ngf sdl $1==8 && $2<0 + | source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "mnegd\t%[1],$2(fp)" + setcc({LOCAL8,LB,$2,8}) | | | +ngf sdl $1==8 && $2>=0 + | source8 | + remove(displaced) + remove(LOCALS,%[num] <= $2+7 && %[num]+%[size] > $2) + "mnegd\t%[1],$2(ap)" + setcc({LOCAL8,AP,$2,8}) | | | +ngf sde $1==8 | source8 | + remove(externals) + "mnegd\t%[1],$2" + setcc({EXTERNAL8,$2}) | | | +#endif FLOAT8 +ngf !defined($1) | source1or2or4 | + remove(ALL) + move(%[1],R0) + "jsb\t.ngf" | | | +fif $1==4 | source4 source4 | + allocate(%[1],%[2],REG,REG) + "mulf3\t%[1],%[2],%[a]" + "emodf\t%[a],$$0,$$0f1.0,-(sp),%[b]" + /* + * Don't trust the integer part. + * Overflow could occur. + */ + "tstl\t(sp)+" + "subf2\t%[b],%[a]" | %[b] %[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 ADDR_EXTERNAL | + | {ADDR_EXTERNAL,%[1.ind]+"+"+tostring($1)} | | +... | NC ADDR_LOCAL | + | {ADDR_LOCAL,%[1.reg],%[1.num]+$1} | | +... | NC adisplind1 | + | {adisplind1,%[1.ireg],%[1.reg], + %[1.ind]+"+"+tostring($1)} | | +... | NC adispldefind1 | + allocate(%[1.ireg],REG) + "addl3\t$$$1,%[1.ireg],%[a]" + | {adispldefind1,%[a],%[1.reg],%[1.ind]} | | +... | NC aextdefind1 | + allocate(%[1],REG) + "addl3\t$$$1,%[1.ireg],%[a]" + | {aextdefind1,%[a],%[1.ind]} | | +... | NC adispl | | {adispl,%[1.reg],%[1.ind]+"+"+tostring($1)} | | +... | reg4 | | {adispl,%[1],tostring($1)} | | +adp stl | | | {CONST4,$1} | adi 4 stl $2 | +adp ste | | | {CONST4,$1} | adi 4 ste $2 | +adp dup $2==4 | | | {CONST4,$1} | adi 4 dup 4 | +adp lol stf | | | {CONST4,$1} | adi 4 lol $2 stf $3 | +adp lol sti $3==4 + | | | {CONST4,$1} | adi 4 lol $2 sti 4 | +adp loe sti $3==4 + | | | {CONST4,$1} | adi 4 loe $2 sti 4 | +adp cms $2==4 | | | {CONST4,$1} | adi 4 cms 4 | +loe lof adp loe stf $1==$4 && $2==$5 + | | REMEXTANDLOC + allocate(REG={EXTERNAL4,$1}) + "addl2\t$$$3,$2(%[a])" | | | +lol lof adp lol stf $1<0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,LB,$1,4}) + "addl2\t$$$3,$2(%[a])" | | | +lol lof adp lol stf $1>=0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,AP,$1,4}) + "addl2\t$$$3,$2(%[a])" | | | +ads $1==4 | NC reg4 adispl | + | {adisplind1,%[1],%[2.reg],%[2.ind]} | | +... | NC reg4 ADDR_LOCAL | + | {adisplind1,%[1],%[2.reg],tostring(%[2.num])} | | +... | NC reg4 ADDR_EXTERNAL | + | {adispl,%[1],%[2.ind]} | | +... | NC reg4 aextind2 | + | {adisplind2,%[2.ireg],%[1],%[2.ind]} | | +... | NC reg4 aextind4 | + | {adisplind4,%[2.ireg],%[1],%[2.ind]} | | +... | NC reg4 aextind8 | + | {adisplind8,%[2.ireg],%[1],%[2.ind]} | | +... | NC reg4 displ4 | + | {adispldefind1,%[1],%[2.reg],%[2.ind]} | | +... | NC reg4 LOCAL4 | + | {adispldefind1,%[1],%[2.reg],tostring(%[2.num])} | | +... | NC reg4 regdef4 | + | {adispldefind1,%[1],%[2.reg],"0"} | | +... | NC reg4 EXTERNAL4 | + | {aextdefind1,%[1],%[2.ind]} | | +... | NC reg4 reg4 | | {adisplind1,%[1],%[2],"0"} | | +... | | | | adi 4 | +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 | +dup adp lol sti $1==4 && $4==4 + | bigsource4 | + allocate(REG=%[1]) + | %[a] %[1] {CONST4,$2} + | adi 4 lol $3 sti 4 | +dup adp loe sti $1==4 && $4==4 + | bigsource4 | + allocate(REG=%[1]) + | %[a] %[1] {CONST4,$2} + | adi 4 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 && $1<0 + | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "addl2\t$$$2,$1(ap)" + setcc({LOCAL4,LB,$1,4}) | | | +lol adp stl $1==$3 && $1>=0 + | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "addl2\t$$$2,$1(ap)" + setcc({LOCAL4,AP,$1,4}) | | | +lol lol adp stl $1==$4 && $2==$4 && $2<0 + | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + allocate(REG={LOCAL4,LB,$1,4}) + "addl2\t$$$3,$1(fp)" + setcc({LOCAL4,LB,$1,4}) | %[a] | | +lol lol adp stl $1==$4 && $2==$4 + | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + allocate(REG={LOCAL4,AP,$1,4}) + "addl2\t$$$3,$1(ap)" + setcc({LOCAL4,AP,$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 | +loe lof inc loe stf $1==$4 && $2==$5 + | | REMEXTANDLOC + allocate(REG={EXTERNAL4,$1}) + "incl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +lol lof inc lol stf $1<0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,LB,$1,4}) + "incl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +lol lof inc lol stf $1>=0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,AP,$1,4}) + "incl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +dec | | | {CONST1,1} | sbi 4 | +loe lof dec loe stf $1==$4 && $2==$5 + | | REMEXTANDLOC + allocate(REG={EXTERNAL4,$1}) + "decl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +lol lof dec lol stf $1<0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,LB,$1,4}) + "decl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +lol lof dec lol stf $1>=0 && $1==$4 && inreg($1)!=2 && $2==$5 + | | REMEXTANDLOC + allocate(REG={LOCAL4,AP,$1,4}) + "decl\t$2(%[a])" + setcc({displ4,%[a],tostring($2)}) | | | +#ifdef REGVARS +inl inreg($1)==2 | | remove(regvar($1)) + "incl\t%(regvar($1)%)" + erase(regvar($1)) + setcc(regvar($1)) | | | +#endif REGVARS +inl $1<0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "incl\t$1(fp)" + setcc({LOCAL4,LB,$1,4}) | | | +inl $1>=0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "incl\t$1(ap)" + setcc({LOCAL4,AP,$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 $1<0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "decl\t$1(fp)" + setcc({LOCAL4,LB,$1,4}) | | | +del $1>=0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "decl\t$1(ap)" + setcc({LOCAL4,AP,$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 $1<0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "clrl\t$1(fp)" + setcc({LOCAL4,LB,$1,4}) | | | +zrl $1>=0 | | remove(displaced) + remove(LOCALS,%[num]<=$1+3 && %[num]+%[size]>$1) + "clrl\t$1(ap)" + setcc({LOCAL4,AP,$1,4}) | | | +zrl zrl $1==$2+4 && $1<0 +#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,LB,$2,8}) | | | +zrl zrl $1==$2+4 && $1>=0 +#ifdef REGVARS + && inreg($1)<2 && inreg($2)<2 +#endif REGVARS + | | remove(displaced) + remove(LOCALS,%[num]<=$2+7 && %[num]+%[size]>$2) + "clrq\t$2(ap)" + setcc({LOCAL8,AP,$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 | STACK | + "clrq\t-(sp)" | | zer $1-8 | +zer defined($1) | STACK | + 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 | STACK | + "jsb\t.cii" | | | +cfi | STACK | + "jsb\t.cfi" | | | +cfu | STACK | + "jsb\t.cfu" | | | +cuf | STACK | + "jsb\t.cuf" | | | +cif | STACK | + "jsb\t.cif" | | | +cff | STACK | + "jsb\t.cff" | | | +cuu | STACK | + "jsb\t.cuu" | | | +ciu | | | | cuu | +cui | STACK | + "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 && $4<0 + | source1or2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtbl\t%[1],$4(fp)" + setcc({LOCAL4,LB,$4,4}) | | | +loc loc cii stl $1==1 && $2==4 && $4>=0 + | source1or2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtbl\t%[1],$4(ap)" + setcc({LOCAL4,AP,$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 && $4<0 + | source2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtwl\t%[1],$4(fp)" + setcc({LOCAL4,LB,$4,4}) | | | +loc loc cii stl $1==2 && $2==4 && $4>=0 + | source2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtwl\t%[1],$4(ap)" + setcc({LOCAL4,AP,$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 FLOAT4 +#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 && $4<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtfl\t%[1],$4(fp)" + setcc({LOCAL4,AP,$4,4}) | | | +loc loc cfi stl $1==4 && $2==4 && $4>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtfl\t%[1],$4(ap)" + setcc({LOCAL4,AP,$4,4}) | | | +loc loc cfi ste $1==4 && $2==4 | source4 | + remove(externals) + "cvtfl\t%[1],$4" + setcc({EXTERNAL4,$4}) | | | +#endif FLOAT4 +loc loc cfi $1==4 && $2==4 | source4 | + allocate(%[1],REG) + "cvtfl\t%[1],%[a]" + setcc(%[a]) | %[a] | | (3,4) + %[1] +#ifdef FLOAT8 +#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 && $4<0 + | source8 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtdl\t%[1],$4(fp)" + setcc({LOCAL4,LB,$4,4}) | | | +loc loc cfi stl $1==8 && $2==4 && $4>=0 + | source8 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtdl\t%[1],$4(ap)" + setcc({LOCAL4,AP,$4,4}) | | | +loc loc cfi ste $1==8 && $2==4 | source8 | + remove(externals) + "cvtdl\t%[1],$4" + setcc({EXTERNAL4,$4}) | | | +#endif FLOAT8 +loc loc cfi $1==8 && $2==4 | source8 | + allocate(%[1],REG) + "cvtdl\t%[1],%[a]" + setcc(%[a]) | %[a] | | +#ifdef FLOAT4 +#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 && $4<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtlf\t%[1],$4(fp)" | | | +loc loc cif stl $1==4 && $2==4 && $4>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtlf\t%[1],$4(ap)" | | | +loc loc cif ste $1==4 && $2==4 | source4 | + remove(externals) + "cvtlf\t%[1],$4" | | | +#endif FLOAT4 +loc loc cif $1==4 && $2==4 | source4 | + allocate(%[1],REG) + "cvtlf\t%[1],%[a]" | %[a] | | +#ifdef FLOAT8 +/* No double registervariables +#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 && $4<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtld\t%[1],$4(fp)" | | | +loc loc cif sdl $1==4 && $2==8 && $4>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtld\t%[1],$4(ap)" | | | +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. + */ +#endif FLOAT8 +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 FLOAT8 +/* No double registervariables +#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 && $4<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+7 && %[num]+%[size] > $4)) + "cvtfd\t%[1],$4(fp)" | | | +loc loc cff sdl $1==4 && $2==8 && $4>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+7 && %[num]+%[size] > $4)) + "cvtfd\t%[1],$4(ap)" | | | +loc loc cff sde $1==4 && $2==8 | source4 | + remove(externals) + "cvtfd\t%[1],$4" | | | +#endif FLOAT8 +loc loc cff $1==4 && $2==8 | source4 | + allocate(%[1],QREG) + "cvtfd\t%[1],%[a]" | %[a] | | +#ifdef FLOAT4 +#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 && $4<0 + | source8 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtdf\t%[1],$4(fp)" | | | +loc loc cff stl $1==8 && $2==4 && $4>=0 + | source8 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "cvtdf\t%[1],$4(ap)" | | | +loc loc cff ste $1==8 && $2==4 | source8 | + remove(externals) + "cvtdf\t%[1],$4" | | | +#endif FLOAT4 +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 && $4<0 + | source2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "movzwl\t%[1],$4(fp)" + setcc({LOCAL4,LB,$4,4}) | | | +loc loc cuu stl $1==2 && $2==4 && $4>=0 + | source2or4 | + remove(displaced) + remove(LOCALS,(%[num] <= $4+3 && %[num]+%[size] > $4)) + "movzwl\t%[1],$4(ap)" + setcc({LOCAL4,AP,$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] +... | NC CONST source4 | + allocate(%[2],REG) + "bicl3\t$$~%[1.num],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,3)+%[1]+%[2] +... | NC source4 CONST | + allocate(%[1],REG) + "bicl3\t$$~%[2.num],%[1],%[a]" + setcc(%[a]) | %[a] | | (4,3)+%[1]+%[2] +and zeq $1==4 | source4 source4 | + remove(ALL) + "bitl\t%[1],%[2]" + "jeql\t$2" | | | +and zne $1==4 | 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 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] +... | NC CONST source4 | + remove(regvar($2)) + "bicl3\t$$~%[1.num],%[2],%(regvar($2)%)" + erase(regvar($2)) + setcc(regvar($2)) | | | (4,4)+%[1]+%[2] +... | NC 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 && $2<0 + | source4 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,LB,$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,LB,$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,LB,$2,4}) | | | (6,9)+%[1]+%[2] +and stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + allocate(%[1],REG) + "mcoml\t%[1],%[a]" + "bicl3\t%[a],%[2],$2(ap)" + setcc({LOCAL4,AP,$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(ap)" + setcc({LOCAL4,AP,$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(ap)" + setcc({LOCAL4,AP,$2,4}) | | | (6,9)+%[1]+%[2] +#ifdef REGVARS +and sil $1==4 && inreg($2)==2 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mcoml\t%[1],%[a]" + "bicl3\t%[a],%[2],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) + | | | (9,15)+%[1]+%[2] +... | NC CONST source4 | + REMEXTANDLOC + "bicl3\t$$~%[1.num],%[2],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) + | | | (6,12)+%[1]+%[2] +... | NC source4 CONST | + REMEXTANDLOC + "bicl3\t$$~%[2.num],%[1],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) + | | | (6,12)+%[1]+%[2] +#endif REGVARS +and sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mcoml\t%[1],%[a]" + "bicl3\t%[a],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) + | | | (9,15)+%[1]+%[2] +... | NC CONST source4 | + REMEXTANDLOC + "bicl3\t$$~%[1.num],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) + | | | (6,12)+%[1]+%[2] +... | NC source4 CONST | + REMEXTANDLOC + "bicl3\t$$~%[2.num],%[1],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) + | | | (6,12)+%[1]+%[2] +and sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "mcoml\t%[1],%[a]" + "bicl3\t%[a],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) + | | | (9,15)+%[1]+%[2] +... | NC CONST source4 | + REMEXTANDLOC + "bicl3\t$$~%[1.num],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) + | | | (6,12)+%[1]+%[2] +... | NC source4 CONST | + REMEXTANDLOC + "bicl3\t$$~%[2.num],%[1],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) + | | | (6,12)+%[1]+%[2] +and ste $1==4 | source4 source4 | + remove(externals) + allocate(%[1],REG) + "mcoml\t%[1],%[a]" + "bicl3\t%[a],%[2],$2" + setcc({EXTERNAL4,$2}) | | | (11,12)+%[1]+%[2] +... | NC CONST source4 | + remove(externals) + "bicl3\t$$~%[1.num],%[2],$2" + setcc({EXTERNAL4,$2}) | | | (8,9)+%[1]+%[2] +... | NC source4 CONST | + remove(externals) + "bicl3\t$$~%[2.num],%[1],$2" + setcc({EXTERNAL4,$2}) | | | (8,9)+%[1]+%[2] +and $1==8 | sreg8 sreg8 | + "mcoml\t%[1.1],%[1.1]" + "mcoml\t%[1.2],%[1.2]" + "bicl2\t%[1.1],%[2.1]" + "bicl2\t%[1.2],%[2.2]" + erase(%[1]) erase(%[2]) | %[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 | source4 source4 | + allocate(%[1],%[2],REG) + "bisl3\t%[1],%[2],%[a]" + setcc(%[a]) | %[a] | | (4,4)+%[1]+%[2] +... | NC sreg4 source4 | + "bisl2\t%[2],%[1]" + erase(%[1]) + setcc(%[1]) | %[1] | | (3,4) + %[2] +... | NC 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "bisl3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +ior stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "bisl3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "bisl3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +ior sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "bisl3\t%[1],%[2],*$2(ap)" + setcc({displdef4,LB,tostring($2)}) | | | +ior ste $1==4 | source4 source4 | + remove(externals) + "bisl3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +ior $1==8 | sreg8 sreg8 | + "bisl2\t%[1.1],%[2.1]" + "bisl2\t%[1.2],%[2.2]" + erase(%[2]) | %[2] | | +ior defined($1) | STACK | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "xorl3\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +xor stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "xorl3\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "xorl3\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +xor sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "xorl3\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +xor ste $1==4 | source4 source4 | + remove(externals) + "xorl3\t%[1],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +xor defined($1) | STACK | + 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 && $2<0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mcoml\t%[1],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +com stl $1==4 && $2>=0 + | source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "mcoml\t%[1],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 | + REMEXTANDLOC + "mcoml\t%[1],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +com sil $1==4 && $2>=0 + | source4 | + REMEXTANDLOC + "mcoml\t%[1],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +com ste $1==4 | source4 | + remove(externals) + "mcoml\t%[1],$2" + setcc({EXTERNAL4,$2}) | | | +com defined($1) | STACK | + 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 && $2<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "rotl\t%[1],%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +rol stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "rotl\t%[1],%[2],$2(ap)" + setcc({LOCAL4,AP,$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 && $2<0 + | source4 source4 | + REMEXTANDLOC + "rotl\t%[1],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +rol sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + "rotl\t%[1],%[2],*$2(ap)" + setcc({displdef4,AP,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 source4 | + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],%[a]" + setcc(%[a]) | %[a] | | +... | NC 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 source4 | + remove(regvar($2)) + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],%(regvar($2)%)" + erase(regvar($2)) + setcc(regvar($2)) | | | +... | NC 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 && $2<0 + | source4 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,LB,$2,4}) | | | +... | NC CONST source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "rotl\t$$%(32-%[1.num]%),%[2],$2(fp)" + setcc({LOCAL4,LB,$2,4}) | | | +ror stl $1==4 && $2>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +... | NC CONST source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $2+3 && %[num]+%[size] > $2)) + "rotl\t$$%(32-%[1.num]%),%[2],$2(ap)" + setcc({LOCAL4,AP,$2,4}) | | | +#ifdef REGVARS +ror sil $1==4 && inreg($2)==2 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) | | | +... | NC CONST source4 | + REMEXTANDLOC + "rotl\t$$%(32-%[1.num]%),%[2],(%(regvar($2)%))" + setcc({regdef4,regvar($2)}) | | | +#endif REGVARS +ror sil $1==4 && $2<0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +... | NC CONST source4 | + REMEXTANDLOC + "rotl\t$$%(32-%[1.num]%),%[2],*$2(fp)" + setcc({displdef4,LB,tostring($2)}) | | | +ror sil $1==4 && $2>=0 + | source4 source4 | + REMEXTANDLOC + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +... | NC CONST source4 | + REMEXTANDLOC + "rotl\t$$%(32-%[1.num]%),%[2],*$2(ap)" + setcc({displdef4,AP,tostring($2)}) | | | +ror ste $1==4 | source4 source4 | + remove(externals) + allocate(%[1],REG) + "subl3\t%[1],$$32,%[a]" + "rotl\t%[a],%[2],$2" + setcc({EXTERNAL4,$2}) | | | +... | NC 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] +#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 && $3<0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $3+3 && %[num]+%[size] > $3)) + "bicl3\t%[1],%[2],$3(fp)" + setcc({LOCAL4,AP,$3,4}) | | | +com and stl $1==4 && $2==4 && $3>=0 + | source4 source4 | + remove(displaced) + remove(LOCALS,(%[num] <= $3+3 && %[num]+%[size] > $3)) + "bicl3\t%[1],%[2],$3(ap)" + setcc({LOCAL4,AP,$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 && $3<0 + | source4 source4 | + REMEXTANDLOC + "bicl3\t%[1],%[2],*$3(fp)" + setcc({displdef4,LB,tostring($3)}) | | | +com and sil $1==4 && $2==4 && $3>=0 + | source4 source4 | + REMEXTANDLOC + "bicl3\t%[1],%[2],*$3(ap)" + setcc({displdef4,AP,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 | STACK | + 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) | STACK | + 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) | STACK | + 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 adispl | + allocate(%[1],REG) + "mull3\t$$%(rom(1,3)%),%[1],%[a]" + | {adisplind1,%[a],%[2.reg],%[2.ind]} | | (8,10)+%[1] +... | NC source4 ADDR_EXTERNAL | + allocate(%[1],REG) + "mull3\t$$%(rom(1,3)%),%[1],%[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]" + | {adisplind1,%[a],%[2.reg], + %[2.ind]+"+"+tostring(0-rom(1,1)*rom(1,3))} + | | (8,10)+%[1] +... | NC source4 ADDR_EXTERNAL | + allocate(%[1],REG) + "mull3\t$$%(rom(1,3)%),%[1],%[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 | STACK | + "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 | STACK | + "jsb\t.sar4" | | | +sar !defined($1) | source4 | + remove(ALL) + move(%[1],R0) + "jsb\t.sar" + erase(R0) | | | +lar $1==4 | STACK | + "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) | STACK | + 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] | | +#ifdef FLOAT4 +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] | | +#endif FLOAT4 +#ifdef FLOAT8 +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] | | +#endif FLOAT8 +/* 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 | | %[1] | asp 4 | +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 | | %[1] | asp 4 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 asp $2%4 == 0 && $2>=0 + | reg4 | + remove(ALL) + "calls\t$$%($2/4%),(%[1])" | | | +cai | reg4 | + remove(ALL) + "calls\t$$0,(%[1])" | | | +cal asp $2%4 == 0 && $2>=0 + | | remove(ALL) + "calls\t$$%($2/4%),$1" | | | +cal | | remove(ALL) + "calls\t$$0,$1" | | | +lfr $1==4 | | | R0 | | +lfr $1==8 | | | QR0 | | +asp ret $2==0 | | "ret" | | | +ass ret $2==0 | | "ret" | | | +asp lfr ret $2==$3 | | "ret" | | | +ass lfr ret $2==$3 | | "ret" | | | +lfr ret $1==$2 | | "ret" | | | +ret $1==0 | | "ret" | | | +ret $1==4 | NC bigsource4 | + move(%[1],R0) + "ret" | | | +... | STACK | + "movl\t(sp)+,r0" + "ret" | | | +ret $1==8 | NC bigsource8 | + move(%[1],QR0) + "ret" | | | +... | STACK | + "movq\t(sp)+,r0" + "ret" | | | + +/******************************** + * Group 15 : Miscellaneous * + ********************************/ + +#ifdef REGVARS +asp $1==4 | bigsource4 - regch4 | | | | +#else REGVARS +asp $1==4 | NC bigsource4 | | | | +#endif REGVARS +... | STACK | + "tstl\t(sp)+" | | | (2,7) +asp $1>0 | STACK | + "addl2\t$$$1,sp" | | | +asp $1==(0-4) | | | {CONST4,0} | | +asp $1==(0-8) | | | {CONST8,"0"} | | +asp | STACK | + "subl2\t$$%(0-$1%),sp" | | | +ass $1==4 | source4 | + remove(ALL) + "addl2\t%[1],sp" | | | +ass !defined($1) | source4 | + remove(ALL) + move(%[1],R2) /* R2 <= leave return area intact. */ + "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 | STACK | + "jmp\t.csa4" | | | +csa !defined($1) | source4 | + remove(ALL) + move(%[1],R0) + "jmp\t.csa" + erase(R0) | | | +csb $1==4 | STACK | + "jmp\t.csb4" | | | +csb !defined($1) | source4 | + remove(ALL) + move(%[1],R0) + "jmp\t.csb" + erase(R0) | | | +dch | reg4 | | {displ4,%[1],"12"} | | +dup stl $1==4 | | | | stl $2 lol $2 | +dup $1==4 | dups4 | | %[1] %[1] | | +#ifdef REGVARS +dup $1==8 | bigsource8-regch8 | | %[1] %[1] | | +#else REGVARS +dup $1==8 | bigsource8 | | %[1] %[1] | | +#endif REGVARS +dup | STACK | + 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) | STACK | + 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 | STACK | + "pushl\t$$$1" + "jmp\t.gto" | | | +lor $1==0 | | | LB | | +lor $1==1 | STACK | + 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 | STACK | + "jsb\t.mon" | | | +nop | STACK | + "jsb\t.nop" | | | +#ifdef DORCK +rck $1==4 | STACK | + "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" | | | +sig | STACK | + "jsb\t.sig" | | | +sim | STACK | + "jsb\t.sim" | | | +str $1==0 | source4 | + remove(ALL) + "jsb\t.strlb" | | | +str $1==1 | source4 | + remove(ALL) + "movl\t%[1],sp" | | | +str $1==2 | STACK | + "jsb\t.strhp" | | | +trp | STACK | + "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] | | +| reg4 | | {adispl,%[1],"0"} | | +| ADDR_LOCAL | | {adispl,%[1.reg],tostring(%[1.num])} | | +| bigsource4-adispl-reg4-ADDR_LOCAL | + allocate(%[1],REG=%[1]) | {adispl,%[a],"0"} | | + +/******************************** + * 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.reg],%[1.num]+4,4} {LOCAL4,%[1.reg],%[1.num],4}| | +| EXTERNAL8 | | {EXTERNAL4,%[1.ind]+"+4"} {EXTERNAL4,%[1.ind]} | | +| QREG | | %[1.2] %[1.1] | | +| regdef4 | | {displ4,%[1.reg],"0"} | | +| LOCAL4 | | {displ4,%[1.reg],tostring(%[1.num])} | | + +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]) diff --git a/mach/vax4/libbc/Makefile b/mach/vax4/libbc/Makefile new file mode 100644 index 00000000..4a2432c5 --- /dev/null +++ b/mach/vax4/libbc/Makefile @@ -0,0 +1,21 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=vax4" "SUF=o" "ASAR=ar" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/vax4/libbc/compmodule b/mach/vax4/libbc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/vax4/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/vax4/libcc/Makefile b/mach/vax4/libcc/Makefile new file mode 100644 index 00000000..082bedfc --- /dev/null +++ b/mach/vax4/libcc/Makefile @@ -0,0 +1,54 @@ +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" +LIBM="PREF=m" "SRC=lang/cem/libcc/libm" +LIBLN="PREF=ln" "SRC=lang/cem/libcc/libln" + +install: cpstdio cpgen cpmon cplibm cplibln + +cpstdio: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp +cpgen: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp +cpmon: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp +cplibm: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(LIBM) $(MACHDEF) tailcp +cplibln: + RANLIB=ranlib ; export RANLIB ;\ + make -f $(MAKEFILE) $(LIBLN) $(MACHDEF) tailcp + +cmp: cmpstdio cmpgen cmpmon cmplib 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 diff --git a/mach/vax4/libcc/compmodule b/mach/vax4/libcc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/vax4/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/vax4/libem/LIST b/mach/vax4/libem/LIST new file mode 100644 index 00000000..8902b319 --- /dev/null +++ b/mach/vax4/libem/LIST @@ -0,0 +1,71 @@ +tail_em.a +adf.s +adi.s +and.s +ass.s +bls.s +cff.s +cfi.s +cfu.s +cif.s +cmand.s +cmf.s +cmi.s +cms.s +cmu.s +com.s +cuf.s +cui.s +cuu.s +dus.s +dvf.s +dvi.s +dvu.s +dvu4.s +exg.s +fef.s +fif.s +gto.s +inn.s +ior.s +los.s +lxa.s +lxl.s +mlf.s +mli.s +ngf.s +ngi.s +nop.s +print.s +rmi.s +rmu.s +rmu4.s +rol.s +ror.s +sbf.s +sbi.s +sbs.s +cii.s +set.s +sig.s +sim.s +sli.s +sri.s +sru.s +strhp.s +sts.s +xar.s +xor.s +aar4.s +lar4.s +sar4.s +csx.s +csa4.s +csb4.s +rck.s +rck4.s +lpb.s +strlb.s +mon.s +fat.s +trp.s diff --git a/mach/vax4/libem/Makefile b/mach/vax4/libem/Makefile new file mode 100644 index 00000000..d50c1ba9 --- /dev/null +++ b/mach/vax4/libem/Makefile @@ -0,0 +1,30 @@ +# $Header$ +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 + +all: head_em tail_em + +head_em: head_em.s + vax4 -I../../../h -c head_em.s ; mv head_em.o head_em + +tail_em: + ASAR=ar ; export ASAR ;\ + RANLIB=ranlib ; export RANLIB ;\ + 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` diff --git a/mach/vax4/libem/aar4.s b/mach/vax4/libem/aar4.s new file mode 100644 index 00000000..0aa65eea --- /dev/null +++ b/mach/vax4/libem/aar4.s @@ -0,0 +1,11 @@ + # $Header$ +.globl .aar4 + +.aar4: + movl (sp)+,r2 + movl (sp)+,r0 + movl 8(r0),r1 # elementsize in r1 + subl3 (r0),(sp)+,r0 + mull2 r1,r0 + addl2 (sp)+,r0 + jmp (r2) diff --git a/mach/vax4/libem/adf.s b/mach/vax4/libem/adf.s new file mode 100644 index 00000000..9bc407a4 --- /dev/null +++ b/mach/vax4/libem/adf.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .adf + +.adf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + addf2 (sp)+,(sp) + jmp (r1) +L1: + cmpl r0,$8 + bneq L2 + addd2 (sp)+,(sp) + jmp (r1) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/adi.s b/mach/vax4/libem/adi.s new file mode 100644 index 00000000..509e68b0 --- /dev/null +++ b/mach/vax4/libem/adi.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .adi + +.adi: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + addl2 (sp)+,(sp) + jmp (r1) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/and.s b/mach/vax4/libem/and.s new file mode 100644 index 00000000..a9a01ee4 --- /dev/null +++ b/mach/vax4/libem/and.s @@ -0,0 +1,13 @@ + # $Header$ +.globl .and + + # bytes in r0 +.and: + movl (sp)+,r3 + addl3 r0,sp,r1 + ashl $-2,r0,r0 +L1: + mcoml (sp)+,r2 + bicl2 r2,(r1)+ + sobgtr r0,L1 + jmp (r3) diff --git a/mach/vax4/libem/ass.s b/mach/vax4/libem/ass.s new file mode 100644 index 00000000..37a7a771 --- /dev/null +++ b/mach/vax4/libem/ass.s @@ -0,0 +1,16 @@ +#include "em_abs.h" + + # $Header$ + +.globl .ass + +.ass: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 + addl2 r0,sp + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/bls.s b/mach/vax4/libem/bls.s new file mode 100644 index 00000000..ded68fe9 --- /dev/null +++ b/mach/vax4/libem/bls.s @@ -0,0 +1,29 @@ +#include "em_abs.h" + + # $Header$ + +.globl .bls + +.bls: + movl (sp)+,r3 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 # number of bytes in r0 + movl (sp)+,r1 # addresses in r1, r2 + movl (sp)+,r2 + blbc r0,L1 + movb (r2)+,(r1)+ +L1: + bbc $1,r0,L2 + movw (r2)+,(r1)+ +L2: + ashl $-2,r0,r0 + beql L4 +L3: + movl (r2)+,(r1)+ + sobgtr r0,L3 +L4: + jmp (r3) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cff.s b/mach/vax4/libem/cff.s new file mode 100644 index 00000000..ee75d9fe --- /dev/null +++ b/mach/vax4/libem/cff.s @@ -0,0 +1,33 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cff + +.cff: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl r0,$4 + bneq Ldtd + movl (sp)+,r0 + cmpl r0,$4 + bneq Lddf + jmp (r1) +Lddf: + cmpl r0,$8 + bneq Lerr + cvtdf (sp)+,-(sp) + jmp (r1) +Ldtd: + movl (sp)+,r0 + cmpl r0,$4 + bneq Lddd + cvtfd (sp)+,-(sp) + jmp (r1) +Lddd: + cmpl r0,$8 + bneq Lerr + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cfi.s b/mach/vax4/libem/cfi.s new file mode 100644 index 00000000..c89c0ced --- /dev/null +++ b/mach/vax4/libem/cfi.s @@ -0,0 +1,24 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cfi + +.cfi: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 + cmpl r0,$4 + bneq Lddl + cvtfl (sp)+,-(sp) + jmp (r1) +Lddl: + cmpl r0,$8 + bneq Lerr + cvtdl (sp)+,-(sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cfu.s b/mach/vax4/libem/cfu.s new file mode 100644 index 00000000..b761293d --- /dev/null +++ b/mach/vax4/libem/cfu.s @@ -0,0 +1,37 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cfu + +.cfu: + movl (sp)+,r2 + movpsl r1 + bicl2 $~040,r1 + bicpsw $040 # integer overflow traps must be ignored + movl (sp)+,r0 + cmpl (sp),$4 + bneq Lddt + tstl (sp)+ + tstf (sp) + bgeq L1 + mnegf (sp),(sp) +L1: + cvtfl (sp)+,-(sp) +L2: + cmpl r0,$4 + bneq Lerr + bispsw r1 # restore trap enable bit + jmp (r2) +Lddt: + cmpl (sp)+,$8 + bneq Lerr + tstd (sp) + bgeq L3 + mnegd (sp),(sp) +L3: + cvtdl (sp)+,-(sp) + brb L2 +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cif.s b/mach/vax4/libem/cif.s new file mode 100644 index 00000000..65c0e75f --- /dev/null +++ b/mach/vax4/libem/cif.s @@ -0,0 +1,27 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cif + +.cif: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl r0,$4 + bneq Ldbl + movl (sp)+,r0 + cmpl r0,$4 + bneq Lerr + cvtlf (sp)+,-(sp) + jmp (r1) +Ldbl: + cmpl r0,$8 + bneq Lerr + movl (sp)+,r0 + cmpl r0,$4 + bneq Lerr + cvtld (sp)+,-(sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cii.s b/mach/vax4/libem/cii.s new file mode 100644 index 00000000..6a39061f --- /dev/null +++ b/mach/vax4/libem/cii.s @@ -0,0 +1,25 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cii + +.cii: + movl (sp)+, r1 + movl (sp)+, r0 + cmpl (sp), $1 + beql Lfrom1 + cmpl (sp), $2 + beql Lfrom2 + cmpl (sp)+, $4 + bgtr Lerr + jmp (r1) +Lfrom1: + cvtbw 4(sp), 4(sp) +Lfrom2: + tstl (sp)+ + cvtwl (sp), (sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cmand.s b/mach/vax4/libem/cmand.s new file mode 100644 index 00000000..ea9942bf --- /dev/null +++ b/mach/vax4/libem/cmand.s @@ -0,0 +1,13 @@ + # $Header$ +.globl .cmand + + # bytes in r0 + +.cmand: + movl (sp)+,r2 + addl3 r0,sp,r1 + ashl $-2,r0,r0 +L1: + bicl2 (sp)+,(r1)+ + sobgtr r0,L1 + jmp (r2) diff --git a/mach/vax4/libem/cmf.s b/mach/vax4/libem/cmf.s new file mode 100644 index 00000000..110b5753 --- /dev/null +++ b/mach/vax4/libem/cmf.s @@ -0,0 +1,30 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cmf + +.cmf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + clrl r0 + cmpf (sp)+,(sp)+ + brb L3 +L1: + cmpl r0,$8 + bneq Lerr + clrl r0 + cmpd (sp)+,(sp)+ +L3: + beql L2 + bgtr L4 + incl r0 + brb L2 +L4: + decl r0 +L2: + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cmi.s b/mach/vax4/libem/cmi.s new file mode 100644 index 00000000..c730675a --- /dev/null +++ b/mach/vax4/libem/cmi.s @@ -0,0 +1,23 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cmi + +.cmi: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + clrl r0 + cmpl (sp)+,(sp)+ + beql L1 + bgtr L2 + incl r0 + brb L1 +L2: + decl r0 +L1: + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cms.s b/mach/vax4/libem/cms.s new file mode 100644 index 00000000..fa74c344 --- /dev/null +++ b/mach/vax4/libem/cms.s @@ -0,0 +1,16 @@ + # $Header$ +.globl .cms + + # bytes in r0 +.cms: + movl (sp)+,r3 + addl3 sp,r0,r1 + addl3 r1,r0,r2 + ashl $-2,r0,r0 +L1: + cmpl (sp)+,(r1)+ + bneq L2 + sobgtr r0,L1 +L2: + movl r2,sp + jmp (r3) diff --git a/mach/vax4/libem/cmu.s b/mach/vax4/libem/cmu.s new file mode 100644 index 00000000..c30ecfd8 --- /dev/null +++ b/mach/vax4/libem/cmu.s @@ -0,0 +1,23 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cmu + +.cmu: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + clrl r0 + cmpl (sp)+,(sp)+ + beqlu L1 + bgtru L2 + incl r0 + brb L1 +L2: + decl r0 +L1: + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/com.s b/mach/vax4/libem/com.s new file mode 100644 index 00000000..5ce26e74 --- /dev/null +++ b/mach/vax4/libem/com.s @@ -0,0 +1,12 @@ + # $Header$ +.globl .com + + # bytes in r0 +.com: + movl (sp)+,r2 + movl sp,r1 + ashl $-2,r0,r0 +L1: + mcoml (r1),(r1)+ + sobgtr r0,L1 + jmp (r2) diff --git a/mach/vax4/libem/compmodule b/mach/vax4/libem/compmodule new file mode 100755 index 00000000..67777e8a --- /dev/null +++ b/mach/vax4/libem/compmodule @@ -0,0 +1,4 @@ +if vax4 -O -c -I../../../h -I. $1 1>&2 +then echo `basename $1 $2`.o +else exit 1 +fi diff --git a/mach/vax4/libem/csa4.s b/mach/vax4/libem/csa4.s new file mode 100644 index 00000000..293e6752 --- /dev/null +++ b/mach/vax4/libem/csa4.s @@ -0,0 +1,22 @@ +#include "em_abs.h" + + # $Header$ + +.globl .csa4 + +.csa4: + movl (sp)+,r0 # descriptor address + movl (sp)+,r1 # index + movl (r0)+,r2 # default + subl2 (r0)+,r1 + cmpl (r0)+,r1 + blssu L1 + movl (r0)[r1],r1 + bneq L2 +L1: + movl r2,r1 + bneq L2 + pushl $ECASE + jmp .fat +L2: + jmp (r1) diff --git a/mach/vax4/libem/csb4.s b/mach/vax4/libem/csb4.s new file mode 100644 index 00000000..eb49a7c8 --- /dev/null +++ b/mach/vax4/libem/csb4.s @@ -0,0 +1,30 @@ +#include "em_abs.h" + + # $Header$ + +.globl .csb4 + +.csb4: + movl (sp)+,r0 # descriptor address + movl (sp)+,r1 # index + pushl r4 # Save r4 + movl (r0)+,r4 # default + movl (r0)+,r2 # number of cases +L1: + decl r2 + blss L2 + movl (r0)+,r3 + cmpl r1,r3 + beql Lfound + tstl (r0)+ # useless address + brb L1 +Lfound: + movl (r0)+,r4 +L2: + movl r4,r0 + beql a3 + movl (sp)+,r4 # Restore r4 + jmp (r0) +a3: + pushl $ECASE + jmp .fat diff --git a/mach/vax4/libem/csx.s b/mach/vax4/libem/csx.s new file mode 100644 index 00000000..1a6266a5 --- /dev/null +++ b/mach/vax4/libem/csx.s @@ -0,0 +1,21 @@ +#include "em_abs.h" + + # $Header$ + +.globl .csa + +.csa: + cmpl r0,$4 + bneq Lillins + jmp .csa4 + +.globl .csb + +.csb: + cmpl r0,$4 + bneq Lillins + jmp .csb4 + +Lillins: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/cuf.s b/mach/vax4/libem/cuf.s new file mode 100644 index 00000000..d04bd0d8 --- /dev/null +++ b/mach/vax4/libem/cuf.s @@ -0,0 +1,34 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cuf + +.cuf: + movl (sp)+,r2 + movl (sp)+,r0 + movl (sp)+,r1 + cmpl r1,$4 + bneq Lerr + cmpl r0,$4 + bneq Ldld + cvtlf (sp)+,-(sp) + bgeq Lout + addf2 Ltwo32f,(sp) +Lout: + jmp (r2) +Ldld: + cmpl r0,$8 + bneq Lerr + cvtld (sp)+,-(sp) + bgeq Lout + addd2 Ltwo32F,(sp) + jmp (r2) +Lerr: + pushl $EILLINS + jmp .fat +.data +Ltwo32f: + .float 0f4294967296.0 +Ltwo32F: + .double 0f4294967296.0 diff --git a/mach/vax4/libem/cui.s b/mach/vax4/libem/cui.s new file mode 100644 index 00000000..8d2f35f0 --- /dev/null +++ b/mach/vax4/libem/cui.s @@ -0,0 +1,25 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cui + +.cui: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 + cmpl r0,$4 + bneq Lerr + tstl (sp) + bgeq L1 + jbr Liovfl +L1: + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat +Liovfl: + pushl $EIOVFL + jmp .trp diff --git a/mach/vax4/libem/cuu.s b/mach/vax4/libem/cuu.s new file mode 100644 index 00000000..14931e22 --- /dev/null +++ b/mach/vax4/libem/cuu.s @@ -0,0 +1,25 @@ +#include "em_abs.h" + + # $Header$ + +.globl .cuu + +.cuu: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl (sp),$1 + beql Lfrom1 + cmpl (sp),$2 + beql Lfrom2 + cmpl (sp)+, $4 + bneq Lerr + jmp (r1) +Lfrom1: + movzbw 4(sp), 4(sp) +Lfrom2: + tstl (sp)+ + movzwl (sp), (sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/dus.s b/mach/vax4/libem/dus.s new file mode 100644 index 00000000..17b99114 --- /dev/null +++ b/mach/vax4/libem/dus.s @@ -0,0 +1,16 @@ +#include "em_abs.h" + + # $Header$ + +.globl .dus + +.dus: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 + pushl r1 + jmp .dup +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/dvf.s b/mach/vax4/libem/dvf.s new file mode 100644 index 00000000..da3a65b1 --- /dev/null +++ b/mach/vax4/libem/dvf.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .dvf + +.dvf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + divf2 (sp)+,(sp) + jmp (r1) +L1: + cmpl r0,$8 + bneq L2 + divd2 (sp)+,(sp) + jmp (r1) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/dvi.s b/mach/vax4/libem/dvi.s new file mode 100644 index 00000000..ab92213d --- /dev/null +++ b/mach/vax4/libem/dvi.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .dvi + +.dvi: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + divl2 (sp)+,(sp) + jmp (r1) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/dvu.s b/mach/vax4/libem/dvu.s new file mode 100644 index 00000000..7e8555d2 --- /dev/null +++ b/mach/vax4/libem/dvu.s @@ -0,0 +1,13 @@ +#include "em_abs.h" + + # $Header$ + +.globl .dvu + +.dvu: + cmpl r0,$4 + bneq Lerr + jmp .dvu4 +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/dvu4.s b/mach/vax4/libem/dvu4.s new file mode 100644 index 00000000..000d4467 --- /dev/null +++ b/mach/vax4/libem/dvu4.s @@ -0,0 +1,22 @@ +#include "em_abs.h" + + # $Header$ + +.globl .dvu4 + +.dvu4: + movl (sp)+,r3 + movl (sp)+,r2 + blss L1 + movl (sp)+,r0 + clrl r1 + ediv r2,r0,r0,r1 + jmp (r3) +L1: + cmpl (sp)+,r2 + bgequ L2 + clrl r0 + jmp (r3) +L2: + movl $1,r0 + jmp (r3) diff --git a/mach/vax4/libem/exg.s b/mach/vax4/libem/exg.s new file mode 100644 index 00000000..b3160641 --- /dev/null +++ b/mach/vax4/libem/exg.s @@ -0,0 +1,18 @@ + # $Header$ +.globl .exg + + # bytes in r0 +.exg: + movl (sp)+,r3 + addl3 sp,r0,r2 + addl2 r0,r2 + ashl $-2,r0,r1 +L1: + movl -(r2),-(sp) + sobgtr r1,L1 + addl3 r0,r2,r1 +L2: + movw -(r2),-(r1) + sobgtr r0,L2 + movl r1,sp + jmp (r3) diff --git a/mach/vax4/libem/fat.s b/mach/vax4/libem/fat.s new file mode 100644 index 00000000..9ab4a93c --- /dev/null +++ b/mach/vax4/libem/fat.s @@ -0,0 +1,15 @@ + # $Header$ +.globl .fat + +.fat: + pushl (sp) + jsb .trp + movl $L1,ap + movl (sp)+,6(ap) + chmk (ap)+ + halt + + .data +L1: .word 1 + .long 1 + .long 0 diff --git a/mach/vax4/libem/fef.s b/mach/vax4/libem/fef.s new file mode 100644 index 00000000..59daf154 --- /dev/null +++ b/mach/vax4/libem/fef.s @@ -0,0 +1,29 @@ +#include "em_abs.h" + + # $Header$ + +.globl .fef + +.fef: + movl (sp)+,r3 + cmpl r0,$4 + bneq L1 + movf (sp)+,r0 + jsb Lhulp + movf r0,-(sp) + jmp (r3) +L1: + cmpl r0,$8 + bneq L2 + movd (sp)+,r0 + jsb Lhulp + movd r0,-(sp) + jmp (r3) +L2: + pushl $EILLINS + jmp .fat +Lhulp: + extzv $7,$8,r0,r2 + subl3 $128,r2,-(sp) + insv $128,$7,$8,r0 + rsb diff --git a/mach/vax4/libem/fif.s b/mach/vax4/libem/fif.s new file mode 100644 index 00000000..d1c3f1f9 --- /dev/null +++ b/mach/vax4/libem/fif.s @@ -0,0 +1,24 @@ +#include "em_abs.h" + + # $Header$ + +.globl .fif + +.fif: + movl (sp)+,r2 + cmpl r0,$4 + bneq L1 + mulf3 (sp)+,(sp)+,r0 + emodf r0,$0,$0f1.0,r1,-(sp) + subf3 (sp),r0,-(sp) + jmp (r2) +L1: + cmpl r0,$8 + bneq L2 + muld3 (sp)+,(sp)+,r0 + emodd r0,$0,$0f1.0,r0,-(sp) + subd3 (sp),r0,-(sp) + jmp (r2) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/gto.s b/mach/vax4/libem/gto.s new file mode 100644 index 00000000..85cd56fe --- /dev/null +++ b/mach/vax4/libem/gto.s @@ -0,0 +1,16 @@ + # $Header$ + +.globl .strlb +.globl .gto + # Nonlocal goto. + # On the stack is a pointer to a block containing : + # 1. the new local base (ptr+8) + # 2. the new stack pointer (ptr+4) + # 3. the new program counter (ptr) +.gto: + movl (sp)+,r2 + movl 4(r2),sp # Store new stack pointer + pushl (r2) # Push target address + pushl 8(r2) # Push new local base + jsb .strlb # Store in fp, compute ap + rsb diff --git a/mach/vax4/libem/head_em.s b/mach/vax4/libem/head_em.s new file mode 100644 index 00000000..2124e04b --- /dev/null +++ b/mach/vax4/libem/head_em.s @@ -0,0 +1,93 @@ +#include "system.h" +#include "em_abs.h" +#ifdef BSD42 +#include "/usr/include/syscall.h" +#endif BSD42 + + # $Header$ + +.globl hol0 +.globl .reghp +.globl .trppc +.globl .trpim + + # run time startoff + .word 0 + bispsw $0100 # set FU(0100) + movl 4(sp),r0 + clrl -4(r0) + movl sp,r0 + movl (r0)+,r1 + movl r0,r2 +a1: + tstl (r0)+ + bneq a1 + cmpl r0,(r2) + blssu a2 + tstl -(r0) +a2: + pushl r0 + pushl r2 + pushl r1 + movl $m1,ap + chmk (ap)+ # catch floating point exception + calls $3,_m_a_i_n + movl $m2,ap + movl r0,6(ap) + chmk (ap)+ + halt + + .align 1 +sig8: + .word 0x0000 + pushl 8(ap) + movl (sp)+,ap + pushl tab [ap] + jsb .trp + movl $m1,ap + chmk (ap)+ + ret + + .data +#ifdef BSD42 +m1: + .word SYS_sigvec + .long 3 + .long 8 + .long m1a + .long 0 +m1a: + .long sig8 + .long 0 + .long 0 +#else BSD42 +m1: + .word 48 + .long 2 + .long 8 + .long sig8 +#endif BSD42 +m2: + .word 1 + .long 1 + .long 0 +.reghp: + .long _end +hol0: + .space 8 +.trppc: + .space 4 +.trpim: + .long 0 +tab: + .long 0 + .long EIOVFL + .long EIDIVZ + .long EFOVFL + .long EFDIVZ + .long EFUNFL + .long EILLINS + .long EARRAY + .long EFOVFL + .long EFDIVZ + .long EFUNFL diff --git a/mach/vax4/libem/inn.s b/mach/vax4/libem/inn.s new file mode 100644 index 00000000..c72be1a6 --- /dev/null +++ b/mach/vax4/libem/inn.s @@ -0,0 +1,18 @@ + # $Header$ +.globl .inn + + # bytes in r0 +.inn: + movl (sp)+,r3 + movl (sp)+,r1 + ashl $3,r0,r2 # nr of bits in r2 + cmpl r1,r2 + bgequ L2 + bbc r1,(sp),L2 + movl $1,r1 +L1: + addl2 r0,sp + jmp (r3) +L2: + clrl r1 + brb L1 diff --git a/mach/vax4/libem/ior.s b/mach/vax4/libem/ior.s new file mode 100644 index 00000000..55968dce --- /dev/null +++ b/mach/vax4/libem/ior.s @@ -0,0 +1,12 @@ + # $Header$ +.globl .ior + + # bytes in r0 +.ior: + movl (sp)+,r2 + addl3 r0,sp,r1 + ashl $-2,r0,r0 +L1: + bisl2 (sp)+,(r1)+ + sobgtr r0,L1 + jmp (r2) diff --git a/mach/vax4/libem/lar4.s b/mach/vax4/libem/lar4.s new file mode 100644 index 00000000..69ce4093 --- /dev/null +++ b/mach/vax4/libem/lar4.s @@ -0,0 +1,26 @@ + # $Header$ +.globl .lar4 + +.lar4: + movl (sp)+,r2 + movl (sp)+,r0 + movl 8(r0),r1 + subl2 (r0),(sp) + mull3 (sp)+,r1,r0 + addl2 (sp)+,r0 + addl2 r1,r0 + cmpl r1,$1 + bgtr L3 + movzbl -(r0),-(sp) + jmp (r2) +L3: + cmpl r1,$2 + bgtr L2 + movzwl -(r0),-(sp) + jmp (r2) +L2: + ashl $-2,r1,r1 +L1: + movl -(r0),-(sp) + sobgtr r1,L1 + jmp (r2) diff --git a/mach/vax4/libem/los.s b/mach/vax4/libem/los.s new file mode 100644 index 00000000..fa0a4330 --- /dev/null +++ b/mach/vax4/libem/los.s @@ -0,0 +1,31 @@ +#include "em_abs.h" + + # $Header$ + +.globl .los + +.los: + movl (sp)+,r2 + cmpl r0,$4 + beql L1 + pushl $EILLINS + jmp .fat +L1: + movl (sp)+,r0 # nbytes in r0 + movl (sp)+,r1 # address in r1 + cmpl r0,$1 + beql L2 + cmpl r0,$2 + beql L3 + addl2 r0,r1 + ashl $-2,r0,r0 +L4: + movl -(r1),-(sp) + sobgtr r0,L4 + jmp (r2) +L2: + cvtbl (r1),-(sp) + jmp (r2) +L3: + cvtwl (r1),-(sp) + jmp (r2) diff --git a/mach/vax4/libem/lpb.s b/mach/vax4/libem/lpb.s new file mode 100644 index 00000000..4150bb4a --- /dev/null +++ b/mach/vax4/libem/lpb.s @@ -0,0 +1,18 @@ + # $Header$ +.globl .lpb + +.lpb: + cmpl r0,fp + bneq L1 + moval 4(ap),r0 + rsb +L1: + movl fp,r1 +L2: + cmpl 12(r1),r0 + beql L3 + movl 12(r1),r1 + jbr L2 +L3: + addl3 $4,8(r1),r0 # Argument Base = ap + 4 + rsb diff --git a/mach/vax4/libem/lxa.s b/mach/vax4/libem/lxa.s new file mode 100644 index 00000000..537c2878 --- /dev/null +++ b/mach/vax4/libem/lxa.s @@ -0,0 +1,7 @@ + # $Header$ +.globl .lxa + +.lxa: + jsb .lxl # Find local base + jsb .lpb # Convert to argument base + rsb diff --git a/mach/vax4/libem/lxl.s b/mach/vax4/libem/lxl.s new file mode 100644 index 00000000..e42adfdc --- /dev/null +++ b/mach/vax4/libem/lxl.s @@ -0,0 +1,14 @@ + # $Header$ +.globl .lxl + + # nlevels in r0 (>=2) +.lxl: + pushl r0 + decl (sp) + movl 4(ap),r0 +L1: + jsb .lpb + movl (r0),r0 + sobgtr (sp),L1 + tstl (sp)+ + rsb diff --git a/mach/vax4/libem/mlf.s b/mach/vax4/libem/mlf.s new file mode 100644 index 00000000..e6061960 --- /dev/null +++ b/mach/vax4/libem/mlf.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .mlf + +.mlf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + mulf2 (sp)+,(sp) + jmp (r1) +L1: + cmpl r0,$8 + bneq L2 + muld2 (sp)+,(sp) + jmp (r1) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/mli.s b/mach/vax4/libem/mli.s new file mode 100644 index 00000000..cf03e0e9 --- /dev/null +++ b/mach/vax4/libem/mli.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .mli + +.mli: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + mull2 (sp)+,(sp) + jmp (r1) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/mon.s b/mach/vax4/libem/mon.s new file mode 100644 index 00000000..01e8c5b8 --- /dev/null +++ b/mach/vax4/libem/mon.s @@ -0,0 +1,354 @@ +#include "system.h" +#include "em_abs.h" +#define MOVL movl (sp)+,(ap)+ +#define MOVQ movq (sp)+,(ap)+ + + # $Header$ + +.set sigvec,108 + +.globl .mon + +.mon: + movl (sp)+,r2 # return address in r2 + movl (sp)+,r0 # monitor call in r0 + movl ap,r3 + movl $args,ap + cvtlw r0,(ap)+ + cmpl r0,$61 + jgtru Lbadmon + ashl $2,r0,r0 + jmp *L0(r0) +.data +.align 2 +L0: +#ifndef BSD41a +.long Lbadmon, Lexit, Lfork, Lread, Lwrite +.long Lopen, Lclose, Lwait, Lcreat, Llink +.long Lunlink, Lbadmon, Lchdir, Lbadmon, Lbadmon +.long Lchmod, Lchown, Lbadmon, Lstat, Llseek +.long Lgetpid, Lbadmon, Lbadmon, Lbadmon, Lgetuid +.long Lbadmon, Lptrace, Lalarm, Lfstat, Lpause +.long Lutime, Lbadmon, Lbadmon, Laccess, Lnice +.long Lbadmon, Lsync, Lkill, Lbadmon, Lbadmon +.long Lbadmon, Ldup, Lpipe, Lbadmon, Lprofil +.long Lbadmon, Lbadmon, Lgetgid, Lsigtrp, Lbadmon +.long Lbadmon, Lacct, Lbadmon, Lbadmon, Lioctl +.long Lbadmon, Lbadmon, Lbadmon, Lbadmon, Lexece +.long Lumask, Lchroot +#else +.long Lbadmon, Lexit, Lfork, Lread, Lwrite +.long Lopen, Lclose, Lwait, Lcreat, Llink +.long Lunlink, Lbadmon, Lchdir, Lbadmon, Lmknod +.long Lchmod, Lchown, Lbadmon, Lstat, Llseek +.long Lgetpid, Lmount, Lumount, Lsetuid, Lgetuid +.long Lstime, Lptrace, Lalarm, Lfstat, Lpause +.long Lutime, Lbadmon, Lbadmon, Laccess, Lnice +.long Lftime, Lsync, Lkill, Lbadmon, Lbadmon +.long Lbadmon, Ldup, Lpipe, Ltimes, Lprofil +.long Lbadmon, Lsetgid, Lgetgid, Lsigtrp, Lbadmon +.long Lbadmon, Lacct, Lbadmon, Llock, Lioctl +.long Lbadmon, Lmpxall, Lbadmon, Lbadmon, Lexece +.long Lumask, Lchroot +#endif +.text + + # Each system call first stores its number of arguments, then the + # arguments themselves. + # The system calls are grouped according to their number of arguments + # and their results. + # Le*: an errornumber is expected + # L*r0*: the value of r0 is expected + # L*r1*: the value of r1 is expected + # Lnores: no results expected + + # 0 arguments. +Lsync: +Lpause: + clrl (ap)+ +Lnores: + jsb Lsyscall + movl r3,ap + jmp (r2) +Lgetpid: + clrl (ap)+ +Lr0: + jsb Lsyscall + pushl r0 + movl r3,ap + jmp (r2) +Lgetuid: +Lgetgid: + clrl (ap)+ +Lr0r1: + jsb Lsyscall + pushl r0 + pushl r1 + movl r3,ap + jmp (r2) +Lpipe: +Lwait: +Lfork: + clrl (ap)+ +Ler0r1: + jsb Lsyscall + pushl r0 + pushl r1 + clrl -(sp) + movl r3,ap + jmp (r2) + + # 1 argument. +Lexit: +Ltimes: + cvtbl $1,(ap)+ + MOVL + jbr Lnores +Lclose: +Lunlink: +Lchdir: +Lumount: +Lsetuid: +Lstime: +Lnice: +Lftime: +Lsetgid: +Lacct: +Llock: +Lchroot: + cvtbl $1,(ap)+ + MOVL +Le: + jsb Lsyscall + clrl -(sp) + movl r3,ap + jmp (r2) +Lalarm: +Lumask: + cvtbl $1,(ap)+ + MOVL + jbr Lr0 + + # 2 arguments. +Llink: +Lchmod: +Lstat: +Lfstat: +Lutime: +Laccess: +Lkill: +Lmpxall: + cvtbl $2,(ap)+ + MOVQ + jbr Le +Ldup: + cvtbl $2,(ap)+ + MOVQ +Ler0: + jsb Lsyscall + pushl r0 + clrl -(sp) + movl r3,ap + jmp (r2) + + # 3 arguments. +Lioctl: +Lexece: +Lmknod: +Lchown: +Lmount: + cvtbl $3,(ap)+ + MOVL + MOVQ + jbr Le +Llseek: +Lread: +Lwrite: + cvtbl $3,(ap)+ + MOVL + MOVQ + jbr Ler0 + + # 4 arguments. +Lprofil: + cvtbl $4,(ap)+ + MOVQ + MOVQ + jbr Lnores +Lptrace: + cvtbl $4,(ap)+ + MOVQ + MOVQ + jbr Ler0 + +Lopen: +#ifndef BSD41a + # The old open(name, mode) system call is simulated by + # open(name, mode, 0). + cvtbl $3,(ap)+ +#else + cvtbl $2,(ap)+ +#endif + MOVQ +#ifndef BSD41a + clrl (ap)+ +#endif + jbr Ler0 +Lcreat: +#ifndef BSD41a + # The old creat(name, mode) system call is simulated by + # open(name, O_WRONLY | O_CREAT | O_TRUNC, mode). + cvtbl $5,-2(ap) + cvtbl $3,(ap)+ +#else + cvtbl $2,(ap)+ +#endif + MOVL +#ifndef BSD41a + movl $0x601,(ap)+ +#endif + MOVL + jbr Ler0 + +Lsyscall: + movl $args,ap + chmk (ap)+ + bcc L1 + cvtwl r0,(sp) # Push the error returned twice, + cvtwl r0,-(sp) # overwrite the return address + movl r3,ap + jmp (r2) +L1: + rsb +Lbadmon: + pushl $EBADMON + jmp .fat +Lsigtrp: + movl 4(sp),r1 # Sig in r1 + movl (sp)+,(sp) # Trapno on top of stack + cmpl r1,$16 + bgtru badsig + tstl r1 + beql badsig +#ifdef BSD42 + movl $3,(ap)+ # sigvec(sig, vec, ovec) +#else BSD42 + movl $2,(ap)+ # signal(sig, func) +#endif BSD42 + movl r1,(ap)+ + movl sigadr0 [r1],r0 + tstl (sp) + blss L2 + cmpl (sp),$252 + bgtr badtrp + movl r0,(ap)+ + brb sys +L2: cmpl $-3,(sp) + bneq L3 + movl $1,(ap)+ # SIG_IGN + brb sys +L3: cmpl $-2,(sp) + bneq badtrp + clrl (ap)+ # SIG_DFL +sys: +#ifdef BSD42 + movl -(ap),vec # vec->sv_handler = func + movl $vec,(ap)+ + movl $ovec,(ap)+ # Not used. +#endif BSD42 + pushl sigtrp0 [r1] + movl 4(sp),sigtrp0 [r1] + movl (sp)+,(sp) # Old trap number on top of stack. + movl $args,ap +#ifdef BSD42 + movw $sigvec,(ap) +#endif + chmk (ap)+ + bcc L4 + movl (sp),sigtrp0 [r1] # Error, reset old trap number. + pushl r0 + movl r3,ap + jmp (r2) +L4: clrl -(sp) + movl r3,ap + jmp (r2) +badsig: + movl $-1,(sp) + pushl (sp) + movl r3,ap + jmp (r2) +badtrp: + movl sigtrp0 [r1],(sp) + pushl $-1 + movl r3,ap + jmp (r2) + +sigs: + .word 0x0000 + # Routine to catch signals. + pushl fp + movl 12(fp),fp + movl 12(fp),fp # Restore local base, two levels! + movl 4(ap),ap + pushl sigtrp0 [ap] + jsb .trp + movl (sp)+,fp + ret + +.data +#ifdef BSD42 +vec: + .long 0 # sv_handler + .long 0 # sv_mask + .long 0 # sv_onstack +ovec: + .long 0 # sv_onstack + .long 0 # sv_mask + .long 0 # sv_onstack +#endif BSD42 +args: + .word 0 + .long 0 + .long 0 + .long 0 + .long 0 + .long 0 + .long 0 + +sigadr0: + .long 0 #0 + .long sigs #1 + .long sigs #2 + .long sigs #3 + .long sigs #4 + .long sigs #5 + .long sigs #6 + .long sigs #7 + .long sigs #8 + .long sigs #9 + .long sigs #10 + .long sigs #11 + .long sigs #12 + .long sigs #13 + .long sigs #14 + .long sigs #15 + .long sigs #16 + +sigtrp0: + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 + .long -2 diff --git a/mach/vax4/libem/ngf.s b/mach/vax4/libem/ngf.s new file mode 100644 index 00000000..667a096b --- /dev/null +++ b/mach/vax4/libem/ngf.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .ngf + +.ngf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + mnegf (sp),(sp) + jmp (r1) +L1: + cmpl r0,$8 + bneq L2 + mnegd (sp),(sp) + jmp (r1) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/ngi.s b/mach/vax4/libem/ngi.s new file mode 100644 index 00000000..271e6363 --- /dev/null +++ b/mach/vax4/libem/ngi.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .ngi + +.ngi: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + mnegl (sp),(sp) + jmp (r1) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/nop.s b/mach/vax4/libem/nop.s new file mode 100644 index 00000000..2e7cb6d4 --- /dev/null +++ b/mach/vax4/libem/nop.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .nop + +.nop: + movl hol0+LINO_AD,r0 + jsb printd + movb $011,r0 + jsb printc + movl sp,r0 + jsb printd + movb $012,r0 + jmp printc diff --git a/mach/vax4/libem/print.s b/mach/vax4/libem/print.s new file mode 100644 index 00000000..3f6d56be --- /dev/null +++ b/mach/vax4/libem/print.s @@ -0,0 +1,29 @@ + # $Header$ +.globl printd +.globl printc + +printd: + clrl r1 + ediv $10,r0,r0,r1 + beql L1 + pushl r1 + jsb printd + movl (sp)+,r1 +L1: + addb3 $'0,r1,r0 + +printc: + movb r0,Lch + movl ap,r2 + movl $L9,ap + chmk $4 + movl r2,ap + rsb + + .data +L9: + .long 3 + .long 2 + .long Lch + .long 1 +Lch: .word 0 diff --git a/mach/vax4/libem/rck.s b/mach/vax4/libem/rck.s new file mode 100644 index 00000000..dc39d4df --- /dev/null +++ b/mach/vax4/libem/rck.s @@ -0,0 +1,13 @@ +#include "em_abs.h" + + # $Header$ + +.globl .rck + +.rck: + cmpl r0,$4 + bneq Lerr + jmp .rck4 +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/rck4.s b/mach/vax4/libem/rck4.s new file mode 100644 index 00000000..93305fa6 --- /dev/null +++ b/mach/vax4/libem/rck4.s @@ -0,0 +1,18 @@ +#include "em_abs.h" + + # $Header$ + +.globl .rck4 + +.rck4: + movl (sp)+,r1 + movl (sp)+,r0 + cmpl (sp),(r0) # compare lower bound + blss Lerr + cmpl (sp),4(r0) # compare upper bound + bgtr Lerr + jmp (r1) +Lerr: + pushl r1 + pushl $ERANGE + jmp .trp diff --git a/mach/vax4/libem/rmi.s b/mach/vax4/libem/rmi.s new file mode 100644 index 00000000..66fa4569 --- /dev/null +++ b/mach/vax4/libem/rmi.s @@ -0,0 +1,19 @@ +#include "em_abs.h" + + # $Header$ + +.globl .rmi + +.rmi: + movl (sp)+,r3 + cmpl r0,$4 + bneq L1 + movl (sp)+,r2 + movl (sp)+,r1 + ashq $-32,r0,r0 + ediv r2,r0,r1,r0 + pushl r0 + jmp (r3) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/rmu.s b/mach/vax4/libem/rmu.s new file mode 100644 index 00000000..3054f87e --- /dev/null +++ b/mach/vax4/libem/rmu.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .rmu + +.rmu: + cmpl r0,$4 + bneq Lerr + jsb .rmu4 + pushl r0 + rsb +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/rmu4.s b/mach/vax4/libem/rmu4.s new file mode 100644 index 00000000..f266f51e --- /dev/null +++ b/mach/vax4/libem/rmu4.s @@ -0,0 +1,18 @@ + # $Header$ +.globl .rmu4 + +.rmu4: + movl (sp)+,r3 + movl (sp)+,r2 + blss L1 + movl (sp)+,r0 + clrl r1 + ediv r2,r0,r1,r0 + jmp (r3) +L1: + movl (sp)+,r0 + cmpl r0,r2 + blssu L2 + subl2 r2,r0 +L2: + jmp (r3) diff --git a/mach/vax4/libem/rol.s b/mach/vax4/libem/rol.s new file mode 100644 index 00000000..ec55edcf --- /dev/null +++ b/mach/vax4/libem/rol.s @@ -0,0 +1,16 @@ +#include "em_abs.h" + + # $Header$ + +.globl .rol + +.rol: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + movl (sp)+,r0 + rotl r0,(sp),(sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/ror.s b/mach/vax4/libem/ror.s new file mode 100644 index 00000000..f8697311 --- /dev/null +++ b/mach/vax4/libem/ror.s @@ -0,0 +1,16 @@ +#include "em_abs.h" + + # $Header$ + +.globl .ror + +.ror: + movl (sp)+,r1 + cmpl r0,$4 + bneq Lerr + subl3 (sp)+,$32,r0 + rotl r0,(sp),(sp) + jmp (r1) +Lerr: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/sar4.s b/mach/vax4/libem/sar4.s new file mode 100644 index 00000000..80061e28 --- /dev/null +++ b/mach/vax4/libem/sar4.s @@ -0,0 +1,26 @@ + # $Header$ +.globl .sar4 + +.sar4: + movl (sp)+,r2 + movl (sp)+,r0 + movl 8(r0),r1 + subl2 (r0),(sp) + movl (sp)+,r0 + mull2 r1,r0 + addl2 (sp)+,r0 + cmpl r1,$1 + bgtr L3 + cvtlb (sp)+,(r0) + jmp (r2) +L3: + cmpl r1,$2 + bgtr L2 + cvtlw (sp)+,(r0) + jmp (r2) +L2: + ashl $-2,r1,r1 +L1: + movl (sp)+,(r0)+ + sobgtr r1,L1 + jmp (r2) diff --git a/mach/vax4/libem/sbf.s b/mach/vax4/libem/sbf.s new file mode 100644 index 00000000..9c317f84 --- /dev/null +++ b/mach/vax4/libem/sbf.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sbf + +.sbf: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + subf2 (sp)+,(sp) + jmp (r1) +L1: + cmpl r0,$8 + bneq L2 + subd2 (sp)+,(sp) + jmp (r1) +L2: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/sbi.s b/mach/vax4/libem/sbi.s new file mode 100644 index 00000000..acad0ea3 --- /dev/null +++ b/mach/vax4/libem/sbi.s @@ -0,0 +1,15 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sbi + +.sbi: + movl (sp)+,r1 + cmpl r0,$4 + bneq L1 + subl2 (sp)+,(sp) + jmp (r1) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/sbs.s b/mach/vax4/libem/sbs.s new file mode 100644 index 00000000..4814f1eb --- /dev/null +++ b/mach/vax4/libem/sbs.s @@ -0,0 +1,10 @@ + # $Header$ +.globl .sbs + +.sbs: + movl (sp)+,r1 + subl2 (sp)+,(sp) + movl $4,-(sp) + movl r0,-(sp) + movl r1,-(sp) + jmp .cii diff --git a/mach/vax4/libem/set.s b/mach/vax4/libem/set.s new file mode 100644 index 00000000..c1ba16af --- /dev/null +++ b/mach/vax4/libem/set.s @@ -0,0 +1,25 @@ +#include "em_abs.h" + + # $Header$ + +.globl .setx + + # bytes in r0 +.setx: + movl (sp)+,r3 + movl (sp)+,r1 # bitnumber in r1 + subl3 r0,sp,r2 +L1: + clrl -(sp) + cmpl sp,r2 + bgtru L1 + ashl $3,r0,r2 # number of bits in r2 + cmpl r1,r2 + bgequ L2 + bbcs r1,(sp),L3 +L3: + jmp (r3) +L2: + pushl $ESET + jsb .trp + jmp (r3) diff --git a/mach/vax4/libem/sig.s b/mach/vax4/libem/sig.s new file mode 100644 index 00000000..e2b58668 --- /dev/null +++ b/mach/vax4/libem/sig.s @@ -0,0 +1,9 @@ + # $Header$ +.globl .sig + +.sig: + movl (sp)+,r1 + movl (sp)+,r0 + pushl .trppc + movl r0,.trppc + jmp (r1) diff --git a/mach/vax4/libem/sim.s b/mach/vax4/libem/sim.s new file mode 100644 index 00000000..2a11a71f --- /dev/null +++ b/mach/vax4/libem/sim.s @@ -0,0 +1,12 @@ + # $Header$ +.globl .sim + +.sim: + movl (sp)+,r0 + movl (sp)+,.trpim # store ignore mask + bbc $5,.trpim,L3 # floating underflow to be ignored? + bicpsw $0100 + jmp (r0) +L3: + bispsw $0100 # enable underflow trap + jmp (r0) diff --git a/mach/vax4/libem/sli.s b/mach/vax4/libem/sli.s new file mode 100644 index 00000000..9f29a5f4 --- /dev/null +++ b/mach/vax4/libem/sli.s @@ -0,0 +1,17 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sli + +.sli: + movl (sp)+,r2 + cmpl r0,$4 + bneq L1 + movl (sp)+,r0 + movl (sp)+,r1 + ashl r0,r1,-(sp) + jmp (r2) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/sri.s b/mach/vax4/libem/sri.s new file mode 100644 index 00000000..7144701d --- /dev/null +++ b/mach/vax4/libem/sri.s @@ -0,0 +1,18 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sri + +.sri: + movl (sp)+,r2 + cmpl r0,$4 + bneq L1 + movl (sp)+,r0 + mnegl r0,r0 + movl (sp)+,r1 + ashl r0,r1,-(sp) + jmp (r2) +L1: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/sru.s b/mach/vax4/libem/sru.s new file mode 100644 index 00000000..4c7c2f2b --- /dev/null +++ b/mach/vax4/libem/sru.s @@ -0,0 +1,20 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sru + +.sru: + movl (sp)+,r3 + cmpl r0,$4 + beql .sru4 + pushl $EILLINS + jmp .fat +.sru4: + movl (sp)+,r2 + mnegl r2,r2 + movl (sp)+,r0 + clrl r1 + ashq r2,r0,r0 + movl r0,-(sp) + jmp (r3) diff --git a/mach/vax4/libem/strhp.s b/mach/vax4/libem/strhp.s new file mode 100644 index 00000000..8da69356 --- /dev/null +++ b/mach/vax4/libem/strhp.s @@ -0,0 +1,31 @@ +#include "em_abs.h" + + # $Header$ + +.globl .strhp + +.strhp: + movl (sp)+,r1 + movl (sp)+,r0 + pushl r1 + movl r0,.reghp + cmpl r0,.hplim + blssu L2 + addl2 $02000,r0 + bicl2 $0777,r0 + movl r0,.hplim + movl ap,r1 + movl $L9,ap + chmk (ap)+ + bcc L1 + pushl $EHEAP + jmp .fat +L1: + movl r1,ap +L2: + rsb + + .data +L9: .word 17 + .long 1 +.hplim: .long _end diff --git a/mach/vax4/libem/strlb.s b/mach/vax4/libem/strlb.s new file mode 100644 index 00000000..463f8bbb --- /dev/null +++ b/mach/vax4/libem/strlb.s @@ -0,0 +1,26 @@ + # $Header$ +.globl .strlb + # Store the value that is on the stack in fp. + # Compute ap. +.strlb: + movl (sp)+,r3 + movl (sp)+,fp + pushl r3 + movl $20,ap # Compute argumentbase from local base. + # Distance is 5 longwords + the number of + # registers saved. + movl $1,r3 # Now check register save mask + movl $12,r2 +L1: + bitl r3,6(fp) + beql L2 + addl2 $4,ap # Add 1 longword for each register saved +L2: + ashl $1,r3,r3 + sobgeq r2,L1 + + extzv $14,$2,6(fp),r3 # Now find out about the stack alignment + # between fp and ap + addl2 r3,ap # add alignment + addl2 fp,ap + rsb diff --git a/mach/vax4/libem/sts.s b/mach/vax4/libem/sts.s new file mode 100644 index 00000000..3219a3c8 --- /dev/null +++ b/mach/vax4/libem/sts.s @@ -0,0 +1,32 @@ +#include "em_abs.h" + + # $Header$ + +.globl .sts + +.sts: + movl (sp)+,r2 + cmpl r0,$4 + beql L1 + pushl $EILLINS + jmp .fat +L1: + movl (sp)+,r0 # number of bytes in r0 + movl (sp)+,r1 # address in r1 + cmpl r0,$1 + beql L3 + cmpl r0,$2 + beql L4 + ashl $-2,r0,r0 +L2: + movl (sp)+,(r1)+ + sobgtr r0,L2 + jmp (r2) +L3: + movl (sp)+,r0 + movb r0,(r1) + jmp (r2) +L4: + movl (sp)+,r0 + movw r0,(r1) + jmp (r2) diff --git a/mach/vax4/libem/system.h b/mach/vax4/libem/system.h new file mode 100644 index 00000000..56ac7fac --- /dev/null +++ b/mach/vax4/libem/system.h @@ -0,0 +1,4 @@ +/* $Header$ */ +/*#define BSD42 */ +/*#define BSD41c */ +#define BSD41a diff --git a/mach/vax4/libem/trp.s b/mach/vax4/libem/trp.s new file mode 100644 index 00000000..0e3a5a68 --- /dev/null +++ b/mach/vax4/libem/trp.s @@ -0,0 +1,52 @@ + # $Header$ +.globl .trp + +.trp: + pushl r0 + movl 8(sp),r0 + movl 4(sp),8(sp) + movl (sp)+,(sp) + cmpl r0,$16 + bgequ L1 # a trapnumber >= 16 cannot be ignored + bbc r0,.trpim,L1 + movl (sp)+,r0 + rsb +L1: + pushr $017776 # save registers + pushl r0 # trapnumber on stack + movl .trppc,r0 + beql L2 # is there a user defined traphandler? + clrl .trppc + calls $1,(r0) # if so, call it + popr $017776 # restore registers + movl (sp)+,r0 + rsb + +.set write,4 + +L2: + # Put the (octal) trapnumber in the zeroes in Lemes[]. + + movl $Lemesend-1,r1 # Addres after last '0'. + movl $5,r2 # Max number of digits. + movl (sp),r0 # Trap number in r0. +L3: + bicw2 $0177770,r0 # Lower 3 bits form lower octal digit. + bisb2 r0,-(r1) # Put them in the '0'. + ashl $-3,r0,r0 # Shift the 3 bits off. + sobgtr r2,L3 + movl ap,r2 + movl $Lwr,ap + chmk $write + movl r2,ap + bpt +.data +Lemes: +.byte 'E,'r,'r,' ,'0,'0,'0,'0,'0,0xa +Lemesend: +.align 2 +Lwr: +.long 3 # 3 arguments. +.long 2 # File descriptor 2. +.long Lemes # Address of character buffer. +.long Lemesend - Lemes # Number of characters to write. diff --git a/mach/vax4/libem/xar.s b/mach/vax4/libem/xar.s new file mode 100644 index 00000000..431f0462 --- /dev/null +++ b/mach/vax4/libem/xar.s @@ -0,0 +1,28 @@ +#include "em_abs.h" + + # $Header$ + +.globl .lar + +.lar: + cmpl r0,$4 + bneq Lillins + jmp .lar4 + +.globl .sar + +.sar: + cmpl r0,$4 + bneq Lillins + jmp .sar4 + +.globl .aar + +.aar: + cmpl r0,$4 + bneq Lillins + jmp .aar4 + +Lillins: + pushl $EILLINS + jmp .fat diff --git a/mach/vax4/libem/xor.s b/mach/vax4/libem/xor.s new file mode 100644 index 00000000..22c06519 --- /dev/null +++ b/mach/vax4/libem/xor.s @@ -0,0 +1,12 @@ + # $Header$ +.globl .xor + + # bytes in r0 +.xor: + movl (sp)+,r2 + addl3 r0,sp,r1 + ashl $-2,r0,r0 +L1: + xorl2 (sp)+,(r1)+ + sobgtr r0,L1 + jmp (r2) diff --git a/mach/vax4/libpc/Makefile b/mach/vax4/libpc/Makefile new file mode 100644 index 00000000..87bf4fbe --- /dev/null +++ b/mach/vax4/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/vax4/libpc/compmodule b/mach/vax4/libpc/compmodule new file mode 100755 index 00000000..491f6d25 --- /dev/null +++ b/mach/vax4/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.o diff --git a/mach/z80/Action b/mach/z80/Action new file mode 100644 index 00000000..8e96d285 --- /dev/null +++ b/mach/z80/Action @@ -0,0 +1,3 @@ +name "Z80 assembler" +dir as +end diff --git a/mach/z80/cg/Makefile b/mach/z80/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/z80/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/z80/int/Makefile b/mach/z80/int/Makefile new file mode 100644 index 00000000..139a7e29 --- /dev/null +++ b/mach/z80/int/Makefile @@ -0,0 +1,4 @@ +CFLAGS=-O + +dl: dl.o + cc -n -o dl dl.o diff --git a/mach/z80/int/READ_ME b/mach/z80/int/READ_ME new file mode 100644 index 00000000..6b2a6a43 --- /dev/null +++ b/mach/z80/int/READ_ME @@ -0,0 +1,23 @@ +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 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 diff --git a/mach/z80/int/atof.s b/mach/z80/int/atof.s new file mode 100644 index 00000000..26c0a2e2 --- /dev/null +++ b/mach/z80/int/atof.s @@ -0,0 +1,280 @@ + .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 diff --git a/mach/z80/int/cv.c b/mach/z80/int/cv.c new file mode 100644 index 00000000..03811e27 --- /dev/null +++ b/mach/z80/int/cv.c @@ -0,0 +1,34 @@ +/* + * (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 + +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 +#include +#include + +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); +} diff --git a/mach/z80/int/doas b/mach/z80/int/doas new file mode 100644 index 00000000..5d30eae6 --- /dev/null +++ b/mach/z80/int/doas @@ -0,0 +1,3 @@ +/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 diff --git a/mach/z80/int/dosort b/mach/z80/int/dosort new file mode 100755 index 00000000..dfcbf7fa --- /dev/null +++ b/mach/z80/int/dosort @@ -0,0 +1,9 @@ +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 diff --git a/mach/z80/int/dvi4.s b/mach/z80/int/dvi4.s new file mode 100644 index 00000000..cf1ccbce --- /dev/null +++ b/mach/z80/int/dvi4.s @@ -0,0 +1,74 @@ +.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 diff --git a/mach/z80/int/dvu4.s b/mach/z80/int/dvu4.s new file mode 100644 index 00000000..f0489664 --- /dev/null +++ b/mach/z80/int/dvu4.s @@ -0,0 +1,137 @@ +.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 diff --git a/mach/z80/int/eb.s b/mach/z80/int/eb.s new file mode 100644 index 00000000..875035ed --- /dev/null +++ b/mach/z80/int/eb.s @@ -0,0 +1,2 @@ + .bss +eb: diff --git a/mach/z80/int/em.s b/mach/z80/int/em.s new file mode 100644 index 00000000..4e82dd11 --- /dev/null +++ b/mach/z80/int/em.s @@ -0,0 +1,4932 @@ +# +! 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 diff --git a/mach/z80/int/fpp.s b/mach/z80/int/fpp.s new file mode 100644 index 00000000..fbec1550 --- /dev/null +++ b/mach/z80/int/fpp.s @@ -0,0 +1,474 @@ +! 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 diff --git a/mach/z80/int/mli4.s b/mach/z80/int/mli4.s new file mode 100644 index 00000000..ce7927ef --- /dev/null +++ b/mach/z80/int/mli4.s @@ -0,0 +1,75 @@ +.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 diff --git a/mach/z80/libcc/Makefile b/mach/z80/libcc/Makefile new file mode 100644 index 00000000..acc68c1b --- /dev/null +++ b/mach/z80/libcc/Makefile @@ -0,0 +1,37 @@ +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 diff --git a/mach/z80/libcc/compmodule b/mach/z80/libcc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/z80/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/z80/libpc/Makefile b/mach/z80/libpc/Makefile new file mode 100644 index 00000000..5128fcec --- /dev/null +++ b/mach/z80/libpc/Makefile @@ -0,0 +1,20 @@ +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 diff --git a/mach/z80/libpc/compmodule b/mach/z80/libpc/compmodule new file mode 100755 index 00000000..4a77cd8a --- /dev/null +++ b/mach/z80/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -DCPM -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/z8000/Action b/mach/z8000/Action new file mode 100644 index 00000000..6134c947 --- /dev/null +++ b/mach/z8000/Action @@ -0,0 +1,18 @@ +name "Zilog Z8000 assembler" +dir as +end +name "Zilog Z8000 backend" +dir cg +end +name "Zilog Z8000 C libraries" +dir libcc +end +name "Zilog Z8000 EM library" +dir libem +end +name "Zilog Z8000 Pascal library" +dir libpc +end +name "Zilog Z8000 Basic library" +dir libbc +end diff --git a/mach/z8000/cg/Makefile b/mach/z8000/cg/Makefile new file mode 100644 index 00000000..bb54f712 --- /dev/null +++ b/mach/z8000/cg/Makefile @@ -0,0 +1,185 @@ +# $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 + +distr: + make tables.c + rm -f tables1.[ch] + cp tables.c tables1.c + cp tables.h tables1.h + chmod -w tables1.[ch] + + +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 diff --git a/mach/z8000/cg/mach.c b/mach/z8000/cg/mach.c new file mode 100644 index 00000000..e6221a59 --- /dev/null +++ b/mach/z8000/cg/mach.c @@ -0,0 +1,107 @@ +/* + * (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 */ +}; diff --git a/mach/z8000/cg/mach.h b/mach/z8000/cg/mach.h new file mode 100644 index 00000000..868cb725 --- /dev/null +++ b/mach/z8000/cg/mach.h @@ -0,0 +1,24 @@ +#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 diff --git a/mach/z8000/cg/table b/mach/z8000/cg/table new file mode 100644 index 00000000..97f6aee0 --- /dev/null +++ b/mach/z8000/cg/table @@ -0,0 +1,1838 @@ +"$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. + +/* */ +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: +/* */ +/*************************************** +******** 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} | | +/* */ +/*************************************** +******** 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]} ) | | | +/* */ +/*************************************** +******** 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] | | +/* */ +/*************************************** +******** 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) +/* */ +/*************************************** +******** 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 | +/* */ +/*************************************** +******** 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 | | | +/* */ +/*************************************** +******** 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 | +/* */ +/*************************************** +******** 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] | | +/* */ +/*************************************** +******** 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) | | | +/* */ +/*************************************** +******** 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) | +/* */ +/*************************************** +******** 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] | | +/* */ +/*************************************** +******** 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] +/* */ +/*************************************** +******** 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 | +/* */ +/*************************************** +******** 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 | +/* */ +/* 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) ) diff --git a/mach/z8000/libbc/Makefile b/mach/z8000/libbc/Makefile new file mode 100644 index 00000000..ef381a1c --- /dev/null +++ b/mach/z8000/libbc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +MACHDEF="MACH=z8000" "SUF=s" +BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib" + +install: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp + +cmp: + make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail + -../../compare head_bc + -../../compare tail_bc + +clean: + -rm -f *.old *.[ce$(SUF)] tail* head* + +opr: + make pr | opr + +pr: + @pr Makefile diff --git a/mach/z8000/libbc/compmodule b/mach/z8000/libbc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/z8000/libbc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/z8000/libcc/Makefile b/mach/z8000/libcc/Makefile new file mode 100644 index 00000000..8004e86b --- /dev/null +++ b/mach/z8000/libcc/Makefile @@ -0,0 +1,37 @@ +MAKEFILE=../../proto/libg/Makefile +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 diff --git a/mach/z8000/libcc/compmodule b/mach/z8000/libcc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/z8000/libcc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/mach/z8000/libem/LIST b/mach/z8000/libem/LIST new file mode 100644 index 00000000..f7d9999d --- /dev/null +++ b/mach/z8000/libem/LIST @@ -0,0 +1,36 @@ +tail_em.s.a +aar.s +blm.s +cii.s +cmi.s +cmi4.s +cms.s +cmu.s +cmu4.s +csa.s +csb.s +cuu.s +dup.s +dvu2.s +dvu4.s +exg.s +gto.s +inn.s +lar.s +los2.s +mon.s +noop.s +prf.s +rck.s +rmu2.s +rmu4.s +sar.s +sigtrp.s +strhp.s +sts2.s +xset.s +unknown.s +trp.s +printf.s +save.s +end.s diff --git a/mach/z8000/libem/Makefile b/mach/z8000/libem/Makefile new file mode 100644 index 00000000..486aa5d7 --- /dev/null +++ b/mach/z8000/libem/Makefile @@ -0,0 +1,17 @@ + +install: + ../../install head_em.s head_em + ../../install tail_em.s.a tail_em + +cmp: + -../../compare head_em.s head_em + -../../compare tail_em.s.a tail_em + +clean: + +opr : + make pr | opr + +pr: + @pr head_em.s + @arch pv tail_em.s.a | pr -h `pwd`/tail_em.s.a diff --git a/mach/z8000/libem/aar.s b/mach/z8000/libem/aar.s new file mode 100644 index 00000000..1cf46784 --- /dev/null +++ b/mach/z8000/libem/aar.s @@ -0,0 +1,13 @@ +.define aar + +!R1 contains description address +!R3 contains element number +!base address is on stack +aar: + sub R3, 0(R1) + mult RR2, 4(R1) + inc R15, $4 + add R3, *RR14 + ld *RR14, R3 + dec R15, $4 + ret diff --git a/mach/z8000/libem/blm.s b/mach/z8000/libem/blm.s new file mode 100644 index 00000000..de643ebb --- /dev/null +++ b/mach/z8000/libem/blm.s @@ -0,0 +1,26 @@ +.define blm + +!size in R0 +blm: + popl saveret, *RR14 + ldm savereg, R4, $10 + ldk R2, $0 + ld R4, R2 + pop R3, *RR14 !RR2: dst address + pop R5, *RR14 !RR4: src address + ld R1, R0 + sra R0 + jr EQ, 2f + !now avoid wrong copy in case the pieces overlap + cp R5, R3 + jr EQ, 2f + jr LT, 1f + ldir *RR2, *RR4, R0 + jr 2f +1: dec R1, $2 + add R3, R1 + add R5, R1 + lddr *RR2, *RR4, R0 +2: ldm R4, savereg, $10 + pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/cii.s b/mach/z8000/libem/cii.s new file mode 100644 index 00000000..686f1036 --- /dev/null +++ b/mach/z8000/libem/cii.s @@ -0,0 +1,24 @@ +.define cii + +cii: + popl saveret, *RR14 + pop R2, *RR14 + pop R1, *RR14 + sub R2, R1 !expansion in bytes + jr LE, 1f + sra R2 !expansion in words > 0 + jr NC, 2f + pop R1, *RR14 !expand 1 --> 2 + extsb R1 + push *RR14, R1 + test R2 + jr EQ, 4f +2: !expand >= 1 word + ld R1, *RR14 + exts RR0 +3: push *RR14, R0 + djnz R2, 3b + jr 4f +1: sub R15, R2 +4: pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/cmi.s b/mach/z8000/libem/cmi.s new file mode 100644 index 00000000..5459aec8 --- /dev/null +++ b/mach/z8000/libem/cmi.s @@ -0,0 +1,14 @@ +.define cmi + +!size in R0 +cmi: + cp R0, $2 + jr NE, 1f + popl RR2, *RR14 + pop R1, *RR14 + pop R0, *RR14 + sub R0, R1 + jp *RR2 +1: cp R0, $4 + jr EQ, cmi4 + jr unknown diff --git a/mach/z8000/libem/cmi4.s b/mach/z8000/libem/cmi4.s new file mode 100644 index 00000000..ac3ff4e1 --- /dev/null +++ b/mach/z8000/libem/cmi4.s @@ -0,0 +1,15 @@ +.define cmi4 + +cmi4: + popl saveret, *RR14 + popl RR0, *RR14 + popl RR2, *RR14 + subl RR2, RR0 + ldk R0, $0 + ldl RR2, saveret + jr LT, 1f + jp EQ, *RR2 + inc R0 + jp *RR2 +1: dec R0 + jp *RR2 diff --git a/mach/z8000/libem/cms.s b/mach/z8000/libem/cms.s new file mode 100644 index 00000000..cfe26c4c --- /dev/null +++ b/mach/z8000/libem/cms.s @@ -0,0 +1,19 @@ +.define cms + +cms: + popl saveret, *RR14 + ldm savereg, R4, $10 + ldl RR2, RR14 + add R3, R0 + ldl RR4, RR2 + add R5, R0 + sra R0 +2: pop R1, *RR14 + cp R1, *RR2 + jr NE, 1f + inc R3, $2 + djnz R0, 2b +1: ld R15, R5 + ldm R4, savereg, $10 + pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/cmu.s b/mach/z8000/libem/cmu.s new file mode 100644 index 00000000..c3b96136 --- /dev/null +++ b/mach/z8000/libem/cmu.s @@ -0,0 +1,20 @@ +.define cmu + +!size in R0 +cmu: + cp R0, $2 + jr NE, 1f + popl RR2, *RR14 + pop R1, *RR14 + pop R0, *RR14 + cp R0, R1 + ldk R0, $0 + jr ULT, 2f + jp EQ, *RR2 + inc R0 + jp *RR2 +2: dec R0 + jp *RR2 +1: cp R0, $4 + jr EQ, cmu4 + jr unknown diff --git a/mach/z8000/libem/cmu4.s b/mach/z8000/libem/cmu4.s new file mode 100644 index 00000000..2135b2d0 --- /dev/null +++ b/mach/z8000/libem/cmu4.s @@ -0,0 +1,15 @@ +.define cmu4 + +cmu4: + popl saveret, *RR14 + popl RR0, *RR14 + popl RR2, *RR14 + cpl RR2, RR0 + ldk R0, $0 + ldl RR2, saveret + jr ULT, 1f + jp EQ, *RR2 + inc R0 + jp *RR2 +1: dec R0 + jp *RR2 diff --git a/mach/z8000/libem/csa.s b/mach/z8000/libem/csa.s new file mode 100644 index 00000000..e4fd1b96 --- /dev/null +++ b/mach/z8000/libem/csa.s @@ -0,0 +1,19 @@ +.define csa + +!R1 contains address of jump table +!R2 contains case index +csa: + sub R2, 2(R1) + jr LT, 1f + cp R2, 4(R1) + jr UGT, 1f + sla R2 + add R1, R2 + ld R2, 06(R1) + cp R2, $0 + jr EQ, 2f + jp 0(R2) +1: ld R1, 0(R1) + jp NE, 0(R1) +2: push *RR14, $ECASE + jr fatal diff --git a/mach/z8000/libem/csb.s b/mach/z8000/libem/csb.s new file mode 100644 index 00000000..de145d96 --- /dev/null +++ b/mach/z8000/libem/csb.s @@ -0,0 +1,21 @@ +.define csb + +!R1 contains address of jump table +!R2 contains case index +csb: + ld R3, 0(R1) !default pointer + ld R0, 2(R1) !number of entries + test R0 + jr EQ, 1f +3: inc R1, $4 + cp R2, 0(R1) + jr EQ, 2f + djnz R0, 3b +1: ld R1, R3 !default pointer + jr 4f +2: ld R1, 2(R1) +4: test R1 + jr EQ, 5f + jp 0(R1) +5: push *RR14, $ECASE + jr fatal diff --git a/mach/z8000/libem/cuu.s b/mach/z8000/libem/cuu.s new file mode 100644 index 00000000..7e60c5e8 --- /dev/null +++ b/mach/z8000/libem/cuu.s @@ -0,0 +1,15 @@ +.define cuu + +cuu: + popl RR2, *RR14 + pop R0, *RR14 + pop R1, *RR14 + sub R0, R1 !expansion in bytes + jr LE, 1f + sra R0 !expansion in words + jp EQ, *RR2 +2: push *RR14, $0 + djnz R0, 2b + jp *RR2 +1: sub R15, R0 + jp *RR2 diff --git a/mach/z8000/libem/dup.s b/mach/z8000/libem/dup.s new file mode 100644 index 00000000..74aa6809 --- /dev/null +++ b/mach/z8000/libem/dup.s @@ -0,0 +1,12 @@ +.define dup + +dup: + popl saveret, *RR14 + dec R15, $2 + ldl RR2, RR14 + add R3, R0 + sra R0 + lddr *RR14, *RR2, R0 + inc R15, $2 + pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/dvu2.s b/mach/z8000/libem/dvu2.s new file mode 100644 index 00000000..d1403722 --- /dev/null +++ b/mach/z8000/libem/dvu2.s @@ -0,0 +1,17 @@ +.define dvu2 + +dvu2: + popl saveret, *RR14 + pop R2, *RR14 + pop R1, *RR14 + test R2 + jr MI, 1f + ldk R0, $0 + div RR0, R2 +2: pushl *RR14, saveret + ret +1: cp R2, R1 + ldk R1, $0 + jr UGT, 2b + inc R1 + jr 2b diff --git a/mach/z8000/libem/dvu4.s b/mach/z8000/libem/dvu4.s new file mode 100644 index 00000000..d5fc9617 --- /dev/null +++ b/mach/z8000/libem/dvu4.s @@ -0,0 +1,19 @@ +.define dvu4 + +dvu4: + popl saveret, *RR14 + ldm savereg, R4, $10 + popl RR4, *RR14 + popl RR2, *RR14 + testl RR4 + jr MI, 1f + ldl RR0, $0 + divl RQ0, RR4 + jr 2f +1: cpl RR4, RR2 + ldl RR2, $0 + jr UGT, 2f + inc R3 +2: ldm R4, savereg, $10 + pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/end.s b/mach/z8000/libem/end.s new file mode 100644 index 00000000..019432cc --- /dev/null +++ b/mach/z8000/libem/end.s @@ -0,0 +1,14 @@ +.define endtext, enddata, endbss, _etext, _edata, _end + + .text + .align 2 +endtext: +_etext: + .data + .align 2 +enddata: +_edata: + .bss + .align 2 +endbss: +_end: diff --git a/mach/z8000/libem/exg.s b/mach/z8000/libem/exg.s new file mode 100644 index 00000000..79061cc2 --- /dev/null +++ b/mach/z8000/libem/exg.s @@ -0,0 +1,18 @@ +.define exg + +!size (bytes) in R0 +exg: + ldm savereg, R4, $10 + ldl RR2, RR14 + inc R3, $2 + ldl RR4, RR2 + add R5, R0 + sra R0 +1: ld R1, *RR2 + ex R1, *RR4 + ld *RR4, R1 + inc R3, $2 + inc R5, $2 + djnz R0, 1b + ldm R4, savereg, $10 + ret diff --git a/mach/z8000/libem/gto.s b/mach/z8000/libem/gto.s new file mode 100644 index 00000000..4c78b235 --- /dev/null +++ b/mach/z8000/libem/gto.s @@ -0,0 +1,8 @@ +.define gto + +gto: + pop R3, *RR14 + ld R13, 4(R3) + ld R15, 2(R3) + ld R3, 0(R3) + jp 0(R3) diff --git a/mach/z8000/libem/head_em.s b/mach/z8000/libem/head_em.s new file mode 100644 index 00000000..202fcbcb --- /dev/null +++ b/mach/z8000/libem/head_em.s @@ -0,0 +1,57 @@ +.define EXIT, F_DUM +.define ERANGE, ESET, EHEAP, EILLINS, EODDZ, ECASE, EBADMON +.define hol0, trppc, trpim, reghp, argv, envp + +EXIT = 0 +F_DUM = 0 + +ERANGE = 1 +ESET = 2 +EHEAP = 17 +EILLINS = 18 +EODDZ = 19 +ECASE = 20 +EBADMON = 25 + +.text + !clear .bss + ldk R2, $0 + ld R3, $endbss + ld R0, R3 + sub R0, $begbss + jr EQ, 1f + sra R0 + push *RR2, $0 + dec R0 + jr EQ, 1f + ldl RR4, RR2 + dec R5, $2 + lddr *RR4, *RR2, R0 +1: + ldb RL0, $10 ! echo newline + sc $4 + ldl RR14, $0 + push *RR14, envp + push *RR14, argv + push *RR14, $1 + calr _m_a_i_n + ldl RR14, $0xC00017FC + sc $0 + +.bss +begbss: +.data +hol0: + .word 0,0 ! line no + .word 0,0 ! file +trppc: + .word 0 +trpim: + .word 0 +argv: +envp: + .word 1f + .word 0 +1: .asciz "program" +reghp: + .word endbss diff --git a/mach/z8000/libem/inn.s b/mach/z8000/libem/inn.s new file mode 100644 index 00000000..ba8ac0f4 --- /dev/null +++ b/mach/z8000/libem/inn.s @@ -0,0 +1,23 @@ +.define inn + +!bitnr in R1 +!size (bytes) in R2 +inn: + ld R3, R2 + sra R2 + ldk R0, $0 + div RR0, $020 !R0: bitnr, R1: wordnr + cp R1, R2 + jr UGE, 1f !R1 must be < R2 + inc R1, $2 !R1 contains nr of words from top stack + sla R1 + ld R1, RR14(R1) + bit R1, R0 + jr EQ, 1f + ldk R0, $1 + jr 2f +1: ldk R0, $0 +2: ld R1, R3 + popl RR2, *RR14 + add R15, R1 + jp *RR2 diff --git a/mach/z8000/libem/lar.s b/mach/z8000/libem/lar.s new file mode 100644 index 00000000..bf82bbb6 --- /dev/null +++ b/mach/z8000/libem/lar.s @@ -0,0 +1,23 @@ +.define lar + +!R1 contains description address +!R3 contains element number +!base address is on stack +lar: + popl saveret, *RR14 + sub R3, 0(R1) + ld R0, 4(R1) !nr of bytes per element + mult RR2, R0 + add R3, *RR14 + add R3, R0 + sra R0 !nr of words per element + jr EQ, 1f + dec R3, $2 + lddr *RR14, *RR2, R0 + inc R15, $2 + jr 2f +1: ldb RL2, -1(R3) + ldb RH2, $0 + ld *RR14, R2 +2: ldl RR2, saveret + jp *RR2 diff --git a/mach/z8000/libem/los2.s b/mach/z8000/libem/los2.s new file mode 100644 index 00000000..a6b9d3e6 --- /dev/null +++ b/mach/z8000/libem/los2.s @@ -0,0 +1,20 @@ +.define los2 + +los2: + popl saveret, *RR14 + pop R0, *RR14 !object size + ldk R2, $0 + pop R3, *RR14 !address of object + cp R0, $1 + jr NE, 1f + ldb RL0, *RR2 + push *RR14, R0 + jr 2f +1: add R3, R0 + dec R3, $2 + dec R15, $2 + sra R0 + lddr *RR14, *RR2, R0 + inc R15, $2 +2: pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/mon.s b/mach/z8000/libem/mon.s new file mode 100644 index 00000000..3d971be1 --- /dev/null +++ b/mach/z8000/libem/mon.s @@ -0,0 +1,83 @@ +.define mon + +mon: + popl saveret, *RR14 + pop R0, *RR14 ! iocode + cp R0, $1 ! exit + jr NE, read + inc R15, $2 + sc $EXIT +read: cp R0, $3 ! read + jr NE, write + pop R0, *RR14 ! dummy; all input from stdin + pop R1, *RR14 ! ptr to buffer + pop R2, *RR14 ! nr of bytes to be read + ld R3, R1 + cp R2, $0 + jr EQ, 6f +1: sc $2 ! read character into RL0 + cpb RL0, $004 ! \^D + jr EQ, 6f + cpb RL0, $015 ! \cr + jr NE, 2f + ldb RL0, $012 +2: sc $4 ! echo + cpb RL0, $010 ! \^H + jr NE, 3f + cp R1, R3 + jr EQ, 5f + dec R1 + jr 5f +3: cpb RL0, $0100 ! \@ + jr NE, 4f + ld R1, R3 + ldb RL0, $012 + sc $4 + jr 5f +4: ldb 0(R1), RL0 + inc R1 + cpb RL0, $012 ! \nl + jr EQ, 6f +5: djnz R2, 1b +6: sub R1, R3 ! nr of bytes read + push *RR14, R1 + push *RR14, $0 + jr retu +write: cp R0, $4 ! write + jr NE, open + pop R0, *RR14 ! dummy; all output to stdout + pop R1, *RR14 ! ptr to buffer + pop R2, *RR14 ! nr of bytes to be written + ld R3, R2 + cp R2, $0 + jr EQ, 8f +9: ld R0, $5000 ! counter to delay printing a little +7: djnz R0, 7b + ldb RL0, 0(R1) + sc $4 + inc R1 + djnz R2, 9b +8: sub R3, R2 ! nr of bytes written + push *RR14, R3 + push *RR14, $0 + jr retu +open: cp R0, $5 ! open + jr close + jr NE, close + ld *RR14, $0 + ld 2(R15), $0 + jr retu +close: cp R0, $6 ! close + jr NE, ioctl + ld *RR14, $0 + jr retu +ioctl: cp R0, $54 ! ioctl + jr NE, err + inc R15, $4 + ld *RR14, $0 +retu: ldl RR2, saveret + jp *RR2 +err: push *RR14, saveret + push *RR14, $EBADMON + calr trp + ret diff --git a/mach/z8000/libem/noop.s b/mach/z8000/libem/noop.s new file mode 100644 index 00000000..f6c16c0a --- /dev/null +++ b/mach/z8000/libem/noop.s @@ -0,0 +1,9 @@ +.define noop + +noop: + push *RR14, hol0 + push *RR14, $fmt + calr prf + ret +.data +fmt: .asciz "test %d\n" diff --git a/mach/z8000/libem/prf.s b/mach/z8000/libem/prf.s new file mode 100644 index 00000000..9491b142 --- /dev/null +++ b/mach/z8000/libem/prf.s @@ -0,0 +1,36 @@ +.define prf + +prf: + ld R0, hol0+4 !pointer to filename + cp R0, $0 + jr EQ, 1f + ld R2, R0 + ld R1, $40 +3: !test filename on bad characters + ldb R3, 0(R2) + cpb R3, $0 + jr EQ, 2f + cpb R3, $0177 + jr GE, 1f + cpb R3, $040 + jr LT, 1f + inc R2 + djnz R1, 3b + clrb 0(R2) +2: push *RR14, hol0 + ld R1, R15 + push *RR14, R1 + push *RR14, R0 + push *RR14, $fmt1 + calr printf + popl saveprf, *RR14 !return address + calr printf !because of call from 'noop' + pushl *RR14, saveprf + ret +1: ld R0, $name + jr 2b +.data +fmt1: .asciz "%s, sp = %x, line %d:\n" +name: .asciz "_unknown file_" +saveprf: + .long 0 diff --git a/mach/z8000/libem/printf.s b/mach/z8000/libem/printf.s new file mode 100755 index 00000000..0e511b9d --- /dev/null +++ b/mach/z8000/libem/printf.s @@ -0,0 +1,82 @@ +.define printf + +printf: + popl saveret, *RR14 + ldm savereg, R4, $10 + ld R3, $buff !R3 is pointer to a buffer, in which + !we built the string to be printed. + pop R2, *RR14 !R2 is pointer to format-string +prloop: + ldb RL0, 0(R2) + testb RL0 + jr EQ, ready + inc R2 + cpb RL0, $045 ! '%'? + jr NE, 1f + ldb RL0, 0(R2) + inc R2 + cpb RL0, $0163 ! 's'? + jr EQ, 3f + cpb RL0, $0170 ! 'x'? + ld R4, $16 ! print number hexadecimal + jr EQ, 2f + cpb RL0, $0144 ! 'd'? + ld R4, $10 ! print number decimal + jr EQ, 2f + cpb RL0, $0157 ! 'o'? + ld R4, $8 ! print number octal + jr EQ, 2f +1: ldb 0(R3), RL0 + inc R3 + jr prloop +2: !in case of %x, %d or %o + pop R1, *RR14 + test R1 + jr PL, 4f + cp R4, $10 + jr NE, 4f ! print only '-' in case of %d + ldb 0(R3), $055 ! '-' + inc R3 + neg R1 +4: calr printn + jr prloop +3: !in case of %s + pop R1, *RR14 +6: ldb RL0, 0(R1) + testb RL0 + jr EQ, prloop + inc R1 + ldb 0(R3), RL0 + inc R3 + jr 6b +ready: !now really print the string we built in the buffer + ldb 0(R3), RL0 !end string with '\0' + sub R3, $buff-1 !R3 contains the number of characters + ld R1, $buff +7: ldb RL0, 0(R1) + inc R1 + sc $4 + djnz R3, 7b + ldm R4, savereg, $10 + pushl *RR14, saveret + ret + +printn: + ldk R0, $0 + div RR0, R4 !%x, %d or %o determined by R4 + test R1 + jr EQ, 5f !if quotient is '0' printn is ready + push *RR14, R0 !push remainder onto the stack + calr printn + pop R0, *RR14 +5: add R0, $060 + cp R0, $071 !'9' + jr LE, 8f + add R0, $7 +8: ldb 0(R3), RL0 + inc R3 + ret + +.data +buff: + .space 256 diff --git a/mach/z8000/libem/rck.s b/mach/z8000/libem/rck.s new file mode 100644 index 00000000..cf36d8c4 --- /dev/null +++ b/mach/z8000/libem/rck.s @@ -0,0 +1,11 @@ +.define rck + +rck: + ld R0, RR14($4) + cp R0, 0(R1) + jr LT, 1f + cp R0, 2(R1) + jr LE, 2f +1: push *RR14, $ERANGE + calr trp +2: ret diff --git a/mach/z8000/libem/rmu2.s b/mach/z8000/libem/rmu2.s new file mode 100644 index 00000000..1bdcb4d4 --- /dev/null +++ b/mach/z8000/libem/rmu2.s @@ -0,0 +1,17 @@ +.define rmu2 + +rmu2: + popl saveret, *RR14 + pop R2, *RR14 + pop R1, *RR14 + test R2 + jr MI, 1f + ldk R0, $0 + div RR0, R2 +2: pushl *RR14, saveret + ret +1: ld R0, R1 + cp R2, R1 + jp UGT, 2b + sub R0, R2 + jp 2b diff --git a/mach/z8000/libem/rmu4.s b/mach/z8000/libem/rmu4.s new file mode 100644 index 00000000..1604f734 --- /dev/null +++ b/mach/z8000/libem/rmu4.s @@ -0,0 +1,19 @@ +.define rmu4 + +rmu4: + popl saveret, *RR14 + ldm savereg, R4, $10 + popl RR4, *RR14 + popl RR2, *RR14 + testl RR4 + jr MI, 1f + ldl RR0, $0 + divl RQ0, RR4 + jr 2f +1: ldl RR0, RR2 + cpl RR4, RR2 + jr UGT, 2f + sub RR0, RR4 +2: ldm R4, savereg, $10 + pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/sar.s b/mach/z8000/libem/sar.s new file mode 100644 index 00000000..509003a2 --- /dev/null +++ b/mach/z8000/libem/sar.s @@ -0,0 +1,20 @@ +.define sar + +!R1 contains description address +!R3 contains element number +!base address is on stack +sar: + popl saveret, *RR14 + sub R3, 0(R1) + ld R0, 4(R1) !nr of bytes per element + mult RR2, R0 + add R3, *RR14 + inc R15, $2 + sra R0 !nr of words per element + jr EQ, 1f + ldir *RR2, *RR14, R0 + jr 2f +1: pop R1, *RR14 + ldb *RR2, RL1 +2: ldl RR2, saveret + jp *RR2 diff --git a/mach/z8000/libem/save.s b/mach/z8000/libem/save.s new file mode 100644 index 00000000..ef704dd5 --- /dev/null +++ b/mach/z8000/libem/save.s @@ -0,0 +1,8 @@ +.define saveret +.define savereg + +.data +saveret: + .long 0 +savereg: + .space 20 diff --git a/mach/z8000/libem/sigtrp.s b/mach/z8000/libem/sigtrp.s new file mode 100644 index 00000000..e69de29b diff --git a/mach/z8000/libem/strhp.s b/mach/z8000/libem/strhp.s new file mode 100644 index 00000000..a987aa31 --- /dev/null +++ b/mach/z8000/libem/strhp.s @@ -0,0 +1,10 @@ +.define strhp + +strhp: + popl RR2, *RR14 + pop R0, *RR14 + ld reghp, R0 !heappointer must be < stackpointer. + cp R0, R15 + jp ULT, *RR2 + push *RR14, $EHEAP + jr fatal diff --git a/mach/z8000/libem/sts2.s b/mach/z8000/libem/sts2.s new file mode 100644 index 00000000..2c404ca2 --- /dev/null +++ b/mach/z8000/libem/sts2.s @@ -0,0 +1,16 @@ +.define sts2 + +sts2: + popl saveret, *RR14 + pop R0, *RR14 !object size + ldk R2, $0 + pop R3, *RR14 !address of object + cp R0, $1 + jr NE, 1f + pop R0, *RR14 + ldb *RR2, RL0 + jr 2f +1: sra R0 + ldir *RR2, *RR14, R0 +2: pushl *RR14, saveret + ret diff --git a/mach/z8000/libem/trp.s b/mach/z8000/libem/trp.s new file mode 100644 index 00000000..f9efd641 --- /dev/null +++ b/mach/z8000/libem/trp.s @@ -0,0 +1,38 @@ +.define trp, fatal + +fatal: + calr trp + sc $EXIT + +trp: + push *RR14, R1 + inc R15, $2 + popl saveret, *RR14 + pop R1, *RR14 !trap number in R1 + pushl *RR14, saveret + push *RR14, R0 + dec R15, $2 + cp R1, $16 + jr UGE, 1f + ld R0, trpim + bit R0, R1 + jr NE, 2f !ignore +1: sub R15, $24 + ldm *RR14, R2, $12 + push *RR14, R1 + ld R1, trppc + cp R1, $0 + jr EQ, 3f + clr trppc + call 0(R1) + inc R15, $2 + ldm R2, *RR14, $12 + add R15, $24 +2: pop R1, *RR14 + pop R0, *RR14 + ret +3: push *RR14, $err + calr printf + sc $EXIT +.data +err: .asciz "trap error %d\n" diff --git a/mach/z8000/libem/unknown.s b/mach/z8000/libem/unknown.s new file mode 100644 index 00000000..e3e2e819 --- /dev/null +++ b/mach/z8000/libem/unknown.s @@ -0,0 +1,5 @@ +.define unknown + +unknown: + push *RR14, $EODDZ + jr fatal diff --git a/mach/z8000/libem/xset.s b/mach/z8000/libem/xset.s new file mode 100644 index 00000000..7ed57945 --- /dev/null +++ b/mach/z8000/libem/xset.s @@ -0,0 +1,22 @@ +.define xset + +!bitnr in R1 +!size (bytes) in R0 +xset: + popl saveret, *RR14 + sra R0 + ld R2, R0 +1: push *RR14, $0 + djnz R0, 1b + div RR0, $020 !R0: bitnr, R1: wordnr + cp R1, R2 + jr UGE, 2f + ldk R2, $0 + set R2, R0 + sla R1 + ld RR14(R1), R2 +3: pushl *RR14, saveret + ret +2: push *RR14, $ESET + calr trp + jr 3b diff --git a/mach/z8000/libpc/Makefile b/mach/z8000/libpc/Makefile new file mode 100644 index 00000000..345d2294 --- /dev/null +++ b/mach/z8000/libpc/Makefile @@ -0,0 +1,20 @@ +MAKEFILE=../../proto/libg/Makefile +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 diff --git a/mach/z8000/libpc/compmodule b/mach/z8000/libpc/compmodule new file mode 100755 index 00000000..28461326 --- /dev/null +++ b/mach/z8000/libpc/compmodule @@ -0,0 +1,2 @@ +${MACH?} -I../../../h ${MACHFL?} $1 1>&2 +echo `basename $1 $2`.s diff --git a/man/6500_as.1 b/man/6500_as.1 new file mode 100644 index 00000000..d7c779d3 --- /dev/null +++ b/man/6500_as.1 @@ -0,0 +1,65 @@ +.\" $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) diff --git a/man/6800_as.1 b/man/6800_as.1 new file mode 100644 index 00000000..e7341ec3 --- /dev/null +++ b/man/6800_as.1 @@ -0,0 +1,55 @@ +.\" $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 2-byte address. Allowed in the register + memory group. (extended) +expr 1-byte address if appropriate, 2-byte + in other cases. (auto-direct/extended) +,x indexed with zero offset. (indexed) +expr,x indexed with 16 bit offset. (indexed-2) +expr,x indexed with the shortest possible off- + set. (auto indexed) +bit,expr bit number and direct address. + (bit set/clear) +bit,expr,tag bit number, direct address and branch + tag. Automatically changed to reversed + condition branch and jump if appropri- + ate. (bit test and branch) +tag branch tag. Converted to reversed con- + dition branch and jump if appropriate. + (branch) +.fi +.IP "PSEUDO INSTRUCTIONS" + + .dram use the zero page ram/io segment. + .dprom use the zero page (ep)rom segment. + .cmos assemble cmos version instructions. +.SH "SEE ALSO" +uni_ass(6), +ack(1), +.br +M6805 HMOS, M146805 CMOS family, Motorola, +Prentice-Hall, Inc., 1983, (ISBN 0-13-541375-3). +.SH EXAMPLE +An example of Motorola 6805 assembly code. +.sp 2 +.nf +.ta 8 16 32 40 48 56 64 +.dram +one: .space 1 ! a-port +.dprom +c1: .byte 1 +.text +start: ldx #c1 ! load address of c1 + txa + sta one + add c1 ! add one + brset 1,one,whoop ! jif bit one of aport + bset 1,one ! set it now +.data + .ascii "unused string" +.text +whoop: nop +.org 0xff8 + .word start ! set vector address +.text + nop ! resume code +.fi +.SH AUTHOR +Written by Gijs Mos. +Not a member of the ACK group. +.SH BUGS +The assembler has not been well tested. diff --git a/man/6809_as.1 b/man/6809_as.1 new file mode 100644 index 00000000..7ac2ede8 --- /dev/null +++ b/man/6809_as.1 @@ -0,0 +1,147 @@ +.\" $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 two-byte value of `expr' is the exact memory + address. Not that this mode always requires one + byte more than "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 diff --git a/man/8080_as.1 b/man/8080_as.1 new file mode 100644 index 00000000..e8d8871a --- /dev/null +++ b/man/8080_as.1 @@ -0,0 +1,36 @@ +.\" $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 diff --git a/man/Makefile b/man/Makefile new file mode 100644 index 00000000..2dbeaa27 --- /dev/null +++ b/man/Makefile @@ -0,0 +1,69 @@ +# $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 m68k_int.1 > m68k_int.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 cgg.6 > cgg.opr + -nroff macro.v7 em_ass.6 > em_ass.opr + -nroff macro.v7 em_cg.6 > em_cg.opr + -nroff macro.v7 em_ncg.6 > em_ncg.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 m68k_int.1 > /usr/man/man1/m68k_int.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 cgg.6 /usr/man/man6/cgg.6 + -cp em_ass.6 /usr/man/man6/em_ass.6 + -cp em_cg.6 /usr/man/man6/em_cg.6 + -cp em_ncg.6 /usr/man/man6/em_ncg.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 diff --git a/man/a.out.5 b/man/a.out.5 new file mode 100644 index 00000000..25cc6b5b --- /dev/null +++ b/man/a.out.5 @@ -0,0 +1,46 @@ +.\" $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 diff --git a/man/arch.1 b/man/arch.1 new file mode 100644 index 00000000..4d675b62 --- /dev/null +++ b/man/arch.1 @@ -0,0 +1,135 @@ +.\" $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. diff --git a/man/arch.5 b/man/arch.5 new file mode 100644 index 00000000..32ce7004 --- /dev/null +++ b/man/arch.5 @@ -0,0 +1,52 @@ +.\" $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. diff --git a/man/em.1 b/man/em.1 new file mode 100644 index 00000000..f8ed40c5 --- /dev/null +++ b/man/em.1 @@ -0,0 +1,87 @@ +.\" $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. diff --git a/man/em_cg.6 b/man/em_cg.6 new file mode 100644 index 00000000..a9d5066e --- /dev/null +++ b/man/em_cg.6 @@ -0,0 +1,32 @@ +.\" $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 diff --git a/man/em_decode.6 b/man/em_decode.6 new file mode 100644 index 00000000..d1901baa --- /dev/null +++ b/man/em_decode.6 @@ -0,0 +1,40 @@ +.\" $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. diff --git a/man/em_ncg.6 b/man/em_ncg.6 new file mode 100644 index 00000000..5a4a9f9e --- /dev/null +++ b/man/em_ncg.6 @@ -0,0 +1,43 @@ +.\" $Header$ +.TH EM_CG VI +.ad +.SH NAME +em_cg \- EM to assembly code translator +.SH SYNOPSIS +em_cg [-d\fIn\fP] [-p\fIn\fP] [-w\fIn\fP] [-u\fIfile\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\fIn\fP +Run in debugging mode, debugging level \fIn\fP, +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. +.IP -u\fIfile\fP +Take the \fIfile\fP as a bitmap giving 1 bits for untested code rules +and write the \fIfile\fP at end of code generation, +substituting zero bits for rules used. +Give a list of untested rules on standard error, unless the -u +was given as -U. +Only possible if the -d flag was given to cgg(VI). +.SH FILES +code If the -c flag was given to cgg(VI) +.SH "SEE ALSO" +ack(I) +.br +cgg(VI) +.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 diff --git a/man/eminform.1 b/man/eminform.1 new file mode 100644 index 00000000..18e5dc14 --- /dev/null +++ b/man/eminform.1 @@ -0,0 +1,51 @@ +.\" $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 diff --git a/man/i86_as.1 b/man/i86_as.1 new file mode 100644 index 00000000..11379011 --- /dev/null +++ b/man/i86_as.1 @@ -0,0 +1,144 @@ +.\" $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 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 diff --git a/man/libmon.7 b/man/libmon.7 new file mode 100644 index 00000000..468c149f --- /dev/null +++ b/man/libmon.7 @@ -0,0 +1,98 @@ +.\" $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. diff --git a/man/libpc.7 b/man/libpc.7 new file mode 100644 index 00000000..335f4746 --- /dev/null +++ b/man/libpc.7 @@ -0,0 +1,299 @@ +.\" $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. diff --git a/man/m68k2_as.1 b/man/m68k2_as.1 new file mode 100644 index 00000000..deeb430e --- /dev/null +++ b/man/m68k2_as.1 @@ -0,0 +1,100 @@ +.\" $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 diff --git a/man/m68k_int.1 b/man/m68k_int.1 new file mode 100644 index 00000000..11b90fb7 --- /dev/null +++ b/man/m68k_int.1 @@ -0,0 +1,96 @@ +.\" $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. +These options may be overridden at runtime as follows: +em -t turns the test option of; em +c turns count on ; em +p turns profile +on ; em +c +p turns both count and profile on. +Based on these options the name of the appropriate interpreter +is constructed. +Two versions exist, one for two byte words and four byte pointers and +one for four byte words and pointers. +The information in the header of the e.out file is used by em to select the +right interpreter for the word size of used in the e.out file. +.PP +This interpreter is searched for in /usr/em/lib/int[24]4. +.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 maintains tables containing +an estimate of the number of processor state cycles used per source line. +A processor state cycle is equal to two internal clock cycles. +This option is expensive in time as well as in memory space. +The result tables made at run time are dumped in a human readable +format onto a file named +em_profile. +.IP f +maintain a bit map of all source lines that have been executed. +This map is written onto a file em_flow . +This option is almost free in time and space. +The file is not easy to read. +Of each procedure only the lines between the first statement and the last +statement are represented in the bit map. +Currently this option is not installed in the em tree. +.IP c +count line usage in tables that +contains for every source line the number of times it +was entered. +These tables are written onto em_count, a human readable file . +This option is cheap in time, but costs some in memory space. +.IP l +dump the line numbers of the last 64 lines entered onto a file named +em_last. +This file will be in a human readable format. +This option is used simultaneously with the test option. +.PP +These flags +give rise to 5 different interpreters which are in the +directory /usr/em/lib/int24 or in /usr/em/lib/int44 +for the two byte word or the four byte word options, respectively. +.PP +.SH "FILES" +.IP /usr/em/lib/int[24]4/em_???? 35 +interpreters proper +.PD 0 +.IP /usr/em/mach/m68k2/int/mloop? +source of interpreter +.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" +\fIack\fP(I), +\fIint24\fP(I), +\fIint44\fP(I) +.SH BUGS +Most error messages are self explanatory. +If runtime flags are turned on it is advisable to try again +with the default options. +If the interpreter does not work most probably your particular +machine has an other format for the system calls then assumed +in the source. +In that case adapt source file mloopc to your machine. +Also the instruction that causes the machine to allocate stack +space might differ . +In that case adapt the macro 'claimstack' in deffile. +.SH AUTHOR +Freek van Schagen diff --git a/man/macro.v7 b/man/macro.v7 new file mode 100644 index 00000000..2d3ab6c8 --- /dev/null +++ b/man/macro.v7 @@ -0,0 +1,64 @@ +.\" $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 +\fB\\$1\fR\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 +.. diff --git a/man/ns_as.1 b/man/ns_as.1 new file mode 100644 index 00000000..20c31d13 --- /dev/null +++ b/man/ns_as.1 @@ -0,0 +1,148 @@ +.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 diff --git a/man/pc_prlib.7 b/man/pc_prlib.7 new file mode 100644 index 00000000..f0055016 --- /dev/null +++ b/man/pc_prlib.7 @@ -0,0 +1,759 @@ +.\" $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. diff --git a/man/pdp_as.1 b/man/pdp_as.1 new file mode 100644 index 00000000..870f65dc --- /dev/null +++ b/man/pdp_as.1 @@ -0,0 +1,138 @@ +.\" $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). diff --git a/man/uni_ass.6 b/man/uni_ass.6 new file mode 100644 index 00000000..b89b86e6 --- /dev/null +++ b/man/uni_ass.6 @@ -0,0 +1,332 @@ +.\" $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. diff --git a/man/z8000_as.1 b/man/z8000_as.1 new file mode 100644 index 00000000..bf0295af --- /dev/null +++ b/man/z8000_as.1 @@ -0,0 +1,163 @@ +.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 <>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 +(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. diff --git a/man/z80_as.1 b/man/z80_as.1 new file mode 100644 index 00000000..b271ed09 --- /dev/null +++ b/man/z80_as.1 @@ -0,0 +1,66 @@ +.\" $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 diff --git a/mkun/Makefile b/mkun/Makefile new file mode 100644 index 00000000..cab8df3b --- /dev/null +++ b/mkun/Makefile @@ -0,0 +1,25 @@ +DEST=/usr/lib/tmac/tmac.kun + +install: + for i in "" 1 2 3 4 5 6 7 8 ;\ + do ;\ + cp tmac.q$i $DEST$i ;\ + done + +cmp: + for i in "" 1 2 3 4 5 6 7 8 ;\ + do ;\ + cmp tmac.q$i $DEST$i ;\ + done + +pr: + @for i in "" 1 2 3 4 5 6 7 8 ;\ + do ;\ + pr tmac.q$i ;\ + done + +opr: + make pr | opr + +clean: + @: diff --git a/util/LLgen/LLgen.1 b/util/LLgen/LLgen.1 new file mode 100644 index 00000000..b91d0417 --- /dev/null +++ b/util/LLgen/LLgen.1 @@ -0,0 +1,120 @@ +.\" $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 diff --git a/util/LLgen/Makefile b/util/LLgen/Makefile new file mode 100644 index 00000000..54fc56f9 --- /dev/null +++ b/util/LLgen/Makefile @@ -0,0 +1,30 @@ +# $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 + @pr lib/incl lib/rec diff --git a/util/LLgen/READ_ME b/util/LLgen/READ_ME new file mode 100644 index 00000000..3bcd1e41 --- /dev/null +++ b/util/LLgen/READ_ME @@ -0,0 +1,19 @@ +$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. diff --git a/util/LLgen/lib/incl b/util/LLgen/lib/incl new file mode 100644 index 00000000..237ee69e --- /dev/null +++ b/util/LLgen/lib/incl @@ -0,0 +1,12 @@ +/* $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" diff --git a/util/LLgen/lib/rec b/util/LLgen/lib/rec new file mode 100644 index 00000000..4403149f --- /dev/null +++ b/util/LLgen/lib/rec @@ -0,0 +1,217 @@ +/* + * 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; + } +} + diff --git a/util/LLgen/src/Makefile b/util/LLgen/src/Makefile new file mode 100644 index 00000000..5e5f7ad9 --- /dev/null +++ b/util/LLgen/src/Makefile @@ -0,0 +1,96 @@ +# $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) +# must continue when installing LLgen + @touch parser + +LLgen: $(OBJECTS) + $(CC) $(PROF) $(LDFLAGS) $(OBJECTS) -o LLgen + @size LLgen + +pr : + @pr $(FILES) ../lib/rec ../lib/incl Makefile + +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 diff --git a/util/LLgen/src/alloc.c b/util/LLgen/src/alloc.c new file mode 100644 index 00000000..da86bbb9 --- /dev/null +++ b/util/LLgen/src/alloc.c @@ -0,0 +1,56 @@ +/* + * (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; +} diff --git a/util/LLgen/src/assert.h b/util/LLgen/src/assert.h new file mode 100644 index 00000000..8a50b9ca --- /dev/null +++ b/util/LLgen/src/assert.h @@ -0,0 +1,35 @@ +/* + * (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 diff --git a/util/LLgen/src/extern.h b/util/LLgen/src/extern.h new file mode 100644 index 00000000..c4f28a82 --- /dev/null +++ b/util/LLgen/src/extern.h @@ -0,0 +1,86 @@ +/* + * (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? + */ diff --git a/util/LLgen/src/global.c b/util/LLgen/src/global.c new file mode 100644 index 00000000..33e8fc8b --- /dev/null +++ b/util/LLgen/src/global.c @@ -0,0 +1,73 @@ +/* + * (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; diff --git a/util/LLgen/src/io.h b/util/LLgen/src/io.h new file mode 100644 index 00000000..4c034070 --- /dev/null +++ b/util/LLgen/src/io.h @@ -0,0 +1,49 @@ +/* + * (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 +# include + +/* 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; diff --git a/util/LLgen/src/machdep.c b/util/LLgen/src/machdep.c new file mode 100644 index 00000000..6ca3745a --- /dev/null +++ b/util/LLgen/src/machdep.c @@ -0,0 +1,74 @@ +/* + * (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; +} diff --git a/util/LLgen/src/main.c b/util/LLgen/src/main.c new file mode 100644 index 00000000..964b08c8 --- /dev/null +++ b/util/LLgen/src/main.c @@ -0,0 +1,336 @@ +/* + * (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 diff --git a/util/LLgen/src/name.c b/util/LLgen/src/name.c new file mode 100644 index 00000000..2537b693 --- /dev/null +++ b/util/LLgen/src/name.c @@ -0,0 +1,242 @@ +/* + * (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; +} diff --git a/util/LLgen/src/reach.c b/util/LLgen/src/reach.c new file mode 100644 index 00000000..233cc331 --- /dev/null +++ b/util/LLgen/src/reach.c @@ -0,0 +1,123 @@ +/* + * (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++; + } +} diff --git a/util/LLgen/src/sets.h b/util/LLgen/src/sets.h new file mode 100644 index 00000000..bee31fcb --- /dev/null +++ b/util/LLgen/src/sets.h @@ -0,0 +1,45 @@ +/* + * (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; diff --git a/util/LLgen/src/tokens.g b/util/LLgen/src/tokens.g new file mode 100644 index 00000000..4f2f8567 --- /dev/null +++ b/util/LLgen/src/tokens.g @@ -0,0 +1,430 @@ +/* + * (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; + } +} +} diff --git a/util/LLgen/src/tunable.h b/util/LLgen/src/tunable.h new file mode 100644 index 00000000..9714f410 --- /dev/null +++ b/util/LLgen/src/tunable.h @@ -0,0 +1,35 @@ +/* + * (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 */ diff --git a/util/ack/.distr b/util/ack/.distr new file mode 100644 index 00000000..83d135be --- /dev/null +++ b/util/ack/.distr @@ -0,0 +1,23 @@ +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 diff --git a/util/ack/Makefile b/util/ack/Makefile new file mode 100644 index 00000000..9fc81174 --- /dev/null +++ b/util/ack/Makefile @@ -0,0 +1,65 @@ +# $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=acc apc abc vax2 vax4 i86 ix m68k2 m68k4 pmds z8000 int22 int24 int44\ +6500 6800 6809 8080 nascom ns s2650 z80 +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) diff --git a/util/ack/ack.1.X b/util/ack/ack.1.X new file mode 100644 index 00000000..0c1882e7 --- /dev/null +++ b/util/ack/ack.1.X @@ -0,0 +1,260 @@ +.\" $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 diff --git a/util/ack/ack.h b/util/ack/ack.h new file mode 100644 index 00000000..51e605f4 --- /dev/null +++ b/util/ack/ack.h @@ -0,0 +1,93 @@ +#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 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 diff --git a/util/ack/data.c b/util/ack/data.c new file mode 100644 index 00000000..56e1b7d9 --- /dev/null +++ b/util/ack/data.c @@ -0,0 +1,16 @@ +#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 diff --git a/util/ack/data.h b/util/ack/data.h new file mode 100644 index 00000000..5208efc9 --- /dev/null +++ b/util/ack/data.h @@ -0,0 +1,46 @@ +#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 */ diff --git a/util/ack/dmach.h b/util/ack/dmach.h new file mode 100644 index 00000000..3e8d853b --- /dev/null +++ b/util/ack/dmach.h @@ -0,0 +1,19 @@ +/***************************************************************/ +/* */ +/* 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[] ; diff --git a/util/ack/files.c b/util/ack/files.c new file mode 100644 index 00000000..8176e11a --- /dev/null +++ b/util/ack/files.c @@ -0,0 +1,191 @@ +/* + * (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 ; +} diff --git a/util/ack/grows.c b/util/ack/grows.c new file mode 100644 index 00000000..a4c5f914 --- /dev/null +++ b/util/ack/grows.c @@ -0,0 +1,84 @@ +/* + * (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 ; +} diff --git a/util/ack/grows.h b/util/ack/grows.h new file mode 100644 index 00000000..f048aba8 --- /dev/null +++ b/util/ack/grows.h @@ -0,0 +1,23 @@ +#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 */ diff --git a/util/ack/list.c b/util/ack/list.c new file mode 100644 index 00000000..7e472ebc --- /dev/null +++ b/util/ack/list.c @@ -0,0 +1,81 @@ +/* + * (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 ; +} diff --git a/util/ack/list.h b/util/ack/list.h new file mode 100644 index 00000000..bec3bfac --- /dev/null +++ b/util/ack/list.h @@ -0,0 +1,27 @@ +#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) ) diff --git a/util/ack/main.c b/util/ack/main.c new file mode 100644 index 00000000..c1e7a4a5 --- /dev/null +++ b/util/ack/main.c @@ -0,0 +1,445 @@ +/* + * (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 + +#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 ) { + 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 ; + } +} diff --git a/util/ack/malloc.c b/util/ack/malloc.c new file mode 100644 index 00000000..87a4bce5 --- /dev/null +++ b/util/ack/malloc.c @@ -0,0 +1,212 @@ +/* + * (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&&qptr = 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=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 diff --git a/util/ack/mktables.c b/util/ack/mktables.c new file mode 100644 index 00000000..9adb9f44 --- /dev/null +++ b/util/ack/mktables.c @@ -0,0 +1,125 @@ +/* + * (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 +#include + +#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 ; i2) ; + 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) ; +} diff --git a/util/ack/pc/.distr b/util/ack/pc/.distr new file mode 100644 index 00000000..df8c6bb9 --- /dev/null +++ b/util/ack/pc/.distr @@ -0,0 +1,2 @@ +Makefile +em_pc.c diff --git a/util/ack/pc/Makefile b/util/ack/pc/Makefile new file mode 100644 index 00000000..4d4f340f --- /dev/null +++ b/util/ack/pc/Makefile @@ -0,0 +1,25 @@ +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 diff --git a/util/ack/pc/em_pc.c b/util/ack/pc/em_pc.c new file mode 100644 index 00000000..921e7472 --- /dev/null +++ b/util/ack/pc/em_pc.c @@ -0,0 +1,685 @@ +/* + * (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 +#include +#include +#include +#include +#include +#include + +#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 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(); +} diff --git a/util/ack/rmach.c b/util/ack/rmach.c new file mode 100644 index 00000000..14c946ac --- /dev/null +++ b/util/ack/rmach.c @@ -0,0 +1,397 @@ +/* + * (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 + +#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 ; +} diff --git a/util/ack/run.c b/util/ack/run.c new file mode 100644 index 00000000..b46769ba --- /dev/null +++ b/util/ack/run.c @@ -0,0 +1,158 @@ +/* + * (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 + +#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 ; +} diff --git a/util/ack/scan.c b/util/ack/scan.c new file mode 100644 index 00000000..9165537f --- /dev/null +++ b/util/ack/scan.c @@ -0,0 +1,262 @@ +/* + * (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_pcountncount || /* Shorter nec. path */ + (last_ncount==ncount && /* Same nec. path, optimize?*/ + (Optflag? last_ocountocount ))))) { + /* 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") ; +} diff --git a/util/ack/svars.c b/util/ack/svars.c new file mode 100644 index 00000000..c6cd6b41 --- /dev/null +++ b/util/ack/svars.c @@ -0,0 +1,129 @@ +/* + * (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 ; +} diff --git a/util/ack/trans.c b/util/ack/trans.c new file mode 100644 index 00000000..8d016255 --- /dev/null +++ b/util/ack/trans.c @@ -0,0 +1,676 @@ +/* + * (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 *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(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 && eqcolon ) ) 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 && ncp_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) ; +} diff --git a/util/ack/trans.h b/util/ack/trans.h new file mode 100644 index 00000000..30b9e963 --- /dev/null +++ b/util/ack/trans.h @@ -0,0 +1,42 @@ +#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)) diff --git a/util/ack/util.c b/util/ack/util.c new file mode 100644 index 00000000..77e6f18e --- /dev/null +++ b/util/ack/util.c @@ -0,0 +1,194 @@ +/* + * (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 +#include + +#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 ; +} diff --git a/util/ass/Makefile b/util/ass/Makefile new file mode 100644 index 00000000..fafb0710 --- /dev/null +++ b/util/ass/Makefile @@ -0,0 +1,81 @@ +# $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) diff --git a/util/ass/asprint.p b/util/ass/asprint.p new file mode 100644 index 00000000..9f9c409f --- /dev/null +++ b/util/ass/asprint.p @@ -0,0 +1,384 @@ +# +{$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. diff --git a/util/ass/ass00.c b/util/ass/ass00.c new file mode 100644 index 00000000..80ad65e8 --- /dev/null +++ b/util/ass/ass00.c @@ -0,0 +1,541 @@ +#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 ; argnon_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(inpoff2 ) 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; pp_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; pp_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); +} diff --git a/util/ass/ass00.h b/util/ass/ass00.h new file mode 100644 index 00000000..a9b456e5 --- /dev/null +++ b/util/ass/ass00.h @@ -0,0 +1,248 @@ +#include +#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 */ +}; diff --git a/util/ass/ass30.c b/util/ass/ass30.c new file mode 100644 index 00000000..1f6f983d --- /dev/null +++ b/util/ass/ass30.c @@ -0,0 +1,376 @@ +/* + * (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=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=0 && 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 */ + } +} diff --git a/util/ass/ass40.c b/util/ass/ass40.c new file mode 100644 index 00000000..41cfe652 --- /dev/null +++ b/util/ass/ass40.c @@ -0,0 +1,60 @@ +/* + * (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 ; + } +} diff --git a/util/ass/ass50.c b/util/ass/ass50.c new file mode 100644 index 00000000..6b3663dc --- /dev/null +++ b/util/ass/ass50.c @@ -0,0 +1,194 @@ +/* + * (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); + } + } +} diff --git a/util/ass/ass60.c b/util/ass/ass60.c new file mode 100644 index 00000000..2a6e1c15 --- /dev/null +++ b/util/ass/ass60.c @@ -0,0 +1,215 @@ +/* + * (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->type1type1 : 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 ; il_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 diff --git a/util/ass/ass70.c b/util/ass/ass70.c new file mode 100644 index 00000000..18fe730e --- /dev/null +++ b/util/ass/ass70.c @@ -0,0 +1,346 @@ +/* + * (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); +} diff --git a/util/ass/ass80.c b/util/ass/ass80.c new file mode 100644 index 00000000..e7c04ced --- /dev/null +++ b/util/ass/ass80.c @@ -0,0 +1,416 @@ +/* + * (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)))<>= 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))<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 diff --git a/util/ass/assci.c b/util/ass/assci.c new file mode 100644 index 00000000..06971fcc --- /dev/null +++ b/util/ass/assci.c @@ -0,0 +1,858 @@ +/* + * (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=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 ( wordsizewordsize ? 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 ; +} diff --git a/util/ass/asscm.c b/util/ass/asscm.c new file mode 100644 index 00000000..705e1048 --- /dev/null +++ b/util/ass/asscm.c @@ -0,0 +1,141 @@ +/* + * (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 = sizef_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 diff --git a/util/ass/assda.c b/util/ass/assda.c new file mode 100644 index 00000000..e872d6f5 --- /dev/null +++ b/util/ass/assda.c @@ -0,0 +1,132 @@ +#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 */ diff --git a/util/ass/assex.h b/util/ass/assex.h new file mode 100644 index 00000000..91d9880b --- /dev/null +++ b/util/ass/assex.h @@ -0,0 +1,160 @@ +/* + * 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 diff --git a/util/ass/assrl.c b/util/ass/assrl.c new file mode 100644 index 00000000..4fa1aab9 --- /dev/null +++ b/util/ass/assrl.c @@ -0,0 +1,302 @@ +/* + * (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 | / + * | | / + * | | / + * | NTEXT | \ + * | NDATA | \ + * | NPROC | \ + * | ENTRY-POINT | | 8*(wordsize-word) header + * | NLINES | | for interpreter proper + * | | / + * | | / + * | | / + * |________________________| + * | | + * | 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;ig_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 ( ; ig_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 ( ; ir_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 ; +} diff --git a/util/ass/em_ass.6 b/util/ass/em_ass.6 new file mode 100644 index 00000000..eeb753d9 --- /dev/null +++ b/util/ass/em_ass.6 @@ -0,0 +1,68 @@ +.\" $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 diff --git a/util/ass/ip_spec.h b/util/ass/ip_spec.h new file mode 100644 index 00000000..75d14de9 --- /dev/null +++ b/util/ass/ip_spec.h @@ -0,0 +1,35 @@ +/* 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 */ diff --git a/util/ass/maktab.c b/util/ass/maktab.c new file mode 100644 index 00000000..48059de1 --- /dev/null +++ b/util/ass/maktab.c @@ -0,0 +1,482 @@ +/* + * (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 +#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 ; ii_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 ; opc1 ) 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-- ; +} diff --git a/util/cgg/Makefile b/util/cgg/Makefile new file mode 100644 index 00000000..4b47a6da --- /dev/null +++ b/util/cgg/Makefile @@ -0,0 +1,30 @@ +# $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 diff --git a/util/cgg/bootgram.y b/util/cgg/bootgram.y new file mode 100644 index 00000000..d2f72018 --- /dev/null +++ b/util/cgg/bootgram.y @@ -0,0 +1,2341 @@ +%{ + +#ifndef NORCSID +static char rcsid[]="$Header$"; +#endif + +/* + * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands. + * + * This product is part of the Amsterdam Compiler Kit. + * + * Permission to use, sell, duplicate or disclose this software must be + * obtained in writing. Requests for such permissions may be sent to + * + * Dr. Andrew S. Tanenbaum + * Wiskundig Seminarium + * Vrije Universiteit + * Postbox 7161 + * 1007 MC Amsterdam + * The Netherlands + * + * Author: Hans van Staveren + */ + +#ifdef vax | vax2 | vax4 +#define BIG +#endif + +#ifdef BIG +#define BORS(x,y) x +#else +#define BORS(x,y) y +#endif +/* Tunable constants */ + +#define MAXALLREG 5 /* Maximum number of allocates per rule */ +#define MAXREGS BORS(36,32) /* Total number of registers */ +#define MAXREGVARS 8 /* Maximum regvars per type */ +#define MAXPROPS 16 /* Total number of register properties */ +#define MAXTOKENS BORS(75,32) /* Different kind of tokens */ +#define MAXSETS BORS(100,80) /* Number of tokenexpressions definable */ +#define MAXEMPATLEN 25 /* Maximum length of EM-pattern/replacement */ +#define TOKENSIZE 5 /* Maximum number of fields in token struct */ +#define MAXINSTANCE BORS(250,120) /* Maximum number of different tokeninstances */ +#define MAXSTRINGS BORS(800,400)/* Maximum number of different codestrings */ +#define MAXPATTERN BORS(8000,6000) /* Maximum number of bytes in pattern[] */ +#define MAXNODES BORS(450,400) /* Maximum number of expression nodes */ +#define MAXMEMBERS 2 /* Maximum number of subregisters per reg */ +#define NMOVES BORS(50,30) /* Maximum number of move definitions */ +#define MAXC1 20 /* Maximum of coercions type 1 */ +#define MAXC2 20 /* Maximum of coercions type 2 */ +#define MAXC3 20 /* Maximum of coercions type 3 */ +#define MAXSPLIT 4 /* Maximum degree of split */ +#define MAXNSTR 40 /* Maximum consecutive strings in coderule */ + +char *hname="tables.h"; +char *cname="tables.c"; +char *iname=0; /* stdin */ + +/* Derived constants */ + +#define SETSIZE ((MAXREGS+1+MAXTOKENS+15)>>4) +#define PROPSETSIZE ((MAXPROPS+15)>>4) + +#define BMASK 0377 +#define BSHIFT 8 + +#define TRUE 1 +#define FALSE 0 + +#define MAXPATLEN 7 /* Maximum length of tokenpatterns */ + +typedef char byte; +typedef char * string; + +char *malloc(),*myalloc(); + +#include +#include +#include +#include +#include +#include +#include + +typedef struct list1str { + struct list1str *l1next; + string l1name; +} *list1; +typedef struct list2str { + struct list2str *l2next; + list1 l2list; +} *list2; +typedef struct list3str { + struct list3str *l3next; + list2 l3list; +} *list3; + +typedef struct reginfo { + string rname; + string rrepr; + int rsize; + int rmembers[MAXMEMBERS]; + int rregvar; + short rprop[PROPSETSIZE]; +} *reginfo; + +typedef struct tokeninfo { + string t_name; + list2 t_struct; + struct { + int t_type; + string t_sname; + } t_fields[TOKENSIZE-1]; + int t_size; + cost_t t_cost; + int t_format; +} token_t,*token_p; + +typedef struct ident { + struct ident *i_next; + string i_name; + int i_type; +# define IREG 1 +# define IPRP 2 +# define ITOK 3 +# define IEXP 4 + union { + int i_regno; + int i_prpno; + int i_tokno; + int i_expno; + } i_i; +} ident_t,*ident_p; + +#define ITABSIZE 32 +ident_p identtab[ITABSIZE]; + +#define LOOKUP 0 +#define HALFWAY 1 +#define ENTER 2 +#define JUSTLOOKING 3 + + +typedef struct expr { + int expr_typ; +# define TYPINT 1 +# define TYPREG 2 +# define TYPSTR 3 +# define TYPBOOL 4 + int expr_index; +} expr_t,*expr_p; + +unsigned cc1=1,cc2=1,cc3=1,cc4=1; + +node_t nodes[MAXNODES]; +node_p lastnode=nodes+1; + +string codestrings[MAXSTRINGS]; +int ncodestrings; + +int strar[MAXNSTR]; +int nstr; + +int pathash[256]; + +reginfo machregs[MAXREGS]; +char stregclass[MAXREGS]; +int nmachregs=1; +int nregclasses=1; +int maxmembers; +struct { + ident_p propname; + set_t propset; +} machprops[MAXPROPS]; +int nprops=0; +token_t machtokens[MAXTOKENS]; +int nmachtokens=1; +set_t machsets[MAXSETS]; +int nmachsets=0; +int patmnem[MAXEMPATLEN]; +int empatlen; +int maxempatlen; +int empatexpr; +int maxrule=1; +int pattokexp[MAXPATLEN]; +int tokpatlen; +int lookident=0; /* lexical analyzer flag */ +list3 structpool=0; +int nallreg; +int allreg[MAXALLREG]; +int maxallreg; +int lino=0; +int nerrors=0; +int curtokexp; +expr_t arexp[TOKENSIZE]; +int narexp; +inst_t arinstance[MAXINSTANCE]; +int narinstance=1; +move_t machmoves[NMOVES]; +int nmoves=0; +byte pattern[MAXPATTERN]; +int npatbytes=0; +int prevind; +int rulecount; /* Temporary index for ... construct */ +int ncoderules=0; +int codebytes=0; +FILE *cfile; +FILE *hfile; +int maxtokensize=0; +int dealflag; +int emrepllen; +int replmnem[MAXEMPATLEN]; +int tokrepllen; +int replinst[MAXPATLEN]; +int replexpr[MAXPATLEN]; +c1_t c1coercs[MAXC1]; +c2_t c2coercs[MAXC2]; +c3_t c3coercs[MAXC3]; +int nc1=0,nc2=0,nc3=0; +int maxsplit=0; +int wsize= -1; +int psize= -1; +int bsize= -1; +char *fmt=0; + +int cchandled; +int ccspoiled; +int ccregexpr; +int ccinstanceno; +int cocopropno; +int cocosetno; +int allexpno; + +int rvused; /* regvars used */ +int nregvar[4]; /* # of register variables of all kinds */ +int rvnumbers[4][MAXREGVARS]; /* The register numbers */ + +#define chktabsiz(size,maxsize,which) if(size>=maxsize) tabovf(which) + +#define MUST1BEINT(e) int exp1=e.expr_index;tstint(e) +#define MUST2BEINT(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstint(e1);tstint(e2) +#define MUST1BEBOOL(e) int exp1=e.expr_index;tstbool(e) +#define MUST2BEBOOL(e1,e2) int exp1=e1.expr_index,exp2=e2.expr_index;tstbool(e1);tstbool(e2) + +%} + +%union { + int yy_int; + int *yy_intp; + string yy_string; + list1 yy_list1; + list2 yy_list2; + expr_t yy_expr; + cost_t yy_cost; + set_t yy_set; + ident_p yy_ident; + char yy_char; + inst_t yy_instance; +} + +%type list1,structlistel +%type structlist,structdecl +%type expr optexpr +%type optcost cost optcommacost +%type optboolexpr optnocoerc mnem emargno tokargno optprop +%type optcommabool optstack subreg tokenexpressionno optregvar +%type tokeninstanceno code stackreplacement optslashnumber +%type tokenexpression +%type tokeninstance +%type optformat +%token IDENT TYPENAME +%token RIDENT,PIDENT,TIDENT,EIDENT +%token LSTRING,STRING +%token NUMBER +%token CIDENT +%token REGISTERHEAD TOKENHEAD EXPRESSIONHEAD CODEHEAD MOVEHEAD TESTHEAD STACKHEAD +%token REGVAR INREG LOOP POINTER FLOAT +%token TIMEFAC SIZEFAC FORMAT RETURN +%token MOVE ERASE ALLOCATE ELLIPS COST REMOVE STACK +%token SEP SAMESIGN SFIT UFIT ROM DEFINED TOSTRING LOWW HIGHW +%token NOCC SETCC SAMECC TEST NOCOERC +%token LCASELETTER +%start machinespec + +%left OR2 +%left AND2 +%left CMPEQ,CMPNE +%left CMPLT,CMPLE,CMPGT,CMPGE +%left RSHIFT,LSHIFT +%left '+','-' +%left '*','/','%' +%nonassoc NOT,COMP,UMINUS +%nonassoc '$' +%% +machinespec + : rcsid constants registersection tokensection + { inbetween(); } + expressionsection codesection movesection testsection stacksection + ; + +rcsid + : /* empty */ + | STRING + { strlookup($1); } + ; + +constants + : /* empty */ + | constants CIDENT '=' NUMBER + { *$2 = $4; } + | constants SIZEFAC '=' NUMBER optslashnumber + { cc1 = $4; cc2 = $5; } + | constants TIMEFAC '=' NUMBER optslashnumber + { cc3 = $4; cc4 = $5; } + | constants FORMAT '=' STRING + { fmt = $4; } + ; +optslashnumber + : /* empty */ + { $$ = 1; } + | '/' NUMBER + { $$ = $2; } + ; + +registersection + : REGISTERHEAD registerdefs + ; +registerdefs + : /* empty */ + | registerdefs registerdef + ; + +registerdef + : IDENT '=' '(' STRING ',' NUMBER list1 ')' optregvar list1 '.' + { register ident_p ip; + register list1 l; + register reginfo r; + int i; + + r=(reginfo) myalloc(sizeof(struct reginfo)); + r->rname = $1; + r->rrepr = $4; + r->rsize = $6; + if($9>=0 && $7!=0) + yyerror("No subregisters allowed in regvar"); + for (i=0;irmembers[i] = 0; + i=0; + for (l=$7;l!=0;l=l->l1next) { + ip=ilookup(l->l1name,LOOKUP); + if (ip->i_type != IREG) + yyerror("Bad member of set"); + chktabsiz(i,MAXMEMBERS,"Member of register"); + r->rmembers[i++] = ip->i_i.i_regno; + } + maxmembers=max(maxmembers,i); + r->rregvar=$9; + if ($9>=0) { + rvused=1; + chktabsiz(nregvar[$9],MAXREGVARS,"Regvar"); + rvnumbers[$9][nregvar[$9]++] = nmachregs; + } + for(i=0;irprop[i] = 0; + ip=ilookup($1,ENTER); + ip->i_type=IREG; + ip->i_i.i_regno=nmachregs; + for (l = $10; l!= 0; l=l->l1next) { + ip = ilookup(l->l1name,HALFWAY); + if (ip->i_type) { + if (ip->i_type != IPRP) + yyerror("Multiple defined symbol"); + else if(machprops[ip->i_i.i_prpno].propset.set_size != r->rsize) + yyerror("property has more than 1 size"); + } else { + chktabsiz(nprops,MAXPROPS,"Property"); + ip->i_type = IPRP; + ip->i_i.i_prpno = nprops; + machprops[nprops].propname = ip; + machprops[nprops++].propset.set_size = r->rsize; + } + r->rprop[ip->i_i.i_prpno>>4] |= (1<<(ip->i_i.i_prpno&017)); + } + chktabsiz(nmachregs,MAXREGS,"Register table"); + machregs[nmachregs++] = r; + } + | error '.' + ; + +optregvar + : /* nothing */ + { $$ = -1; } + | REGVAR + { $$ = reg_any; } + | REGVAR '(' LOOP ')' + { $$ = reg_loop; } + | REGVAR '(' POINTER ')' + { $$ = reg_pointer; } + | REGVAR '(' FLOAT ')' + { $$ = reg_float; } + ; + +tokensection + : TOKENHEAD tkdefs + ; +tkdefs + : /* empty */ + | tkdefs tkdef + ; +tkdef + : IDENT '=' structdecl NUMBER optcost optformat + { register token_p tp; + register ident_p ip; + + chktabsiz(nmachtokens,MAXTOKENS,"Token table"); + tp = &machtokens[nmachtokens]; + tp->t_name = $1; + tp->t_struct = $3; + tp->t_size = $4; + tp->t_cost = $5; + ip = ilookup($1,ENTER); + ip->i_type = ITOK; + ip->i_i.i_tokno = nmachtokens++; + maxtokensize=max(maxtokensize,structsize($3)); + setfields(tp,$6); + } + | error + ; +structdecl + : '{' structlist '}' + { $$ = lookstruct($2); } + ; +structlist + : /* empty */ + { $$=0; } + | structlistel structlist + { $$=(list2) myalloc(sizeof(struct list2str)); + $$->l2next = $2; + $$->l2list = $1; + } + ; +structlistel + : TYPENAME list1 ';' + { $$=(list1) myalloc(sizeof(struct list1str)); + $$->l1next = $2; + $$->l1name = $1; + } + ; + +optcost : /* empty */ + { $$.c_size = $$.c_time = 0; } + | COST '=' '(' expr ',' expr ')' + { MUST2BEINT($4,$6); + $$.c_size = exp1; + $$.c_time = exp2; + } + ; +optformat + : /* empty */ + { $$ = 0; } + | STRING + ; + +expressionsection + : /* empty */ + | EXPRESSIONHEAD tokenexpressions + ; +tokenexpressions + : tokenexpressionline + | tokenexpressionline tokenexpressions + ; +tokenexpressionline + : IDENT '=' tokenexpression + { + { register ident_p ip; + + chktabsiz(nmachsets,MAXSETS,"Expression table"); + machsets[nmachsets] = $3; + ip=ilookup($1,ENTER); + ip->i_type = IEXP; + ip->i_i.i_expno = nmachsets++; + } + } + | error + ; +tokenexpression + : PIDENT + { $$ = machprops[$1->i_i.i_prpno].propset; } + | TIDENT + { register i; + + for(i=0;ii_i.i_tokno+nmachregs+1)>>4] |= + 01<<(($1->i_i.i_tokno+nmachregs+1)&017); + $$.set_size = machtokens[$1->i_i.i_tokno].t_size; + } + | EIDENT + { $$=machsets[$1->i_i.i_expno]; } + | tokenexpression '*' tokenexpression + { register i; + + if (($$.set_size=$1.set_size)==0) + $$.set_size = $3.set_size; + for (i=0;i1) + yyerror("Token pattern too long"); + if ($8!=0) { /* stacking */ + c1_p cp; + chktabsiz(nc1,MAXC1,"Coerc table 1"); + cp = &c1coercs[nc1++]; + cp->c1_texpno = pattokexp[1]; + cp->c1_prop = -1; + cp->c1_codep = $6; + } else if (tokrepllen>1) { /* splitting */ + c2_p cp; + chktabsiz(nc2,MAXC2,"Coerc table 2"); + cp= &c2coercs[nc2++]; + cp->c2_texpno = pattokexp[1]; + cp->c2_nsplit = tokrepllen; + maxsplit=max(maxsplit,tokrepllen); + for (i=0;ic2_repl[i] = replinst[i]; + cp->c2_codep = $6; + if (nallreg>0) + yyerror("No allocates allowed here"); + } else { /* one to one coercion */ + c3_p cp; + chktabsiz(nc3,MAXC3,"Coerc table 3"); + cp= &c3coercs[nc3++]; + if (tokpatlen) + cp->c3_texpno = pattokexp[1]; + else + cp->c3_texpno = 0; + if (nallreg>1) + yyerror("Too many allocates in coercion"); + cp->c3_prop = nallreg==0 ? 0 : allreg[0]; + cp->c3_repl = replinst[0]; + cp->c3_codep = $6; + } + } + } + | error + ; +empattern + : /* empty */ + { empatlen=0; } + | mnemlist optboolexpr + { register i; + + empatexpr = $2; + patbyte(0); + patshort(prevind); + prevind = npatbytes - 3; + maxempatlen = max(empatlen,maxempatlen); + pat(empatlen); + for(i=1;i<=empatlen;i++) + patbyte(patmnem[i]); + pat(empatexpr); + rulecount = npatbytes; + patbyte(1); /* number of different rules with this pattern */ + pat(codebytes); /* first rule */ + } + | ELLIPS + { pattern[rulecount]++; + maxrule= max(maxrule,pattern[rulecount]); + pat(codebytes); + } + ; + +mnemlist + : mnem + { empatlen = 1; patmnem[empatlen] = $1; } + | mnemlist mnem + { chktabsiz(empatlen+1,MAXEMPATLEN,"EM pattern"); + patmnem[++empatlen] = $2; + } + ; +mnem : IDENT + { if(strlen($1)!=3 || ($$=mlookup($1))==0) + yyerror("not an EM-mnemonic"); + } + ; + +stackpattern + : optnocoerc tokenexpressionlist optstack + { register i; + + if (tokpatlen != 0) { + outbyte(($1 ? ( $3 ? DO_XXMATCH: DO_XMATCH ) : DO_MATCH)+(tokpatlen<<5)); + for(i=1;i<=tokpatlen;i++) { + out(pattokexp[i]); + } + } + if ($3 && tokpatlen==0 && empatlen==0) { + outbyte(DO_COERC); + } + if ($3 && !$1 && empatlen!=0) { + outbyte(DO_REMOVE); + out(allexpno); + } + } + ; + +optnocoerc + : /* empty */ + { $$ = 0; } + | NOCOERC ':' + { $$ = 1; } + ; + +tokenexpressionlist + : /* empty */ + { tokpatlen = 0; } + | tokenexpressionlist tokenexpressionno + { chktabsiz(tokpatlen+1,MAXPATLEN,"Token pattern"); + pattokexp[++tokpatlen] = $2; + if (machsets[$2].set_size==0) + yyerror("Various sized set in tokenpattern"); + } + ; + +tokenexpressionno + : tokenexpression + { $$ = exprlookup($1); } + ; + +optstack + : /* empty */ + { $$ = 0; } + | STACK + { $$ = 1; } + ; + +code : + { $$ = codebytes; cchandled=ccspoiled=0; } + initcode restcode + { if (cchandled==0 && ccspoiled!=0) { + outbyte(DO_ERASE); + out(ccregexpr); + } + } + ; + +initcode + : /* empty */ + | initcode remove + | initcode allocate + ; +remove + : REMOVE '(' tokenexpressionno + { curtokexp = $3; } + optcommabool ')' + { outbyte(DO_REMOVE+ ($5!=0 ? 32 : 0)); + out($3); + if ($5!=0) out($5); + } + | REMOVE '(' expr ')' + { if ($3.expr_typ != TYPREG) + yyerror("Expression must be register"); + outbyte(DO_RREMOVE); + out($3.expr_index); + } + ; +optcommabool + : /* empty */ + { $$ = 0; } + | ',' expr + { MUST1BEBOOL($2); + $$ = exp1; + } + ; + +restcode: /* empty */ + | restcode LSTRING expr + { outbyte(DO_LOUTPUT); + out(stringno($2)); + free($2); + out($3.expr_index); + ccspoiled++; + } + | restcode stringlist + { int i; + for(i=0;nstr>0;i++,nstr--) { + if (i%8==0) outbyte(DO_ROUTPUT+(nstr>7 ? 7 : nstr-1)*32); + out(strar[i]); + } + ccspoiled++; + } + | restcode RETURN + { outbyte(DO_PRETURN); } + | restcode move + | restcode erase + | restcode NOCC + { outbyte(DO_ERASE); + out(ccregexpr); + cchandled++; + } + | restcode SAMECC + { cchandled++; } + | restcode SETCC '(' tokeninstanceno ')' + { outbyte(DO_MOVE); + out(ccinstanceno); + out($4); + cchandled++; + } + | restcode TEST '(' tokeninstanceno ')' + { outbyte(DO_MOVE); + out($4); + out(ccinstanceno); + ccspoiled=0; + } + ; + +stringlist + : STRING + { nstr=1; + strar[0]=stringno($1); + free($1); + } + | stringlist STRING + { chktabsiz(nstr,MAXNSTR,"Consecutiv strings"); + strar[nstr++] = stringno($2); + free($2); + } + ; + +move + : MOVE '(' tokeninstanceno ',' tokeninstanceno ')' + { outbyte(DO_MOVE); + out($3); + out($5); + } + ; + +erase + : ERASE '(' expr ')' + { outbyte(DO_ERASE); + out($3.expr_index); + if($3.expr_typ != TYPREG) + yyerror("Bad argument of erase"); + } + ; + +allocate + : ALLOCATE { dealflag=0; } '(' alloclist ')' + { if (dealflag) + outbyte(DO_REALLOCATE); + } + ; + + +alloclist + : allocel + | alloclist optcomma allocel + ; + +allocel + : tokeninstanceno /* deallocate */ + { outbyte(DO_DEALLOCATE); + out($1); + dealflag++; + } + | PIDENT + { allreg[nallreg++] = $1->i_i.i_prpno; + outbyte(DO_ALLOCATE); + out($1->i_i.i_prpno); + } + | PIDENT '=' tokeninstanceno + { allreg[nallreg++] = $1->i_i.i_prpno; + outbyte(DO_ALLOCATE+32); + out($1->i_i.i_prpno); + out($3); + } + ; + +stackreplacement + : /* empty */ + { $$=0; } + | STACK + { $$=1; } + | '{' STACK '}' + { $$=1; } + | stackrepllist + { $$=0; } + ; +stackrepllist + : tokeninstanceno + { tokrepllen=1; replinst[0] = $1; } + | stackrepllist tokeninstanceno + { chktabsiz(tokrepllen+1,MAXPATLEN,"Stack replacement"); + replinst[tokrepllen++] = $2; + } + ; + +emreplacement + : /* empty, normal case */ + | emrepllist + ; +emrepllist + : mnem optexpr + { emrepllen=1; + replmnem[0]=$1; + replexpr[0]=$2.expr_index; + } + | emrepllist mnem optexpr + { chktabsiz(emrepllen+1,MAXEMPATLEN,"EM replacement"); + replmnem[emrepllen]=$2; + replexpr[emrepllen]=$3.expr_index; + emrepllen++; + } + ; + +cost : /* empty */ + { $$.c_size = $$.c_time = 0; + } + | '(' expr ',' expr ')' + { MUST2BEINT($2,$4); + $$.c_size = exp1; + $$.c_time = exp2; + } + | cost '+' '%' '[' tokargno ']' + { $$.c_size = lookup(1,EX_PLUS,$1.c_size, + lookup(0,EX_COST,$5,0)); + $$.c_time = lookup(1,EX_PLUS,$1.c_time, + lookup(0,EX_COST,$5,1)); + } + ; + +movesection + : MOVEHEAD movedefs + ; + +movedefs + : movedef + | movedefs movedef + ; + +movedef + : '(' tokenexpressionno + { curtokexp = $2; } + optboolexpr ',' tokenexpressionno + { curtokexp = $6; + pattokexp[1] = $2; + pattokexp[2] = $6; + tokpatlen=2; + } + optboolexpr ',' code optcommacost ')' + { register move_p mp; + + outbyte(DO_RETURN); + fprintf(cfile,"\n"); + chktabsiz(nmoves,NMOVES,"Move definition table"); + mp = &machmoves[nmoves++]; + mp->m_set1 = $2; + mp->m_expr1= $4; + mp->m_set2 = $6; + mp->m_expr2= $8; + mp->m_cindex=$10; + mp->m_cost = $11; + } + | error + ; + +testsection + : /* empty */ + | TESTHEAD testdefs + ; + +testdefs: testdef + | testdefs testdef + ; + +testdef : '(' tokenexpressionno + { curtokexp = $2; + pattokexp[1] = $2; + pattokexp[2] = cocosetno; + tokpatlen=2; + } + optboolexpr ',' code optcommacost ')' + { register move_p mp; + + outbyte(DO_RETURN); + fprintf(cfile,"\n"); + chktabsiz(nmoves,NMOVES,"Move definition table(tests)"); + mp = &machmoves[nmoves++]; + mp->m_set1 = $2; + mp->m_expr1 = $4; + mp->m_set2 = cocosetno; + mp->m_expr2 = 0; + mp->m_cindex = $6; + mp->m_cost = $7; + } + ; + +stacksection + : STACKHEAD stackdefs + | /* empty */ + ; +stackdefs + : stackdef + | stackdefs stackdef + ; +stackdef + : '(' tokenexpressionno + { curtokexp = $2; + pattokexp[1] = $2; + tokpatlen=1; + } + optboolexpr ',' optprop ',' code optcommacost ')' + { register c1_p cp; + + outbyte(DO_TOKREPLACE); + outbyte(DO_RETURN); + fprintf(cfile,"\n"); + chktabsiz(nc1,MAXC1,"Stacking table"); + cp = &c1coercs[nc1++]; + cp->c1_texpno = $2; + cp->c1_expr = $4; + cp->c1_prop = $6; + cp->c1_codep = $8; + cp->c1_cost = $9; + } + ; + +optprop + : /* empty */ + { $$ = -1; } + | PIDENT + { $$ = $1->i_i.i_prpno; } + ; + +optcommacost + : /* empty */ + { $$.c_size = 0; $$.c_time = 0;} + | ',' cost + { $$ = $2; } + ; + +list1 : /* empty */ + { $$ = 0; } + | optcomma IDENT list1 + { $$=(list1) myalloc(sizeof(struct list1str)); + $$->l1next = $3; + $$->l1name = $2; + } + ; +optcomma: /* nothing */ + | ',' + ; +emargno : NUMBER + { if ($1<1 || $1>empatlen) + yyerror("Number after $ out of range"); + $$ = $1; + } + ; +tokargno + : NUMBER + { if ($1<1 || $1>tokpatlen) + yyerror("Number within %[] out of range"); + $$ = $1; + } + ; +expr : '$' emargno + { $$.expr_index = lookup(0,EX_ARG,$2,0); $$.expr_typ = argtyp(patmnem[$2]); + } + | NUMBER + { $$.expr_index = lookup(0,EX_CON,(int)($1&0177777),(int)($1>>16)); + $$.expr_typ = TYPINT; + } + | STRING + { $$.expr_index = lookup(0,EX_STRING,strlookup($1),0); + $$.expr_typ = TYPSTR; + } + | RIDENT + { $$.expr_index = lookup(0,EX_REG,$1->i_i.i_regno,0); + $$.expr_typ = TYPREG; + } + | '%' '[' tokargno '.' IDENT ']' + { $$.expr_index = lookup(0,EX_TOKFIELD,$3, + findstructel(pattokexp[$3],$5,&$$.expr_typ)); + } + | '%' '[' tokargno subreg ']' + { chkregexp(pattokexp[$3]); + $$.expr_index = lookup(0,EX_SUBREG,$3,$4); + $$.expr_typ = TYPREG; + } + | '%' '[' LCASELETTER subreg ']' + { if ($3 >= 'a'+nallreg) + yyerror("Bad letter in %[x] construct"); + $$.expr_index = lookup(0,EX_ALLREG,$3-'a'+1,$4); + $$.expr_typ = TYPREG; + } + | '%' '[' IDENT ']' + { $$.expr_index = lookup(0,EX_TOKFIELD,0, + findstructel(curtokexp,$3,&$$.expr_typ)); + } + | TOSTRING '(' expr ')' + { MUST1BEINT($3); + $$.expr_index = lookup(0,EX_TOSTRING,exp1,0); + $$.expr_typ = TYPSTR; + } + | DEFINED '(' expr ')' + { $$.expr_index = lookup(0,EX_DEFINED,$3.expr_index,0); + $$.expr_typ = TYPBOOL; + } + | SAMESIGN '(' expr ',' expr ')' + { MUST2BEINT($3,$5); + $$.expr_index = lookup(1,EX_SAMESIGN,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | SFIT '(' expr ',' expr ')' + { MUST2BEINT($3,$5); + $$.expr_index = lookup(0,EX_SFIT,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | UFIT '(' expr ',' expr ')' + { MUST2BEINT($3,$5); + $$.expr_index = lookup(0,EX_UFIT,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | ROM '(' emargno ',' NUMBER ')' + { if ($5<1 || $5>3) + yyerror("Second argument of rom must be >=1 and <=3"); + $$.expr_index = lookup(0,EX_ROM,$3-1,$5-1); + $$.expr_typ = TYPINT; + } + | LOWW '(' emargno ')' + { + $$.expr_index = lookup(0,EX_LOWW,$3-1,0); + $$.expr_typ = TYPINT; + } + | HIGHW '(' emargno ')' + { + $$.expr_index = lookup(0,EX_HIGHW,$3-1,0); + $$.expr_typ = TYPINT; + } + | '(' expr ')' + { $$ = $2; } + | expr CMPEQ expr + { switch(commontype($1,$3)) { + case TYPINT: + $$.expr_index = lookup(1,EX_NCPEQ,$1.expr_index,$3.expr_index); + break; + case TYPSTR: + $$.expr_index = lookup(1,EX_SCPEQ,$1.expr_index,$3.expr_index); + break; + case TYPREG: + $$.expr_index = lookup(1,EX_RCPEQ,$1.expr_index,$3.expr_index); + break; + } + $$.expr_typ = TYPBOOL; + } + | expr CMPNE expr + { switch(commontype($1,$3)) { + case TYPINT: + $$.expr_index = lookup(1,EX_NCPNE,$1.expr_index,$3.expr_index); + break; + case TYPSTR: + $$.expr_index = lookup(1,EX_SCPNE,$1.expr_index,$3.expr_index); + break; + case TYPREG: + $$.expr_index = lookup(1,EX_RCPNE,$1.expr_index,$3.expr_index); + break; + } + $$.expr_typ = TYPBOOL; + } + | expr CMPGT expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_NCPGT,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr CMPGE expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_NCPGE,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr CMPLT expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_NCPLT,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr CMPLE expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_NCPLE,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr OR2 expr + { MUST2BEBOOL($1,$3); + $$.expr_index = lookup(0,EX_OR2,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr AND2 expr + { MUST2BEBOOL($1,$3); + $$.expr_index = lookup(0,EX_AND2,exp1,exp2); + $$.expr_typ = TYPBOOL; + } + | expr '+' expr + { switch(commontype($1,$3)) { + case TYPINT: + $$.expr_index = lookup(1,EX_PLUS,$1.expr_index,$3.expr_index); + break; + case TYPSTR: + $$.expr_index = lookup(0,EX_CAT,$1.expr_index,$3.expr_index); + break; + default: + yyerror("Bad types"); + } + $$.expr_typ = $1.expr_typ; + } + | expr '-' expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_MINUS,exp1,exp2); + $$.expr_typ = TYPINT; + } + | expr '*' expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(1,EX_TIMES,exp1,exp2); + $$.expr_typ = TYPINT; + } + | expr '/' expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_DIVIDE,exp1,exp2); + $$.expr_typ = TYPINT; + } + | expr '%' expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_MOD,exp1,exp2); + $$.expr_typ = TYPINT; + } + | expr LSHIFT expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_LSHIFT,exp1,exp2); + $$.expr_typ = TYPINT; + } + | expr RSHIFT expr + { MUST2BEINT($1,$3); + $$.expr_index = lookup(0,EX_RSHIFT,exp1,exp2); + $$.expr_typ = TYPINT; + } + | NOT expr + { MUST1BEBOOL($2); + $$.expr_index = lookup(0,EX_NOT,exp1,0); + $$.expr_typ = TYPBOOL; + } + | COMP expr + { MUST1BEINT($2); + $$.expr_index = lookup(0,EX_COMP,exp1,0); + $$.expr_typ = TYPINT; + } + | INREG '(' expr ')' + { MUST1BEINT($3); + $$.expr_index = lookup(0,EX_INREG,exp1,0); + $$.expr_typ = TYPINT; + } + | REGVAR '(' expr ')' + { MUST1BEINT($3); + $$.expr_index = lookup(0,EX_REGVAR,exp1,0); + $$.expr_typ = TYPREG; + } +/* + | '-' expr %prec UMINUS + { MUST1BEINT($2); + $$.expr_index = lookup(0,EX_UMINUS,exp1,0); + $$.expr_typ = TYPINT; + } +*/ + ; + +subreg : /* empty */ + { $$=0; } + | '.' NUMBER + { $$=$2; } + ; + +optboolexpr + : /* empty */ + { $$ = 0; } + | expr + { MUST1BEBOOL($1); + $$=exp1; + } + ; +optexpr + : /* empty */ + { $$.expr_typ=0; + $$.expr_index=0; + } + | expr + ; + +tokeninstanceno + : tokeninstance + { $$ = instno($1); } + ; + +tokeninstance + : '%' '[' tokargno subreg ']' + { register i; + + if ($4!=0) + chkregexp(pattokexp[$3]); + $$.in_which = IN_COPY; + $$.in_info[0] = $3; + $$.in_info[1] = $4; + for (i=2;ii_i.i_regno; + for (i=1;i= 'a'+nallreg) + yyerror("Bad letter in %[x] construct"); + $$.in_which = IN_ALLOC; + $$.in_info[0] = $3-'a'; + $$.in_info[1] = $4; + for (i=2;ii_i.i_tokno; + for(i=0;ii_i.i_tokno].t_fields[i].t_type) + yyerror("Attribute %d has wrong type",i+1); + $$.in_info[i+1] = arexp[i].expr_index; + } + for (i=narexp+1;ii_i.i_tokno].t_fields[i-1].t_type!=0) + yyerror("Too few attributes"); + $$.in_info[i] = 0; + } + } + ; + +attlist + : /* empty */ + { narexp = 0; } + | attlist ',' expr + { arexp[narexp++] = $3; } + ; + +%% + +char * myalloc(n) { + register char *p; + + p= (char*) malloc(n); + if (p==0) { + yyerror("Out of core"); + exit(1); + } + return(p); +} + +tstint(e) expr_t e; { + + if(e.expr_typ != TYPINT) + yyerror("Must be integer expression"); +} + +tstbool(e) expr_t e; { + + if(e.expr_typ != TYPBOOL) + yyerror("Must be boolean expression"); +} + +structsize(s) register list2 s; { + register list1 l; + register sum; + + sum = 0; + while ( s != 0 ) { + l = s->l2list->l1next; + while ( l != 0 ) { + sum++; + l = l->l1next; + } + s = s->l2next; + } + return(sum); +} + +list2 lookstruct(ll) list2 ll; { + list3 l3; + list2 l21,l22; + list1 l11,l12; + + for (l3=structpool;l3 != 0;l3=l3->l3next) { + for (l21=l3->l3list,l22=ll;l21!=0 && l22!=0; + l21=l21->l2next,l22=l22->l2next) { + for(l11=l21->l2list,l12=l22->l2list; + l11!=0 && l12!=0 && strcmp(l11->l1name,l12->l1name)==0; + l11=l11->l1next,l12=l12->l1next) + ; + if (l11!=0 || l12!=0) + goto contin; + } + if(l21==0 && l22==0) + return(l3->l3list); + contin:; + } + l3 = (list3) myalloc(sizeof(struct list3str)); + l3->l3next=structpool; + l3->l3list=ll; + structpool=l3; + return(ll); +} + +instno(inst) inst_t inst; { + register i,j; + + for(i=1;itokpatlen) + yyerror("Number within %[] out of range"); + if (*s == ']') { + s++; + *p++ = PR_TOK; + *p++ = num; + } else if (*s++ != '.') + yyerror("Bad character following %%[digit in codestring"); + else { + char field[256]; + register char *f=field; + int type,offset; + + while( *s != ']' && *s != 0) + *f++ = *s++; + *f++ = 0; + if (*s != ']') + yyerror("Unterminated %[] construction in codestring"); + else + s++; + if (isdigit(field[0])) { + chkregexp(pattokexp[num]); + *p++ = PR_SUBREG; + *p++ = num; + *p++ = atoi(field); + } else { + offset = findstructel(pattokexp[num],field,&type); + *p++ = PR_TOKFLD; + *p++ = num; + *p++ = offset; + } + } + } else if (*s >= 'a' && *s < 'a'+nallreg) { + int reg,subreg; + reg = *s++ -'a'+1; + if(*s == ']') + subreg = 255; + else { + if (*s != '.') + yyerror("Bad character following %%[x in codestring"); + s++; + if(!isdigit(*s)) + yyerror("Bad character following %%[x. in codestring"); + subreg = *s - '0'; + s++; + if(*s != ']') + yyerror("Bad character following %%[x.y in codestring"); + } + s++; + *p++ = PR_ALLREG; + *p++ = reg; + *p++ = subreg; + } else + yyerror("Bad character following %%[ in codestring"); + } + *p++ = 0; + return(strlookup(buf)); +} + +tabovf(tablename) string tablename; { + char buf[256]; + + sprintf(buf,"%s overflow",tablename); + yyerror(buf); + exit(-1); +} + +main(argc,argv) char *argv[]; { + + while (--argc) { + ++argv; + if (argv[0][0]=='-') { + switch (argv[0][1]) { + case 'h': + hname= &argv[0][2]; + break; + case 'c': + cname= &argv[0][2]; + break; + default: + fprintf(stderr,"Bad flag %s\n",argv[0]); + break; + } + } else { + iname= argv[0]; + } + } + inithash(); + initio(); + inittables(); + yyparse(); + if (nerrors==0) { + compueq(); + hashpatterns(); + finishio(); + verbose(); + } + debug(); + exit(nerrors); +} + +lookup(comm,operator,lnode,rnode) { + register node_p p; + + for (p=nodes+1;pex_operator != operator) + continue; + if (!(p->ex_lnode == lnode && p->ex_rnode == rnode || + comm && p->ex_lnode == rnode && p->ex_rnode == lnode)) + continue; + return(p-nodes); + } + if (lastnode >= &nodes[MAXNODES]) + yyerror("node table overflow"); + lastnode++; + p->ex_operator = operator; + p->ex_lnode = lnode; + p->ex_rnode = rnode; + return(p-nodes); +} + +compueq() { + register i,j; + + for (i=1;i>4]; + int member; + + rp1 = machregs[r1]; rp2 = machregs[r2]; + for (i=0;i<((nprops+15)>>4);i++) + if (rp1->rprop[i] != rp2->rprop[i]) + return(0); + for (i=0;i<((MAXREGS+15)>>4);i++) + regbits[i] = 0; + for (i=0;irmembers[i]) + regbits[member>>4] |= (1<<(member&017)); + } + for (i=0;irmembers[i]; + if (regbits[member>>4]&(1<<(member&017))) + return(0); + } + return(1); +} + +unsigned hash(name) register string name; { + register unsigned sum; + register i; + + for (sum=i=0;*name;i+=3) + sum ^= (*name++)<<(i&07); + return(sum); +} + +ident_p ilookup(name,enterf) string name; int enterf; { + register ident_p p,*pp; + + pp = &identtab[hash(name)%ITABSIZE]; + while (*pp != 0) { + if (strcmp((*pp)->i_name,name)==0) + if (enterf != ENTER) + return(*pp); + else + yyerror("Multiply defined symbol"); + pp = &(*pp)->i_next; + } + if (enterf == LOOKUP) + yyerror("Undefined symbol"); + if (enterf == JUSTLOOKING) + return(0); + p = *pp = (ident_p) myalloc(sizeof(ident_t)); + p->i_name = name; + p->i_next = 0; + p->i_type = 0; + return(p); +} + +initio() { + + if (iname!=0 && freopen(iname,"r",stdin)==NULL) { + fprintf(stderr,"Can't open %s\n",iname); + exit(-1); + } + if ((cfile=fopen(cname,"w"))==NULL) { + fprintf(stderr,"Can't create %s\n",cname); + exit(-1); + } + if ((hfile=fopen(hname,"w"))==NULL) { + fprintf(stderr,"Can't create %s\n",hname); + exit(-1); + } + fprintf(cfile,"#include \"param.h\"\n"); + fprintf(cfile,"#include \"tables.h\"\n"); + fprintf(cfile,"#include \"types.h\"\n"); + fprintf(cfile,"#include \n"); + fprintf(cfile,"#include \"data.h\"\n"); + fprintf(cfile,"\nbyte coderules[] = {\n"); + patbyte(0); +} + +exprlookup(sett) set_t sett; { + register i,j,ok; + + for(i=0;irname = "cc reg"; + r->rrepr = "CC"; + r->rsize = -1; + r->rregvar= -1; + for(i=0;irmembers[i] = 0; + for(i=0;irprop[i] = 0; + r->rprop[cocopropno>>4] |= (1<<(cocopropno&017)); + chktabsiz(nmachregs,MAXREGS,"Register table"); + machregs[nmachregs++] = r; + inst.in_which = IN_RIDENT; + inst.in_info[0] = nmachregs-1; + for(i=1;i>4] |= (01<<(nmachregs&017)); + cocosetno=exprlookup(sett); +} + +outregs() { + register i,j,k; + static short rset[(MAXREGS+15)>>4]; + int t,ready; + + fprintf(cfile,"char stregclass[] = {\n"); + for (i=0;irrepr), + machregs[i]->rsize); + if (maxmembers!=0) { + fprintf(cfile,",{"); + for(j=0;jrmembers[j]); + /* now compute and print set of registers + * that clashes with this register. + * A register clashes with al its children (and theirs) + * and with all their parents. + */ + for (j=0;j<((MAXREGS+15)>>4);j++) + rset[j]=0; + rset[i>>4] |= (1<<(i&017)); + do { + ready=1; + for (j=1;j>4]&(1<<(j&017))) + for (k=0;krmembers[k])!=0) { + if ((rset[t>>4]&(1<<(t&017)))==0) + ready=0; + rset[t>>4] |= (1<<(t&017)); + } + } while (!ready); + do { + ready=1; + for (j=1;jrmembers[k])!=0) + if (rset[t>>4]&(1<<(t&017))) { + if (rset[j>>4]&(1<<(j&017))==0) + ready=0; + rset[j>>4] |= (1<<(j&017)); + } + } while (!ready); + fprintf(cfile,"},{"); + for (j=0;j<((nmachregs+15)>>4);j++) + fprintf(cfile,"%d,",rset[j]); + fprintf(cfile,"}"); + } + if (machregs[i]->rregvar>=0) + fprintf(cfile,",1"); + fprintf(cfile,"},\n"); + } + fprintf(cfile,"};\n\n"); +} + +finishio() { + register i; + register node_p np; + int j; + int setsize; + register move_p mp; + + fprintf(cfile,"};\n\n"); + if (wsize>0) + fprintf(hfile,"#define TEM_WSIZE %d\n",wsize); + else + yyerror("Wordsize undefined"); + if (psize>0) + fprintf(hfile,"#define TEM_PSIZE %d\n",psize); + else + yyerror("Pointersize undefined"); + if (bsize>=0) + fprintf(hfile,"#define TEM_BSIZE %d\n",bsize); + else + yyerror("EM_BSIZE undefined"); + if (fmt!=0) + fprintf(hfile,"#define WRD_FMT \"%s\"\n",fmt); + fprintf(hfile,"#define MAXALLREG %d\n",maxallreg); + setsize = (nmachregs+1 + nmachtokens + 15)>>4; + fprintf(hfile,"#define SETSIZE %d\n",setsize); + fprintf(hfile,"#define NPROPS %d\n",nprops); + fprintf(hfile,"#define NREGS %d\n",nmachregs); + fprintf(hfile,"#define REGSETSIZE %d\n",(nmachregs+15)>>4); + fprintf(hfile,"#define TOKENSIZE %d\n",maxtokensize); + fprintf(hfile,"#define MAXMEMBERS %d\n",maxmembers); + fprintf(hfile,"#define LONGESTPATTERN %d\n",maxempatlen); + fprintf(hfile,"#define MAXRULE %d\n",maxrule); + fprintf(hfile,"#define NMOVES %d\n",nmoves); + fprintf(hfile,"#define NC1 %d\n",nc1); + if (nc2) { + assert(maxsplit!=0); + fprintf(hfile,"#define NC2 %d\n",nc2); + fprintf(hfile,"#define MAXSPLIT %d\n",maxsplit); + } + fprintf(hfile,"#define NC3 %d\n",nc3); + outregs(); + fprintf(cfile,"tkdef_t tokens[] = {\n"); + for(i=0;iex_operator,np->ex_lnode, + np->ex_rnode); + fprintf(cfile,"};\n\nstring codestrings[] = {\n"); + for(i=0;im_set1, mp->m_expr1, + mp->m_set2, mp->m_expr2, + mp->m_cindex, + mp->m_cost.c_size,mp->m_cost.c_time); + } + fprintf(cfile,"};\n\nbyte pattern[] = {\n"); + for (i=0;irregvar<0 && + (machprops[i].propset.set_val[j>>4]&(1<<(j&017)))) + fprintf(cfile,"\t&machregs[%d],\n",j-1); + } + fprintf(cfile,"\t0\n};\n"); + } + fprintf(cfile,"struct reginfo **reglist[] = {\n"); + for (i=0;i0) + fprintf(cfile,"struct regassigned ratar%d[%d];\n", + i,nregvar[i]); + for (i=0;i<4;i++) if (nregvar[i]>0) { + fprintf(cfile,"int rvtar%d[] = {",i); + for (j=0;j0) + fprintf(cfile,"\trvtar%d,\n",i); + else + fprintf(cfile,"\t0,\n"); + fprintf(cfile,"};\n\nstruct regassigned *regassigned[] = {\n"); + for (i=0;i<4;i++) + if (nregvar[i]>0) + fprintf(cfile,"\tratar%d,\n",i); + else + fprintf(cfile,"\t0,\n"); + fprintf(cfile,"};\n"); +} + +verbose() { + + fprintf(stderr,"Codebytes %d\n",codebytes); + fprintf(stderr,"Registers %d(%d)\n",nmachregs,MAXREGS); + fprintf(stderr,"Properties %d(%d)\n",nprops,MAXPROPS); + fprintf(stderr,"Tokens %d(%d)\n",nmachtokens,MAXTOKENS); + fprintf(stderr,"Sets %d(%d)\n",nmachsets,MAXSETS); + fprintf(stderr,"Tokeninstances %d(%d)\n",narinstance,MAXINSTANCE); + fprintf(stderr,"Strings %d(%d)\n",ncodestrings,MAXSTRINGS); + fprintf(stderr,"Enodes %d(%d)\n",lastnode-nodes,MAXNODES); + fprintf(stderr,"Patbytes %d(%d)\n",npatbytes,MAXPATTERN); +} + +inbetween() { + register ident_p ip; + register i,j; + register move_p mp; + + lookident=1; /* for lexical analysis */ + + chktabsiz(nmachsets+1,MAXSETS,"Expressiontable"); + for (i=0;ii_type=IEXP; + ip->i_i.i_expno = nmachsets++; + + for (i=0;ii_type=IEXP; + allexpno = ip->i_i.i_expno = nmachsets++; + mp = &machmoves[nmoves++]; + mp->m_set1 = cocosetno; + mp->m_expr1 = 0; + mp->m_set2 = nmachsets-1; + mp->m_expr2 = 0; + mp->m_cindex = 0; + mp->m_cost.c_size = 0; + mp->m_cost.c_time = 0; + + /* + * Create sets of registers per property + */ + + for (i=0;irprop[i>>4]&(1<<(i&017))) + sp[j>>4] |= (1<<(j&017)); + } +} + +formconversion(p,tp) register char *p; register token_p tp; { + char buf[256]; + register char *q=buf; + char field[256]; + register char *f; + int i; + + if (p==0) + return(0); + while (*p) switch(*p) { + default: *q++ = *p++; continue; + case '%': + p++; + if(*p == '%') { + *q++ = *p++; + continue; + } + if (*p == '[') + p++; + else + yyerror("Bad character after % in format"); + f=field; + while (*p != 0 && *p != ']') + *f++ = *p++; + *f++ = 0; + if (*p == ']') + p++; + else + yyerror("Unterminated %[] construct in format"); + for (i=0;it_fields[i].t_sname)==0) + break; + if (i==TOKENSIZE-1) + yyerror("Unknown field in %[] construct in format"); + *q++ = i+1; + } + *q++ = 0; + return(strlookup(buf)); +} + +setfields(tp,format) register token_p tp; string format; { + register i; + list2 ll; + register list1 l; + int type; + + for(i=0;it_fields[i].t_type = 0; + i=0; + for(ll=tp->t_struct;ll!=0;ll=ll->l2next) { + l=ll->l2list; + if(strcmp(l->l1name,"REGISTER")==0) + type = TYPREG; + else if (strcmp(l->l1name,"INT")==0) + type = TYPINT; + else type = TYPSTR; + for(l=l->l1next;l!=0;l=l->l1next) { + tp->t_fields[i].t_type = type; + tp->t_fields[i].t_sname = l->l1name; + i++; + } + } + if (format != 0) + tp->t_format = formconversion(format,tp); + else + tp->t_format = -1; +} + +chkregexp(number) { + register i; + + for(i=nmachregs+1;i>4]&(01<<(i&017))) + yyerror("No tokens allowed in this set"); +} + +findstructel(number,name,t) string name; int *t; { + register i; + register token_p tp; + register list2 structdecl; + int offset; + + for(i=1;i<=nmachregs;i++) + if (machsets[number].set_val[i>>4]&(01<<(i&017))) + yyerror("No registers allowed in this set"); + structdecl = 0; + for (i=nmachregs+1;i>4]&(01<<(i&017))) { + if (structdecl == 0) { + structdecl = machtokens[i-(nmachregs+1)].t_struct; + tp = &machtokens[i-(nmachregs+1)]; + } else if(structdecl != machtokens[i-(nmachregs+1)].t_struct) + yyerror("Multiple structs in this set"); + } + } + if (structdecl == 0) { + yyerror("No structs in this set"); + return(0); + } + for(offset=0;offsett_fields[offset].t_type != 0 && + strcmp(tp->t_fields[offset].t_sname,name)==0) { + *t = tp->t_fields[offset].t_type; + return(offset+1); + } + yyerror("No such field in this struct"); + return(0); +} + +extern char em_flag[]; + +argtyp(mn) { + + switch(em_flag[mn-sp_fmnem]&EM_PAR) { + case PAR_W: + case PAR_S: + case PAR_Z: + case PAR_O: + case PAR_N: + case PAR_L: + case PAR_F: + case PAR_R: + case PAR_C: + return(TYPINT); + default: + return(TYPSTR); + } +} + +commontype(e1,e2) expr_t e1,e2; { + + if(e1.expr_typ != e2.expr_typ) + yyerror("Type incompatibility"); + return(e1.expr_typ); +} + +extern char em_mnem[][4]; + +#define HASHSIZE (2*(sp_lmnem-sp_fmnem)) + +struct hashmnem { + char h_name[3]; + byte h_value; +} hashmnem[HASHSIZE]; + +inithash() { + register i; + + for(i=0;i<=sp_lmnem-sp_fmnem;i++) + enter(em_mnem[i],i+sp_fmnem); +} + +enter(name,value) char *name; { + register unsigned h; + + h=hash(name)%HASHSIZE; + while (hashmnem[h].h_name[0] != 0) + h = (h+1)%HASHSIZE; + strncpy(hashmnem[h].h_name,name,3); + hashmnem[h].h_value = value; +} + +int mlookup(name) char *name; { + register unsigned h; + + h = hash(name)%HASHSIZE; + while (strncmp(hashmnem[h].h_name,name,3) != 0 && + hashmnem[h].h_name[0] != 0) + h = (h+1)%HASHSIZE; + return(hashmnem[h].h_value&BMASK); /* 0 if not found */ +} + +hashpatterns() { + short index; + register byte *bp,*tp; + register short i; + unsigned short hashvalue; + int patlen; + + index = prevind; + while (index != 0) { + bp = &pattern[index]; + tp = &bp[PO_MATCH]; + i = *tp++&BMASK; + if (i==BMASK) { + i = *tp++&BMASK; + i |= (*tp++&BMASK)<>BSHIFT; + hashvalue &= BMASK; + bp[PO_NEXT] = pathash[hashvalue]&BMASK; + bp[PO_NEXT+1] = pathash[hashvalue]>>BSHIFT; + pathash[hashvalue] = i; + } +} + +debug() { + register i,j; + + for(i=0;ii_next) + printf("%-14s %1d %3d\n",ip->i_name, + ip->i_type,ip->i_i.i_regno); + } + + for(i=2;irname,rp->rrepr,rp->rsize); + for(j=0;jrmembers[j] != 0) + printf(", %s",machregs[rp->rmembers[j]]->rname); + printf(")"); + for(j=0;jrprop[j>>4]&(1<<(j&017))) + printf(", %s",machprops[j].propname->i_name); + printf(".\n"); + } +} + +out(n) { + + assert(n>=0); + if (n<128) + outbyte(n); + else { + outbyte(n/256+128); + outbyte(n%256); + } +} + +outbyte(n) { + + fprintf(cfile,"%d, ",n&BMASK); + codebytes++; +} + +pat(n) { + + assert(n>=0); + if (n<128) + patbyte(n); + else { + patbyte(n/256+128); + patbyte(n%256); + } +} + +patshort(n) { + + patbyte(n&BMASK); + patbyte(n>>BSHIFT); +} + +patbyte(n) { + + chktabsiz(npatbytes,MAXPATTERN,"Pattern table"); + pattern[npatbytes++] = n; +} + +max(a,b) { + + if (a>b) + return(a); + return(b); +} + +#include "bootlex.c" diff --git a/util/cgg/bootlex.l b/util/cgg/bootlex.l new file mode 100644 index 00000000..c283e079 --- /dev/null +++ b/util/cgg/bootlex.l @@ -0,0 +1,191 @@ +%{ + +#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++; +} diff --git a/util/cpp/cpp.6 b/util/cpp/cpp.6 new file mode 100644 index 00000000..38d46ed7 --- /dev/null +++ b/util/cpp/cpp.6 @@ -0,0 +1,184 @@ +.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 " 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) 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 diff --git a/util/data/Makefile b/util/data/Makefile new file mode 100644 index 00000000..97e4c2aa --- /dev/null +++ b/util/data/Makefile @@ -0,0 +1,33 @@ +# $Header$ +d=../.. +h=$d/h +l=$d/lib + +OBJ=em_mnem.o em_pseu.o em_flag.o em_ptyp.o + +DATA_PATH=em_data.a + +CFLAGS=-O -I$h + +$(DATA_PATH): $(OBJ) + ar rv $(DATA_PATH) $(OBJ) + -ranlib $(DATA_PATH) + +em_flag.o: $h/em_flag.h + +em_ptyp.o: $h/em_flag.h $h/em_ptyp.h + +install : $(DATA_PATH) + -cmp -s $(DATA_PATH) $l/$(DATA_PATH) || cp $(DATA_PATH) $l/$(DATA_PATH) + +cmp : $(DATA_PATH) + cmp $(DATA_PATH) $l/$(DATA_PATH) + +clean: + rm -f $(OBJ) $(DATA_PATH) *.old + +opr: + make pr ^ opr + +pr: + @pr Makefile em_mnem.c em_pseu.c em_flag.c em_ptyp.c diff --git a/util/ego/bo/Makefile b/util/ego/bo/Makefile new file mode 100644 index 00000000..043cb382 --- /dev/null +++ b/util/ego/bo/Makefile @@ -0,0 +1,60 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +bo.c + +OFILES=\ +bo.o + +HFILES= + +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)/stack_chg.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m \ +$(SHR)/stack_chg.m $(SHR)/go.m + +bo: $(OFILES) + $(CC) -o bo $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +bo_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o bo -.c $(LDFLAGS) bo.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/bo/bo.c b/util/ego/bo/bo.c new file mode 100644 index 00000000..693d67ed --- /dev/null +++ b/util/ego/bo/bo.c @@ -0,0 +1,318 @@ +/* B R A N C H O P T I M I Z A T I O N + * + * B O . C + */ + + +#include +#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 + +#define newbolpx() (lpext_p) newstruct(lpext_ra) +#define oldbolpx(x) oldstruct(lpext_ra,x) + +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; + + for (pi = Lfirst(p->p_loops); pi != (Lindex) 0; + pi = Lnext(pi,p->p_loops)) { + lp = (loop_p) Lelem(pi); + lp->lp_extend = newbolpx(); + } +} + + +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); + oldbolpx(lp->lp_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); +} diff --git a/util/ego/ca/Makefile b/util/ego/ca/Makefile new file mode 100644 index 00000000..9677363a --- /dev/null +++ b/util/ego/ca/Makefile @@ -0,0 +1,65 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +ca.c ca_put.c + +OFILES=\ +ca.o ca_put.o + +HFILES=\ +ca.h ca_put.h + +PRFILES=\ +$(CFILES) $(HFILES) Makefile + +SHARE_OFILES=\ +$(SHR)/get.o $(SHR)/alloc.o $(SHR)/global.o $(SHR)/aux.o $(SHR)/debug.o \ +$(SHR)/lset.o $(SHR)/cset.o $(SHR)/files.o $(SHR)/map.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/aux.m $(SHR)/debug.m \ +$(SHR)/lset.m $(SHR)/cset.m $(SHR)/files.m $(SHR)/map.m + +ca: $(OFILES) + $(CC) -o ca $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +ca_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o ca -.c $(LDFLAGS) ca.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/ca/ca.c b/util/ego/ca/ca.c new file mode 100644 index 00000000..abf1779a --- /dev/null +++ b/util/ego/ca/ca.c @@ -0,0 +1,271 @@ +/* + * 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 +#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 (head != (line_p) 0 && 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); +} diff --git a/util/ego/ca/ca.h b/util/ego/ca/ca.h new file mode 100644 index 00000000..adf7c876 --- /dev/null +++ b/util/ego/ca/ca.h @@ -0,0 +1,15 @@ +/* + * 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[]; diff --git a/util/ego/ca/ca_put.c b/util/ego/ca/ca_put.c new file mode 100644 index 00000000..58cee1b6 --- /dev/null +++ b/util/ego/ca/ca_put.c @@ -0,0 +1,413 @@ +#include +#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;lengthab_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 (lmap != (line_p *) 0) { + oldmap(lmap,llength); + lmap = (line_p *) 0; + } +} + +cputmagic(lf) + FILE *lf; +{ + /* write the magic number */ + + outfile = lf; + coutshort(sp_magic); +} diff --git a/util/ego/ca/ca_put.h b/util/ego/ca/ca_put.h new file mode 100644 index 00000000..46f86f97 --- /dev/null +++ b/util/ego/ca/ca_put.h @@ -0,0 +1,9 @@ +/* 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(); diff --git a/util/ego/cf/Makefile b/util/ego/cf/Makefile new file mode 100644 index 00000000..6fd7cc1f --- /dev/null +++ b/util/ego/cf/Makefile @@ -0,0 +1,82 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +cf.c cf_succ.c cf_idom.c cf_loop.c + +OFILES=\ +cf.o cf_idom.o cf_loop.o cf_succ.o + +HFILES=\ +cf.h cf_succ.h cf_idom.h cf_loop.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 + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m \ +$(SHR)/debug.m $(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m \ +$(SHR)/cset.m $(SHR)/aux.m + +cf: $(OFILES) + $(CC) -o cf $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +cf_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o cf -.c $(LDFLAGS) cf.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/cf/cf.c b/util/ego/cf/cf.c new file mode 100644 index 00000000..f1d70cb0 --- /dev/null +++ b/util/ego/cf/cf.c @@ -0,0 +1,520 @@ +/* C O N T R O L F L O W + * + * M A I N R O U T I N E + */ + +#include +#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 "../../../h/em_pseu.h" +#include "../../../h/em_spec.h" +#include "../../../h/em_flag.h" +#include "../share/def.h" +#include "cf.h" +#include "cf_succ.h" +#include "cf_idom.h" +#include "cf_loop.h" + +#define newcfbx() (bext_p) newstruct(bext_cf) +#define oldcfbx(x) oldstruct(bext_cf,x) + +extern char em_flag[]; + +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); +} diff --git a/util/ego/cf/cf.h b/util/ego/cf/cf.h new file mode 100644 index 00000000..2a14b0ff --- /dev/null +++ b/util/ego/cf/cf.h @@ -0,0 +1,16 @@ +/* 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 + +#define newcflpx() (lpext_p) newstruct(lpext_cf) +#define oldcflpx(x) oldstruct(lpext_cf,x) diff --git a/util/ego/cf/cf_idom.c b/util/ego/cf/cf_idom.c new file mode 100644 index 00000000..6e969559 --- /dev/null +++ b/util/ego/cf/cf_idom.c @@ -0,0 +1,138 @@ +/* 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 */ +} diff --git a/util/ego/cf/cf_idom.h b/util/ego/cf/cf_idom.h new file mode 100644 index 00000000..7a644aba --- /dev/null +++ b/util/ego/cf/cf_idom.h @@ -0,0 +1,15 @@ +/* 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. + */ diff --git a/util/ego/cf/cf_loop.c b/util/ego/cf/cf_loop.c new file mode 100644 index 00000000..e0a6ffe1 --- /dev/null +++ b/util/ego/cf/cf_loop.c @@ -0,0 +1,400 @@ +/* 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; +} diff --git a/util/ego/cf/cf_loop.h b/util/ego/cf/cf_loop.h new file mode 100644 index 00000000..47365102 --- /dev/null +++ b/util/ego/cf/cf_loop.h @@ -0,0 +1,14 @@ +/* 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.). + */ diff --git a/util/ego/cf/cf_succ.c b/util/ego/cf/cf_succ.c new file mode 100644 index 00000000..7ec419be --- /dev/null +++ b/util/ego/cf/cf_succ.c @@ -0,0 +1,250 @@ +/* C O N T R O L F L O W + * + * C F _ S U C C . C + */ + + +#include +#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); + } + } + } + } + } +} diff --git a/util/ego/cf/cf_succ.h b/util/ego/cf/cf_succ.h new file mode 100644 index 00000000..b475d1a7 --- /dev/null +++ b/util/ego/cf/cf_succ.h @@ -0,0 +1,10 @@ +/* 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. + */ diff --git a/util/ego/cj/Makefile b/util/ego/cj/Makefile new file mode 100644 index 00000000..15f400c7 --- /dev/null +++ b/util/ego/cj/Makefile @@ -0,0 +1,60 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +cj.c + +OFILES=\ +cj.o + +HFILES= + +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)/stack_chg.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m $(SHR)/stack_chg.m $(SHR)/go.m + +cj: $(OFILES) + $(CC) -o \ + cj $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +cj_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o cj -.c $(LDFLAGS) cj.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/cj/cj.c b/util/ego/cj/cj.c new file mode 100644 index 00000000..bc4a250b --- /dev/null +++ b/util/ego/cj/cj.c @@ -0,0 +1,355 @@ +/* C R O S S J U M P I N G + * + * CJ.H + * + */ + +#include +#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 (l != (line_p) 0 && (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); + if (l1 == (line_p) 0 || l2 == (line_p) 0) return FALSE; + /* 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); + } +} diff --git a/util/ego/cs/Makefile b/util/ego/cs/Makefile new file mode 100644 index 00000000..36b841ec --- /dev/null +++ b/util/ego/cs/Makefile @@ -0,0 +1,178 @@ +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 + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m\ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m\ +$(SHR)/go.m + +cs: $(OFILES) + $(CC) -o cs $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +cs_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o cs -.c $(LDFLAGS) cs.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(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 diff --git a/util/ego/cs/cs.c b/util/ego/cs/cs.c new file mode 100644 index 00000000..bc599246 --- /dev/null +++ b/util/ego/cs/cs.c @@ -0,0 +1,78 @@ + +/* 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 +#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) { + /* 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. Note that if a block is preceded + * by itself, the number of predecessors is greater than 1, + * but the previous block can still be its immediate dominator. + */ + do { vnm(rbp); bdone = rbp; + OUTTRACE("basic block %d processed", bdone->b_id); + rbp = rbp->b_next; + } while (rbp != (bblock_p) 0 && rbp->b_idom == bdone && + Lnrelems(rbp->b_pred) == 1 + ); + 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); +} diff --git a/util/ego/cs/cs.h b/util/ego/cs/cs.h new file mode 100644 index 00000000..b53f3308 --- /dev/null +++ b/util/ego/cs/cs.h @@ -0,0 +1,123 @@ +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. */ diff --git a/util/ego/cs/cs_alloc.c b/util/ego/cs/cs_alloc.c new file mode 100644 index 00000000..e6cc18fe --- /dev/null +++ b/util/ego/cs/cs_alloc.c @@ -0,0 +1,44 @@ +#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)); +} diff --git a/util/ego/cs/cs_alloc.h b/util/ego/cs/cs_alloc.h new file mode 100644 index 00000000..7390e9ae --- /dev/null +++ b/util/ego/cs/cs_alloc.h @@ -0,0 +1,24 @@ +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. + */ diff --git a/util/ego/cs/cs_aux.c b/util/ego/cs/cs_aux.c new file mode 100644 index 00000000..296e5b0c --- /dev/null +++ b/util/ego/cs/cs_aux.c @@ -0,0 +1,64 @@ +#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; +} diff --git a/util/ego/cs/cs_aux.h b/util/ego/cs/cs_aux.h new file mode 100644 index 00000000..09be0d27 --- /dev/null +++ b/util/ego/cs/cs_aux.h @@ -0,0 +1,25 @@ +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. + */ + diff --git a/util/ego/cs/cs_avail.c b/util/ego/cs/cs_avail.c new file mode 100644 index 00000000..930b592f --- /dev/null +++ b/util/ego/cs/cs_avail.c @@ -0,0 +1,203 @@ +/* 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; +} diff --git a/util/ego/cs/cs_avail.h b/util/ego/cs/cs_avail.h new file mode 100644 index 00000000..2275df8c --- /dev/null +++ b/util/ego/cs/cs_avail.h @@ -0,0 +1,18 @@ +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. + */ diff --git a/util/ego/cs/cs_debug.c b/util/ego/cs/cs_debug.c new file mode 100644 index 00000000..0d4cdbdf --- /dev/null +++ b/util/ego/cs/cs_debug.c @@ -0,0 +1,156 @@ +#include +#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 diff --git a/util/ego/cs/cs_debug.h b/util/ego/cs/cs_debug.h new file mode 100644 index 00000000..194aa62d --- /dev/null +++ b/util/ego/cs/cs_debug.h @@ -0,0 +1,33 @@ +#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 diff --git a/util/ego/cs/cs_elim.c b/util/ego/cs/cs_elim.c new file mode 100644 index 00000000..33f295fe --- /dev/null +++ b/util/ego/cs/cs_elim.c @@ -0,0 +1,283 @@ +#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, ravp->av_size); + mes = gen_mesreg(tmp, ravp, pp); + append(ravp, tmp); + } + change_score(mes, score); + set_replace(ravp, tmp); + } + } +} diff --git a/util/ego/cs/cs_elim.h b/util/ego/cs/cs_elim.h new file mode 100644 index 00000000..5d108e5d --- /dev/null +++ b/util/ego/cs/cs_elim.h @@ -0,0 +1,5 @@ +extern eliminate(); /* (proc_p pp) + * Eliminate some of the recurrences of expressions + * that were found by the valuenumbering + * algorithm. + */ diff --git a/util/ego/cs/cs_entity.c b/util/ego/cs/cs_entity.c new file mode 100644 index 00000000..f3e95ca9 --- /dev/null +++ b/util/ego/cs/cs_entity.c @@ -0,0 +1,142 @@ +/* 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(); +} diff --git a/util/ego/cs/cs_entity.h b/util/ego/cs/cs_entity.h new file mode 100644 index 00000000..413de812 --- /dev/null +++ b/util/ego/cs/cs_entity.h @@ -0,0 +1,15 @@ +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. + */ diff --git a/util/ego/cs/cs_getent.c b/util/ego/cs/cs_getent.c new file mode 100644 index 00000000..b345f21a --- /dev/null +++ b/util/ego/cs/cs_getent.c @@ -0,0 +1,219 @@ +#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); +} diff --git a/util/ego/cs/cs_getent.h b/util/ego/cs/cs_getent.h new file mode 100644 index 00000000..53eb5ea7 --- /dev/null +++ b/util/ego/cs/cs_getent.h @@ -0,0 +1,8 @@ +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. + */ diff --git a/util/ego/cs/cs_kill.c b/util/ego/cs/cs_kill.c new file mode 100644 index 00000000..9a30f908 --- /dev/null +++ b/util/ego/cs/cs_kill.c @@ -0,0 +1,372 @@ +#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(); + } +} diff --git a/util/ego/cs/cs_kill.h b/util/ego/cs/cs_kill.h new file mode 100644 index 00000000..96d831d2 --- /dev/null +++ b/util/ego/cs/cs_kill.h @@ -0,0 +1,24 @@ +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. + */ diff --git a/util/ego/cs/cs_partit.c b/util/ego/cs/cs_partit.c new file mode 100644 index 00000000..977a10a4 --- /dev/null +++ b/util/ego/cs/cs_partit.c @@ -0,0 +1,371 @@ +/* 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 */ +} diff --git a/util/ego/cs/cs_partit.h b/util/ego/cs/cs_partit.h new file mode 100644 index 00000000..16f3cbda --- /dev/null +++ b/util/ego/cs/cs_partit.h @@ -0,0 +1,55 @@ +/* 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. + */ diff --git a/util/ego/cs/cs_profit.c b/util/ego/cs/cs_profit.c new file mode 100644 index 00000000..aa2b15ac --- /dev/null +++ b/util/ego/cs/cs_profit.c @@ -0,0 +1,207 @@ +#include +#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. + */ + int instr; + + fscanf(f, "%d", &instr); + while (instr >= sp_fmnem) { + Cadd((Celem_t) 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 . + */ + 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; +} diff --git a/util/ego/cs/cs_profit.h b/util/ego/cs/cs_profit.h new file mode 100644 index 00000000..535b6b90 --- /dev/null +++ b/util/ego/cs/cs_profit.h @@ -0,0 +1,10 @@ +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. + */ diff --git a/util/ego/cs/cs_stack.c b/util/ego/cs/cs_stack.c new file mode 100644 index 00000000..2070dad6 --- /dev/null +++ b/util/ego/cs/cs_stack.c @@ -0,0 +1,132 @@ +/* + * 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]; +} diff --git a/util/ego/cs/cs_stack.h b/util/ego/cs/cs_stack.h new file mode 100644 index 00000000..cd43c657 --- /dev/null +++ b/util/ego/cs/cs_stack.h @@ -0,0 +1,18 @@ +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. + */ diff --git a/util/ego/cs/cs_vnm.c b/util/ego/cs/cs_vnm.c new file mode 100644 index 00000000..0fbe05aa --- /dev/null +++ b/util/ego/cs/cs_vnm.c @@ -0,0 +1,321 @@ + +/* 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; + } + } +} diff --git a/util/ego/cs/cs_vnm.h b/util/ego/cs/cs_vnm.h new file mode 100644 index 00000000..cf4be283 --- /dev/null +++ b/util/ego/cs/cs_vnm.h @@ -0,0 +1,4 @@ +extern vnm(); /* (bblock_p bp) + * Performs the valuenumbering algorithm on the basic + * block in bp. + */ diff --git a/util/ego/descr/descr.sed b/util/ego/descr/descr.sed new file mode 100644 index 00000000..993a63d8 --- /dev/null +++ b/util/ego/descr/descr.sed @@ -0,0 +1,22 @@ +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 diff --git a/util/ego/descr/i86.descr b/util/ego/descr/i86.descr new file mode 100644 index 00000000..4dc7545c --- /dev/null +++ b/util/ego/descr/i86.descr @@ -0,0 +1,15 @@ + +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 diff --git a/util/ego/descr/m68k2.descr b/util/ego/descr/m68k2.descr new file mode 100644 index 00000000..893312fe --- /dev/null +++ b/util/ego/descr/m68k2.descr @@ -0,0 +1,103 @@ +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 diff --git a/util/ego/descr/makedescrs b/util/ego/descr/makedescrs new file mode 100755 index 00000000..85d8fcf9 --- /dev/null +++ b/util/ego/descr/makedescrs @@ -0,0 +1,5 @@ +for i in *.descr +do +m=`basename $i .descr` +../../../lib/cpp -P -I../../../h $i | sed -f descr.sed > ../../../lib/ego/${m}descr +done diff --git a/util/ego/descr/pdp.descr b/util/ego/descr/pdp.descr new file mode 100644 index 00000000..c8bd382d --- /dev/null +++ b/util/ego/descr/pdp.descr @@ -0,0 +1,96 @@ +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 diff --git a/util/ego/descr/vax2.descr b/util/ego/descr/vax2.descr new file mode 100644 index 00000000..8dfc9ace --- /dev/null +++ b/util/ego/descr/vax2.descr @@ -0,0 +1,117 @@ +wordsize: 2 +pointersize: 4 +%%RA +general registers: 3 +address registers: 4 +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: + (9 cases) + 0 -> (0,0) + 1 -> (1,0) + 2 -> (2,0) + 3 -> (3,0) + 4 -> (4,0) + 5 -> (5,0) + 6 -> (6,0) + 7 -> (7,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 + op_cmi op_cmf op_cmu op_cms op_cmp -1 + op_cii op_cui op_cfi op_ciu op_cff op_cuu op_cif + op_cmi op_cmf op_cmu op_cms op_cmp -1 +lexical tresholds: 1 1 +indirection limit: 8 +do sli if index?: no no +forbidden operators: -1 -1 +%%SP +global stack pollution allowed?: yes diff --git a/util/ego/descr/vax4.descr b/util/ego/descr/vax4.descr new file mode 100644 index 00000000..524c5f87 --- /dev/null +++ b/util/ego/descr/vax4.descr @@ -0,0 +1,114 @@ +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 diff --git a/util/ego/em_ego/em_ego b/util/ego/em_ego/em_ego new file mode 100755 index 00000000..0db2b045 --- /dev/null +++ b/util/ego/em_ego/em_ego @@ -0,0 +1,68 @@ +TMP=/usr/tmp/ego +DDUMP=$TMP.dd.$$ +PDUMP=$TMP.pd.$$ +PHASES='' +FLAGS='' + + +while : +do + case $# in + 0) break ;; + esac + A="$1" + shift + case $A in + *.m|*.ma) ICARG="$ICARG $A"; continue;; + -P) OPT="$1"; shift; continue;; + -IL) PHASES="$PHASES il cf " ; continue;; + -CS) PHASES="$PHASES cs " ; continue;; + -SR) PHASES="$PHASES sr " ; continue;; + -UD) PHASES="$PHASES ud " ; continue;; + -LV) PHASES="$PHASES lv " ; continue;; + -RA) PHASES="$PHASES ra " ; continue;; + -SP) PHASES="$PHASES sp " ; continue;; + -BO) PHASES="$PHASES bo " ; continue;; + -CJ) PHASES="$PHASES cj " ; continue;; + -*) FLAGS="$FLAGS $A"; continue;; + esac +done +if test "$PHASES" +then : +else PHASES='cj bo sp ' +fi +PASSES="ic cf $PHASES ca" +OUTFILES="$PDUMP $DDUMP" +c=1 +if test "$ICARG" +then : +else +exit 0 +fi +for i in $PASSES +do INFILES=$OUTFILES + OUTFILES="$TMP.p.$c.$$ $TMP.d.$c.$$ $TMP.l.$c.$$ $TMP.b.$c.$$" + trap "rm -f $INFILES $OUTFILES $PDUMP $DDUMP; exit 1" 1 2 15 + case $i in + ic) if $OPT/ic $INFILES - - $OUTFILES $ICARG + then : + else exit 1 + fi ;; + ca) if $OPT/ca $INFILES $PDUMP $DDUMP - - + then + rm -f $INFILES $PDUMP $DDUMP + else + rm -f $INFILES $PDUMP $DDUMP + exit 1 + fi;; + *) if $OPT/$i $INFILES $OUTFILES $FLAGS + then + rm -f $INFILES + else + rm -f $INFILES + exit 1 + fi ;; + esac + c=`expr $c + 1` +done +exit 0 diff --git a/util/ego/ic/Makefile b/util/ego/ic/Makefile new file mode 100644 index 00000000..cf4fd798 --- /dev/null +++ b/util/ego/ic/Makefile @@ -0,0 +1,100 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +ic.c ic_aux.c ic_lib.c ic_lookup.c ic_io.c + +OFILES=\ +ic.o ic_aux.o ic_lookup.o ic_io.o ic_lib.o + +HFILES=\ +ic.h ic_aux.h ic_lib.h ic_lookup.h ic_io.h + +PRFILES=\ +$(CFILES) $(HFILES) Makefile + +SHARE_OFILES=\ +$(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 + +SHARE_MFILES=\ +$(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m + +ic: $(OFILES) + $(CC) -o ic $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +ic_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o ic -.c $(LDFLAGS) ic.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/ic/ic.c b/util/ego/ic/ic.c new file mode 100644 index 00000000..9f63771b --- /dev/null +++ b/util/ego/ic/ic.c @@ -0,0 +1,520 @@ +/* I N T E R M E D I A T E C O D E + * + * I C . C + */ + +#include +#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 */ +} diff --git a/util/ego/ic/ic.h b/util/ego/ic/ic.h new file mode 100644 index 00000000..bca89f15 --- /dev/null +++ b/util/ego/ic/ic.h @@ -0,0 +1,70 @@ +/* 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[]; + diff --git a/util/ego/ic/ic_aux.c b/util/ego/ic/ic_aux.c new file mode 100644 index 00000000..211d05a3 --- /dev/null +++ b/util/ego/ic/ic_aux.c @@ -0,0 +1,459 @@ +/* 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)); +} diff --git a/util/ego/ic/ic_aux.h b/util/ego/ic/ic_aux.h new file mode 100644 index 00000000..887e4315 --- /dev/null +++ b/util/ego/ic/ic_aux.h @@ -0,0 +1,39 @@ +/* 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. + */ diff --git a/util/ego/ic/ic_io.c b/util/ego/ic/ic_io.c new file mode 100644 index 00000000..017ff1e6 --- /dev/null +++ b/util/ego/ic/ic_io.c @@ -0,0 +1,204 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ I O . C + */ + + + +#include +#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); + } +} diff --git a/util/ego/ic/ic_io.h b/util/ego/ic/ic_io.h new file mode 100644 index 00000000..30bb194f --- /dev/null +++ b/util/ego/ic/ic_io.h @@ -0,0 +1,34 @@ +/* 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. + */ diff --git a/util/ego/ic/ic_lib.c b/util/ego/ic/ic_lib.c new file mode 100644 index 00000000..390ccec7 --- /dev/null +++ b/util/ego/ic/ic_lib.c @@ -0,0 +1,274 @@ +/* I N T E R M E D I A T E C O D E + * + * I C _ L I B . C + */ + + +#include +#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; + } + } + } +} diff --git a/util/ego/ic/ic_lib.h b/util/ego/ic/ic_lib.h new file mode 100644 index 00000000..75d0b22e --- /dev/null +++ b/util/ego/ic/ic_lib.h @@ -0,0 +1,14 @@ +/* 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. + */ diff --git a/util/ego/ic/ic_lookup.c b/util/ego/ic/ic_lookup.c new file mode 100644 index 00000000..6c0d2b80 --- /dev/null +++ b/util/ego/ic/ic_lookup.c @@ -0,0 +1,414 @@ +/* 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 +#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; + } + } + } +} diff --git a/util/ego/ic/ic_lookup.h b/util/ego/ic/ic_lookup.h new file mode 100644 index 00000000..6d7d287a --- /dev/null +++ b/util/ego/ic/ic_lookup.h @@ -0,0 +1,71 @@ +/* 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 + */ diff --git a/util/ego/il/Makefile b/util/ego/il/Makefile new file mode 100644 index 00000000..5504f502 --- /dev/null +++ b/util/ego/il/Makefile @@ -0,0 +1,160 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +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 + +OFILES=\ +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 + +HFILES=\ +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 + +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)/parser.o \ +$(SHR)/aux.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/parser.m \ +$(SHR)/aux.m $(SHR)/go.m + +il: $(OFILES) + $(CC) -o il $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +il_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o il -.c $(LDFLAGS) il.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/il/il.c b/util/ego/il/il.c new file mode 100644 index 00000000..0a5ab629 --- /dev/null +++ b/util/ego/il/il.c @@ -0,0 +1,313 @@ +/* I N L I N E S U B S T I T U T I O N */ +#include +#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); +} diff --git a/util/ego/il/il.h b/util/ego/il/il.h new file mode 100644 index 00000000..56f78215 --- /dev/null +++ b/util/ego/il/il.h @@ -0,0 +1,161 @@ +/* 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) diff --git a/util/ego/il/il1_anal.c b/util/ego/il/il1_anal.c new file mode 100644 index 00000000..2e8acd28 --- /dev/null +++ b/util/ego/il/il1_anal.c @@ -0,0 +1,177 @@ +/* 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 +#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); +} diff --git a/util/ego/il/il1_anal.h b/util/ego/il/il1_anal.h new file mode 100644 index 00000000..ed01629f --- /dev/null +++ b/util/ego/il/il1_anal.h @@ -0,0 +1,17 @@ +/* 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. + */ diff --git a/util/ego/il/il1_aux.c b/util/ego/il/il1_aux.c new file mode 100644 index 00000000..b8602c02 --- /dev/null +++ b/util/ego/il/il1_aux.c @@ -0,0 +1,208 @@ +/* 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; +} diff --git a/util/ego/il/il1_aux.h b/util/ego/il/il1_aux.h new file mode 100644 index 00000000..9f7ee795 --- /dev/null +++ b/util/ego/il/il1_aux.h @@ -0,0 +1,38 @@ +/* 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. + */ diff --git a/util/ego/il/il1_cal.c b/util/ego/il/il1_cal.c new file mode 100644 index 00000000..7a694699 --- /dev/null +++ b/util/ego/il/il1_cal.c @@ -0,0 +1,138 @@ +/* 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 +#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); + } + } +} diff --git a/util/ego/il/il1_cal.h b/util/ego/il/il1_cal.h new file mode 100644 index 00000000..191e7ae5 --- /dev/null +++ b/util/ego/il/il1_cal.h @@ -0,0 +1,31 @@ +/* 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. + */ diff --git a/util/ego/il/il1_formal.c b/util/ego/il/il1_formal.c new file mode 100644 index 00000000..1a616efc --- /dev/null +++ b/util/ego/il/il1_formal.c @@ -0,0 +1,141 @@ +/* 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 */ + } + } +} diff --git a/util/ego/il/il1_formal.h b/util/ego/il/il1_formal.h new file mode 100644 index 00000000..062043c7 --- /dev/null +++ b/util/ego/il/il1_formal.h @@ -0,0 +1,11 @@ +/* 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). + */ diff --git a/util/ego/il/il2_aux.c b/util/ego/il/il2_aux.c new file mode 100644 index 00000000..0d393c74 --- /dev/null +++ b/util/ego/il/il2_aux.c @@ -0,0 +1,718 @@ +/* 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 +#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 diff --git a/util/ego/il/il2_aux.h b/util/ego/il/il2_aux.h new file mode 100644 index 00000000..8ef35527 --- /dev/null +++ b/util/ego/il/il2_aux.h @@ -0,0 +1,36 @@ +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. + */ diff --git a/util/ego/il/il3_aux.c b/util/ego/il/il3_aux.c new file mode 100644 index 00000000..2572a892 --- /dev/null +++ b/util/ego/il/il3_aux.c @@ -0,0 +1,63 @@ +/* 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 (lines != (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); +} diff --git a/util/ego/il/il3_aux.h b/util/ego/il/il3_aux.h new file mode 100644 index 00000000..afa8cdbd --- /dev/null +++ b/util/ego/il/il3_aux.h @@ -0,0 +1,15 @@ +/* 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. + */ diff --git a/util/ego/il/il3_change.c b/util/ego/il/il3_change.c new file mode 100644 index 00000000..147ce795 --- /dev/null +++ b/util/ego/il/il3_change.c @@ -0,0 +1,584 @@ +/* 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 +#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); +} diff --git a/util/ego/il/il3_change.h b/util/ego/il/il3_change.h new file mode 100644 index 00000000..83524941 --- /dev/null +++ b/util/ego/il/il3_change.h @@ -0,0 +1,41 @@ +/* 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. + */ diff --git a/util/ego/il/il3_subst.c b/util/ego/il/il3_subst.c new file mode 100644 index 00000000..a3601a36 --- /dev/null +++ b/util/ego/il/il3_subst.c @@ -0,0 +1,122 @@ +/* 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 +#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); + } +} diff --git a/util/ego/il/il3_subst.h b/util/ego/il/il3_subst.h new file mode 100644 index 00000000..d3e582f6 --- /dev/null +++ b/util/ego/il/il3_subst.h @@ -0,0 +1,17 @@ + +/* 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. + */ diff --git a/util/ego/il/il_aux.c b/util/ego/il/il_aux.c new file mode 100644 index 00000000..8f3f1e55 --- /dev/null +++ b/util/ego/il/il_aux.c @@ -0,0 +1,383 @@ + +/* 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 +#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; +} diff --git a/util/ego/il/il_aux.h b/util/ego/il/il_aux.h new file mode 100644 index 00000000..798ab551 --- /dev/null +++ b/util/ego/il/il_aux.h @@ -0,0 +1,53 @@ + +/* 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. + */ diff --git a/util/ego/lv/Makefile b/util/ego/lv/Makefile new file mode 100644 index 00000000..32298550 --- /dev/null +++ b/util/ego/lv/Makefile @@ -0,0 +1,66 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +lv.c + +OFILES=\ +lv.o + +HFILES=\ +lv.h + +PRFILES=\ +$(CFILES) $(HFILES) Makefile + +SHARE_OFILES=\ +$(SHR)/get.o $(SHR)/aux.o $(SHR)/put.o $(SHR)/map.o $(SHR)/alloc.o \ +$(SHR)/global.o $(SHR)/debug.o $(SHR)/lset.o $(SHR)/cset.o $(SHR)/parser.o \ +$(SHR)/files.o $(SHR)/locals.o $(SHR)/init_glob.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/aux.m $(SHR)/put.m $(SHR)/map.m $(SHR)/alloc.m \ +$(SHR)/global.m $(SHR)/debug.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/parser.m \ +$(SHR)/files.m $(SHR)/locals.m $(SHR)/init_glob.m $(SHR)/go.m + +lv: $(OFILES) + $(CC) -o lv $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +lv_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o lv -.c $(LDFLAGS) lv.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/lv/lv.c b/util/ego/lv/lv.c new file mode 100644 index 00000000..d56d1feb --- /dev/null +++ b/util/ego/lv/lv.c @@ -0,0 +1,588 @@ + +/* L I V E V A R I A B L E S A N A L Y S I S */ + +#include +#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); +} diff --git a/util/ego/lv/lv.h b/util/ego/lv/lv.h new file mode 100644 index 00000000..27fc1359 --- /dev/null +++ b/util/ego/lv/lv.h @@ -0,0 +1,42 @@ +/* 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)) + + diff --git a/util/ego/ra/Makefile b/util/ego/ra/Makefile new file mode 100644 index 00000000..0922f804 --- /dev/null +++ b/util/ego/ra/Makefile @@ -0,0 +1,176 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +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 + +OFILES=\ +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 + +HFILES=\ +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 + +PRFILES=\ +$(CFILES) $(HFILES) Makefile + +SHARE_OFILES=\ +$(SHR)/aux.o $(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)/go.o + +SHARE_MFILES=\ +$(SHR)/aux.m $(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m \ +$(SHR)/debug.m $(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m \ +$(SHR)/go.m + +ra: $(OFILES) + $(CC) -o ra $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +ra_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o ra -.c $(LDFLAGS) ra.o $(EMLIB)/em_data.a + +itemtab.h: itemtab.src makeitems $(EMH)/em_mnem.h + makeitems $(EMH)/em_mnem.h itemtab.src > itemtab.h + +makeitems: makeitems.c + $(CC) -o makeitems makeitems.c + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/ra/itemtab.src b/util/ego/ra/itemtab.src new file mode 100644 index 00000000..4c3e5e09 --- /dev/null +++ b/util/ego/ra/itemtab.src @@ -0,0 +1,21 @@ +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 diff --git a/util/ego/ra/makeitems.c b/util/ego/ra/makeitems.c new file mode 100644 index 00000000..8df2006e --- /dev/null +++ b/util/ego/ra/makeitems.c @@ -0,0 +1,77 @@ +#include + +/* 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); +} diff --git a/util/ego/ra/ra.c b/util/ego/ra/ra.c new file mode 100644 index 00000000..48df6d09 --- /dev/null +++ b/util/ego/ra/ra.c @@ -0,0 +1,548 @@ +/* + * R E G I S T E R A L L O C A T I O N + * + */ + +#include +#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,"%hd %hd %hd",&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,"%hd",®s_available[reg_any]); + fscanf(f,"%hd",®s_available[reg_pointer]); + fscanf(f,"%hd",®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)) { + cleantimeset(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 cleantimeset(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 cleanitems(list) + item_p list; +{ + register item_p x,next; + + for (x = list; x != (item_p) 0; x = next ) { + next = x->it_next; + cleantimeset(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); + cleanitems(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; + + fprintf(stderr,"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; + fprintf(stderr,"\nitem: [type = %s, ",str_types[t]); + switch(t) { + case GLOBL_ADDR: + fprintf(stderr,"id = %d]\n", item->i_t.it_obj->o_id); + break; + case PROC_ADDR: + fprintf(stderr,"id = %d]\n", item->i_t.it_proc->p_id); + break; + default: + fprintf(stderr,"offset = %D]\n", item->i_t.it_off); + } + fprintf(stderr,"#usages(static) = %d\n",al->al_susecount); + fprintf(stderr,"#usages(dyn) = %d\n",al->al_dusecount); + fprintf(stderr,"#inits = %d\n",Lnrelems(al->al_inits)); + fprintf(stderr,"timespan = {"); + for (iv = al->al_timespan; iv != (interv_p) 0; + iv = iv->i_next) { + fprintf(stderr,"(%d,%d) ",iv->i_start,iv->i_stop); + } + fprintf(stderr,"} \n"); + fprintf(stderr,"busy = {"); + for (iv = al->al_busy; iv != (interv_p) 0; + iv = iv->i_next) { + fprintf(stderr,"(%d,%d) ",iv->i_start,iv->i_stop); + } + fprintf(stderr,"} \n"); + fprintf(stderr,"profits = %d\n",al->al_profits); + fprintf(stderr,"dummy local = %D\n",al->al_dummy); + fprintf(stderr,"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]); + } +} diff --git a/util/ego/ra/ra.h b/util/ego/ra/ra.h new file mode 100644 index 00000000..9a84cb1c --- /dev/null +++ b/util/ego/ra/ra.h @@ -0,0 +1,136 @@ +/* + * 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) diff --git a/util/ego/ra/ra_allocl.c b/util/ego/ra/ra_allocl.c new file mode 100644 index 00000000..4b5bb8a6 --- /dev/null +++ b/util/ego/ra/ra_allocl.c @@ -0,0 +1,376 @@ +/* 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++; + } + } + } + } +} diff --git a/util/ego/ra/ra_allocl.h b/util/ego/ra/ra_allocl.h new file mode 100644 index 00000000..1690b69b --- /dev/null +++ b/util/ego/ra/ra_allocl.h @@ -0,0 +1,19 @@ + +/* 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. + */ diff --git a/util/ego/ra/ra_aux.c b/util/ego/ra/ra_aux.c new file mode 100644 index 00000000..b44f3230 --- /dev/null +++ b/util/ego/ra/ra_aux.c @@ -0,0 +1,40 @@ +/* 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)); +} diff --git a/util/ego/ra/ra_aux.h b/util/ego/ra/ra_aux.h new file mode 100644 index 00000000..374a60c2 --- /dev/null +++ b/util/ego/ra/ra_aux.h @@ -0,0 +1,24 @@ +/* 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. + */ diff --git a/util/ego/ra/ra_interv.c b/util/ego/ra/ra_interv.c new file mode 100644 index 00000000..6be3271c --- /dev/null +++ b/util/ego/ra/ra_interv.c @@ -0,0 +1,228 @@ +/* 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; +} diff --git a/util/ego/ra/ra_interv.h b/util/ego/ra/ra_interv.h new file mode 100644 index 00000000..14985cfa --- /dev/null +++ b/util/ego/ra/ra_interv.h @@ -0,0 +1,35 @@ + +/* 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. + */ diff --git a/util/ego/ra/ra_items.c b/util/ego/ra/ra_items.c new file mode 100644 index 00000000..08bbf75c --- /dev/null +++ b/util/ego/ra/ra_items.c @@ -0,0 +1,346 @@ +/* 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); + item->it_desirable = TRUE; + 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; +} diff --git a/util/ego/ra/ra_items.h b/util/ego/ra/ra_items.h new file mode 100644 index 00000000..2bbe2320 --- /dev/null +++ b/util/ego/ra/ra_items.h @@ -0,0 +1,31 @@ +/* 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. + */ diff --git a/util/ego/ra/ra_lifet.c b/util/ego/ra/ra_lifet.c new file mode 100644 index 00000000..4b623ac7 --- /dev/null +++ b/util/ego/ra/ra_lifet.c @@ -0,0 +1,74 @@ +/* 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; + } + } + } +} diff --git a/util/ego/ra/ra_lifet.h b/util/ego/ra/ra_lifet.h new file mode 100644 index 00000000..bf7ab87d --- /dev/null +++ b/util/ego/ra/ra_lifet.h @@ -0,0 +1,12 @@ +/* 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. + */ diff --git a/util/ego/ra/ra_pack.c b/util/ego/ra/ra_pack.c new file mode 100644 index 00000000..2fe69de2 --- /dev/null +++ b/util/ego/ra/ra_pack.c @@ -0,0 +1,416 @@ +/* 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 initregcount() +{ + 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 (b != (alloc_p) 0 && 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,(offset) 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; + + initregcount(); + 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; +} + + +/* If an item is always put in the same register during different loops, + * we try to put it in that register during the whole procedure. + * The profits of the whole-procedure allocation are updated to prevent + * account_regsave from rejecting it. + */ + +STATIC repl_allocs(new,old,packed) + alloc_p new,old,packed; +{ + alloc_p x,next,prev,*p; + short prof = 0; + + 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) { + prof += x->al_profits; + *p = next; + oldalloc(x); + } else { + p = &x->al_mates; + } + } + new->al_profits = prof; +} + + + +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; + + initregcount(); + 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); +} diff --git a/util/ego/ra/ra_pack.h b/util/ego/ra/ra_pack.h new file mode 100644 index 00000000..5f593d54 --- /dev/null +++ b/util/ego/ra/ra_pack.h @@ -0,0 +1,11 @@ + +/* 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. + */ diff --git a/util/ego/ra/ra_profits.c b/util/ego/ra/ra_profits.c new file mode 100644 index 00000000..3c725a03 --- /dev/null +++ b/util/ego/ra/ra_profits.c @@ -0,0 +1,235 @@ +/* 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); + */ +} + + + + +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; + } + } +} diff --git a/util/ego/ra/ra_profits.h b/util/ego/ra/ra_profits.h new file mode 100644 index 00000000..443b3631 --- /dev/null +++ b/util/ego/ra/ra_profits.h @@ -0,0 +1,11 @@ + +/* 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. + */ +extern regsave_cost(); /* (short regs[], *time_out, *space_out) + */ diff --git a/util/ego/ra/ra_xform.c b/util/ego/ra/ra_xform.c new file mode 100644 index 00000000..be3aa313 --- /dev/null +++ b/util/ego/ra/ra_xform.c @@ -0,0 +1,565 @@ +/* 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; + } +} diff --git a/util/ego/ra/ra_xform.h b/util/ego/ra/ra_xform.h new file mode 100644 index 00000000..05710f42 --- /dev/null +++ b/util/ego/ra/ra_xform.h @@ -0,0 +1,24 @@ + +/* 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. + */ diff --git a/util/ego/share/Makefile b/util/ego/share/Makefile new file mode 100644 index 00000000..e297744b --- /dev/null +++ b/util/ego/share/Makefile @@ -0,0 +1,161 @@ +EM=../../.. +EMH=$(EM)/h +EML=$(EM)/lib + +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 + +PRFILES=$(SRC) + +.SUFFIXES: .m +.c.m: + $(CC) -c.m $(CFLAGS) $< + +all:\ +classdefs.h pop_push.h wordlen.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 + + +em_files:\ +classdefs.h pop_push.h wordlen.h alloc.m cset.m debug.m\ +files.m go.m global.m lset.m map.m parser.m get.m put.m aux.m stack_chg.m\ +locals.m init_glob.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 + +wordlen.h: makewordlen + makewordlen > wordlen.h + rm makewordlen +makewordlen: makewlen.c + $(CC) -o makewordlen makewlen.c +show: \ + show.c + $(CC) -o show show.c $(EML)/em_data.a +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/share/alloc.c b/util/ego/share/alloc.c new file mode 100644 index 00000000..1784420a --- /dev/null +++ b/util/ego/share/alloc.c @@ -0,0 +1,237 @@ +/* S H A R E D F I L E + * + * A L L O C . C + */ + + + +#include +#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); +} diff --git a/util/ego/share/alloc.h b/util/ego/share/alloc.h new file mode 100644 index 00000000..61029a18 --- /dev/null +++ b/util/ego/share/alloc.h @@ -0,0 +1,54 @@ +/* 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) diff --git a/util/ego/share/aux.c b/util/ego/share/aux.c new file mode 100644 index 00000000..2e4c8b36 --- /dev/null +++ b/util/ego/share/aux.c @@ -0,0 +1,246 @@ +/* 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; + offset size; +{ + /* Allocate a new local variable in the stack frame of p */ + + p->p_localbytes += 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); +} diff --git a/util/ego/share/aux.h b/util/ego/share/aux.h new file mode 100644 index 00000000..6a5243ab --- /dev/null +++ b/util/ego/share/aux.h @@ -0,0 +1,66 @@ +/* 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, offset 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. + */ diff --git a/util/ego/share/cldefs.src b/util/ego/share/cldefs.src new file mode 100644 index 00000000..23dc1380 --- /dev/null +++ b/util/ego/share/cldefs.src @@ -0,0 +1,69 @@ +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 12 +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 diff --git a/util/ego/share/cset.c b/util/ego/share/cset.c new file mode 100644 index 00000000..646fefed --- /dev/null +++ b/util/ego/share/cset.c @@ -0,0 +1,277 @@ +/* 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; +} diff --git a/util/ego/share/cset.h b/util/ego/share/cset.h new file mode 100644 index 00000000..1c7199c0 --- /dev/null +++ b/util/ego/share/cset.h @@ -0,0 +1,21 @@ +/* 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) */ diff --git a/util/ego/share/debug.c b/util/ego/share/debug.c new file mode 100644 index 00000000..104a3076 --- /dev/null +++ b/util/ego/share/debug.c @@ -0,0 +1,145 @@ +/* S H A R E D F I L E + * + * D E B U G . C + */ + + +#include +#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); + } +} diff --git a/util/ego/share/debug.h b/util/ego/share/debug.h new file mode 100644 index 00000000..72da2c68 --- /dev/null +++ b/util/ego/share/debug.h @@ -0,0 +1,56 @@ +/* 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 diff --git a/util/ego/share/def.h b/util/ego/share/def.h new file mode 100644 index 00000000..07db9076 --- /dev/null +++ b/util/ego/share/def.h @@ -0,0 +1,14 @@ +/* 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 diff --git a/util/ego/share/files.c b/util/ego/share/files.c new file mode 100644 index 00000000..062306ed --- /dev/null +++ b/util/ego/share/files.c @@ -0,0 +1,17 @@ +/* S H A R E D F I L E + * + * F I L E S . C + */ + +#include + +FILE *openfile(name,mode) + char *name,*mode; +{ + FILE *f; + + if ((f = fopen(name,mode)) == NULL) { + error("cannot open %s",name); + } + return f; +} diff --git a/util/ego/share/files.h b/util/ego/share/files.h new file mode 100644 index 00000000..494893b9 --- /dev/null +++ b/util/ego/share/files.h @@ -0,0 +1,33 @@ +/* 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. + */ diff --git a/util/ego/share/get.c b/util/ego/share/get.c new file mode 100644 index 00000000..474e7b31 --- /dev/null +++ b/util/ego/share/get.c @@ -0,0 +1,548 @@ +/* S H A R E D F I L E + * + * G E T . C + */ + +#include +#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; +} diff --git a/util/ego/share/get.h b/util/ego/share/get.h new file mode 100644 index 00000000..0268a729 --- /dev/null +++ b/util/ego/share/get.h @@ -0,0 +1,53 @@ +/* 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. + */ diff --git a/util/ego/share/global.c b/util/ego/share/global.c new file mode 100644 index 00000000..37d8a00f --- /dev/null +++ b/util/ego/share/global.c @@ -0,0 +1,21 @@ +/* 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'. + */ diff --git a/util/ego/share/global.h b/util/ego/share/global.h new file mode 100644 index 00000000..b8eb30f5 --- /dev/null +++ b/util/ego/share/global.h @@ -0,0 +1,51 @@ +/* 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, defined in automatically generated file */ +#include "../share/wordlen.h" + +#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'. + */ diff --git a/util/ego/share/go.c b/util/ego/share/go.c new file mode 100644 index 00000000..5a597358 --- /dev/null +++ b/util/ego/share/go.c @@ -0,0 +1,152 @@ +/* S H A R E D F I L E + * + * G O . C + * + */ + + +#include +#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); + } +} diff --git a/util/ego/share/go.h b/util/ego/share/go.h new file mode 100644 index 00000000..3c3bff1a --- /dev/null +++ b/util/ego/share/go.h @@ -0,0 +1,34 @@ +/* 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 + */ diff --git a/util/ego/share/init_glob.c b/util/ego/share/init_glob.c new file mode 100644 index 00000000..088d679b --- /dev/null +++ b/util/ego/share/init_glob.c @@ -0,0 +1,57 @@ + +/* 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; +} diff --git a/util/ego/share/init_glob.h b/util/ego/share/init_glob.h new file mode 100644 index 00000000..984b847d --- /dev/null +++ b/util/ego/share/init_glob.h @@ -0,0 +1,10 @@ + +/* 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. + */ diff --git a/util/ego/share/locals.c b/util/ego/share/locals.c new file mode 100644 index 00000000..64e3f4ca --- /dev/null +++ b/util/ego/share/locals.c @@ -0,0 +1,242 @@ +/* + * L O C A L S . C + */ + +#include +#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); + } +} diff --git a/util/ego/share/locals.h b/util/ego/share/locals.h new file mode 100644 index 00000000..3b101fda --- /dev/null +++ b/util/ego/share/locals.h @@ -0,0 +1,39 @@ + +/* + * 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) + + diff --git a/util/ego/share/lset.c b/util/ego/share/lset.c new file mode 100644 index 00000000..85348dca --- /dev/null +++ b/util/ego/share/lset.c @@ -0,0 +1,208 @@ +/* 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; +} diff --git a/util/ego/share/lset.h b/util/ego/share/lset.h new file mode 100644 index 00000000..826b8944 --- /dev/null +++ b/util/ego/share/lset.h @@ -0,0 +1,16 @@ +/* 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) */ diff --git a/util/ego/share/makecldef.c b/util/ego/share/makecldef.c new file mode 100644 index 00000000..f656b09b --- /dev/null +++ b/util/ego/share/makecldef.c @@ -0,0 +1,83 @@ +#include + +/* 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); +} diff --git a/util/ego/share/makedepend b/util/ego/share/makedepend new file mode 100755 index 00000000..733f55b6 --- /dev/null +++ b/util/ego/share/makedepend @@ -0,0 +1,11 @@ +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 diff --git a/util/ego/share/makewlen.c b/util/ego/share/makewlen.c new file mode 100644 index 00000000..a26dc890 --- /dev/null +++ b/util/ego/share/makewlen.c @@ -0,0 +1,4 @@ +main() +{ + printf("#define WORDLENGTH %d\n",sizeof(int) * 8); +} diff --git a/util/ego/share/map.c b/util/ego/share/map.c new file mode 100644 index 00000000..65458826 --- /dev/null +++ b/util/ego/share/map.c @@ -0,0 +1,21 @@ +/* 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 */ diff --git a/util/ego/share/map.h b/util/ego/share/map.h new file mode 100644 index 00000000..9c3a4655 --- /dev/null +++ b/util/ego/share/map.h @@ -0,0 +1,38 @@ +/* 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 */ diff --git a/util/ego/share/parser.c b/util/ego/share/parser.c new file mode 100644 index 00000000..86624752 --- /dev/null +++ b/util/ego/share/parser.c @@ -0,0 +1,282 @@ + +#include +#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 +#define CLASS12 12 + +#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: + case CLASS12: + 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; + case CLASS12: + n = (arg1 < ws ? ws : arg1); + 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; +} diff --git a/util/ego/share/parser.h b/util/ego/share/parser.h new file mode 100644 index 00000000..b09c5f5a --- /dev/null +++ b/util/ego/share/parser.h @@ -0,0 +1,13 @@ +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. + */ diff --git a/util/ego/share/pop_push.awk b/util/ego/share/pop_push.awk new file mode 100644 index 00000000..3c9a977c --- /dev/null +++ b/util/ego/share/pop_push.awk @@ -0,0 +1,15 @@ +BEGIN { + print "char *pop_push[]=" + print "{" + print "\"\"," + switch = 0 +} +/aar/ { + switch = 1 +} + { + if (switch) printf("\"%s\",\n",$3) +} +END { + print "};" +} diff --git a/util/ego/share/put.c b/util/ego/share/put.c new file mode 100644 index 00000000..5a7fe9b6 --- /dev/null +++ b/util/ego/share/put.c @@ -0,0 +1,437 @@ +/* P U T . C */ + +#include +#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;lengthab_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; +} diff --git a/util/ego/share/put.h b/util/ego/share/put.h new file mode 100644 index 00000000..729058ae --- /dev/null +++ b/util/ego/share/put.h @@ -0,0 +1,40 @@ + /* 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. + */ diff --git a/util/ego/share/show.c b/util/ego/share/show.c new file mode 100644 index 00000000..41240950 --- /dev/null +++ b/util/ego/share/show.c @@ -0,0 +1,415 @@ +/* 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 +#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(); + } + } + } + } +} diff --git a/util/ego/share/stack_chg.c b/util/ego/share/stack_chg.c new file mode 100644 index 00000000..89a8056d --- /dev/null +++ b/util/ego/share/stack_chg.c @@ -0,0 +1,104 @@ +/* S T A C K _ C H A N G E . C */ + + +#include +#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; +} + + diff --git a/util/ego/share/stack_chg.h b/util/ego/share/stack_chg.h new file mode 100644 index 00000000..52576264 --- /dev/null +++ b/util/ego/share/stack_chg.h @@ -0,0 +1,10 @@ + +/* 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. + */ diff --git a/util/ego/share/types.h b/util/ego/share/types.h new file mode 100644 index 00000000..b89e41c8 --- /dev/null +++ b/util/ego/share/types.h @@ -0,0 +1,414 @@ +/* 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 + diff --git a/util/ego/sp/Makefile b/util/ego/sp/Makefile new file mode 100644 index 00000000..dcdac73f --- /dev/null +++ b/util/ego/sp/Makefile @@ -0,0 +1,65 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +sp.c + +OFILES=\ +sp.o + +HFILES= + +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)/stack_chg.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m \ +$(SHR)/stack_chg.m $(SHR)/go.m + +sp: $(OFILES) + $(CC) -o sp $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +sp_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o sp -.c $(LDFLAGS) sp.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/sp/sp.c b/util/ego/sp/sp.c new file mode 100644 index 00000000..001c2022 --- /dev/null +++ b/util/ego/sp/sp.c @@ -0,0 +1,240 @@ +/* S T A C K P O L L U T I O N + * + * S P . C + */ + + +#include +#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); + } +} + +*/ diff --git a/util/ego/sr/Makefile b/util/ego/sr/Makefile new file mode 100644 index 00000000..cabdd7d8 --- /dev/null +++ b/util/ego/sr/Makefile @@ -0,0 +1,131 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +sr.c sr_iv.c sr_reduce.c sr_cand.c sr_xform.c sr_expr.c sr_aux.c + +OFILES=\ +sr.o sr_expr.o sr_reduce.o sr_iv.o sr_cand.o sr_xform.o sr_aux.o + +HFILES=\ +sr.h sr_iv.h sr_reduce.h sr_cand.h sr_xform.h sr_expr.h sr_aux.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 + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/alloc.m $(SHR)/global.m $(SHR)/debug.m \ +$(SHR)/files.m $(SHR)/map.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/aux.m \ +$(SHR)/go.m + +sr: $(OFILES) + $(CC) -o sr $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +sr_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o sr -.c $(LDFLAGS) sr.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/sr/sr.c b/util/ego/sr/sr.c new file mode 100644 index 00000000..da38ae42 --- /dev/null +++ b/util/ego/sr/sr.c @@ -0,0 +1,205 @@ +/* S T R E N G T H R E D U C T I O N */ + + +#include +#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: */ + +int ovfl_harmful; +int 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); +} diff --git a/util/ego/sr/sr.h b/util/ego/sr/sr.h new file mode 100644 index 00000000..a472690a --- /dev/null +++ b/util/ego/sr/sr.h @@ -0,0 +1,72 @@ +/* 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 int ovfl_harmful; /* Does overflow during multiplication + * cause a trap ? + */ +extern int 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) diff --git a/util/ego/sr/sr_aux.c b/util/ego/sr/sr_aux.c new file mode 100644 index 00000000..9b6d5b08 --- /dev/null +++ b/util/ego/sr/sr_aux.c @@ -0,0 +1,115 @@ +/* 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; +} diff --git a/util/ego/sr/sr_aux.h b/util/ego/sr/sr_aux.h new file mode 100644 index 00000000..a58dfbd5 --- /dev/null +++ b/util/ego/sr/sr_aux.h @@ -0,0 +1,20 @@ +/* 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) diff --git a/util/ego/sr/sr_cand.c b/util/ego/sr/sr_cand.c new file mode 100644 index 00000000..4dcd4ea0 --- /dev/null +++ b/util/ego/sr/sr_cand.c @@ -0,0 +1,187 @@ +/* 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; +} diff --git a/util/ego/sr/sr_cand.h b/util/ego/sr/sr_cand.h new file mode 100644 index 00000000..578fb58a --- /dev/null +++ b/util/ego/sr/sr_cand.h @@ -0,0 +1,14 @@ +/* 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. + */ diff --git a/util/ego/sr/sr_expr.c b/util/ego/sr/sr_expr.c new file mode 100644 index 00000000..d15ea834 --- /dev/null +++ b/util/ego/sr/sr_expr.c @@ -0,0 +1,199 @@ +/* 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 +#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; +} diff --git a/util/ego/sr/sr_expr.h b/util/ego/sr/sr_expr.h new file mode 100644 index 00000000..dae187cc --- /dev/null +++ b/util/ego/sr/sr_expr.h @@ -0,0 +1,13 @@ +/* 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.). + */ diff --git a/util/ego/sr/sr_iv.c b/util/ego/sr/sr_iv.c new file mode 100644 index 00000000..fe561d2b --- /dev/null +++ b/util/ego/sr/sr_iv.c @@ -0,0 +1,183 @@ +/* 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; +} diff --git a/util/ego/sr/sr_iv.h b/util/ego/sr/sr_iv.h new file mode 100644 index 00000000..a157e25f --- /dev/null +++ b/util/ego/sr/sr_iv.h @@ -0,0 +1,7 @@ +/* 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. + */ diff --git a/util/ego/sr/sr_reduce.c b/util/ego/sr/sr_reduce.c new file mode 100644 index 00000000..35aec765 --- /dev/null +++ b/util/ego/sr/sr_reduce.c @@ -0,0 +1,625 @@ +/* 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,(offset) 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(); +} diff --git a/util/ego/sr/sr_reduce.h b/util/ego/sr/sr_reduce.h new file mode 100644 index 00000000..794f68f1 --- /dev/null +++ b/util/ego/sr/sr_reduce.h @@ -0,0 +1,5 @@ +/* S R _ R E D U C E . H */ + +extern strength_reduction(); /* (loop_p loop; lset ivs, vars) + * Perform streength reduction. + */ diff --git a/util/ego/sr/sr_xform.c b/util/ego/sr/sr_xform.c new file mode 100644 index 00000000..e36f95ed --- /dev/null +++ b/util/ego/sr/sr_xform.c @@ -0,0 +1,178 @@ +/* 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 +#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; +} diff --git a/util/ego/sr/sr_xform.h b/util/ego/sr/sr_xform.h new file mode 100644 index 00000000..8ea103be --- /dev/null +++ b/util/ego/sr/sr_xform.h @@ -0,0 +1,19 @@ +/* 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. + */ diff --git a/util/ego/ud/Makefile b/util/ego/ud/Makefile new file mode 100644 index 00000000..54fdbf1d --- /dev/null +++ b/util/ego/ud/Makefile @@ -0,0 +1,122 @@ +EMH=../../../h +EMLIB=../../../lib +SHR=../share + +CFILES=\ +ud.c ud_defs.c ud_const.c ud_copy.c ud_aux.c + +OFILES=\ +ud.o ud_const.o ud_copy.o ud_aux.o ud_defs.o + +HFILES=\ +ud.h ud_defs.h ud_const.h ud_copy.h ud_aux.h + +PRFILES=\ +$(CFILES) $(HFILES) Makefile + +SHARE_OFILES=\ +$(SHR)/get.o $(SHR)/put.o $(SHR)/map.o $(SHR)/alloc.o $(SHR)/global.o \ +$(SHR)/debug.o $(SHR)/lset.o $(SHR)/cset.o $(SHR)/files.o $(SHR)/aux.o \ +$(SHR)/locals.o $(SHR)/init_glob.o $(SHR)/go.o + +SHARE_MFILES=\ +$(SHR)/get.m $(SHR)/put.m $(SHR)/map.m $(SHR)/alloc.m $(SHR)/global.m \ +$(SHR)/debug.m $(SHR)/lset.m $(SHR)/cset.m $(SHR)/files.m $(SHR)/aux.m \ +$(SHR)/locals.m $(SHR)/init_glob.m $(SHR)/go.m + +ud: $(OFILES) + $(CC) -o ud $(LDFLAGS) $(OFILES) $(SHARE_OFILES) $(EMLIB)/em_data.a + +ud_ack: $(CFILES) $(SHARE_MFILES) + $(CC) -c.o $(CFLAGS) $(CFILES) $(SHARE_MFILES) + $(CC) -o ud -.c $(LDFLAGS) ud.o $(EMLIB)/em_data.a + +lint: + lint $(LINTFLAGS) $(CPPFLAGS) $(CFILES) + +pr: $(PRFILES) + @pr $? + @touch pr + +depend: + $(SHR)/makedepend + +# 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 diff --git a/util/ego/ud/ud.c b/util/ego/ud/ud.c new file mode 100644 index 00000000..7616a5e6 --- /dev/null +++ b/util/ego/ud/ud.c @@ -0,0 +1,557 @@ +/* U S E - D E F I N I T I O N A N A L Y S I S */ + +#include +#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_spec.h" +#include "ud_defs.h" +#include "ud_const.h" +#include "ud_copy.h" + +/* core allocation macros */ +#define newudbx() (bext_p) newstruct(bext_ud) +#define oldudbx(x) oldstruct(bext_ud,x) + +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,"%hd %hd %hd",&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); +} + + + diff --git a/util/ego/ud/ud.h b/util/ego/ud/ud.h new file mode 100644 index 00000000..34368ca8 --- /dev/null +++ b/util/ego/ud/ud.h @@ -0,0 +1,21 @@ +/* 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. + */ diff --git a/util/ego/ud/ud_aux.c b/util/ego/ud/ud_aux.c new file mode 100644 index 00000000..20e5a169 --- /dev/null +++ b/util/ego/ud/ud_aux.c @@ -0,0 +1,55 @@ +/* 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); + } +} diff --git a/util/ego/ud/ud_aux.h b/util/ego/ud/ud_aux.h new file mode 100644 index 00000000..8c3a5545 --- /dev/null +++ b/util/ego/ud/ud_aux.h @@ -0,0 +1,17 @@ + +/* 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. + */ diff --git a/util/ego/ud/ud_const.c b/util/ego/ud/ud_const.c new file mode 100644 index 00000000..26420321 --- /dev/null +++ b/util/ego/ud/ud_const.c @@ -0,0 +1,246 @@ +/* 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); +} diff --git a/util/ego/ud/ud_const.h b/util/ego/ud/ud_const.h new file mode 100644 index 00000000..237e4a51 --- /dev/null +++ b/util/ego/ud/ud_const.h @@ -0,0 +1,24 @@ + +/* 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. + */ diff --git a/util/ego/ud/ud_copy.c b/util/ego/ud/ud_copy.c new file mode 100644 index 00000000..3e351f6e --- /dev/null +++ b/util/ego/ud/ud_copy.c @@ -0,0 +1,390 @@ +/* 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))); +} diff --git a/util/ego/ud/ud_copy.h b/util/ego/ud/ud_copy.h new file mode 100644 index 00000000..f6b39811 --- /dev/null +++ b/util/ego/ud/ud_copy.h @@ -0,0 +1,41 @@ + +/* 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). + */ diff --git a/util/ego/ud/ud_defs.c b/util/ego/ud/ud_defs.c new file mode 100644 index 00000000..5bca2cf7 --- /dev/null +++ b/util/ego/ud/ud_defs.c @@ -0,0 +1,378 @@ + +/* 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); + } + } +} diff --git a/util/ego/ud/ud_defs.h b/util/ego/ud/ud_defs.h new file mode 100644 index 00000000..08c68db7 --- /dev/null +++ b/util/ego/ud/ud_defs.h @@ -0,0 +1,51 @@ +/* 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) diff --git a/util/ego/ud/ud_locals.h b/util/ego/ud/ud_locals.h new file mode 100644 index 00000000..b3d3a53f --- /dev/null +++ b/util/ego/ud/ud_locals.h @@ -0,0 +1,18 @@ +/* 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. + */ diff --git a/util/led/archive.c b/util/led/archive.c new file mode 100644 index 00000000..f453256e --- /dev/null +++ b/util/led/archive.c @@ -0,0 +1,178 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include "arch.h" +#include "out.h" +#include "ranlib.h" +#include "const.h" +#include "debug.h" +#include "defs.h" +#include "memory.h" + +#define ENDLIB ((long)0) + +extern ind_t hard_alloc(); + +static struct ar_hdr arhdr; + +/* + * First read a long telling how many ranlib structs there are, then + * the structs themselves. Second read a long telling how many chars there are + * in the string table, then the string table itself. + * We keep only one ranlib table in core, so this table always starts at offset + * (ind_t)0 from its base. + */ +static long +getsymdeftable() +{ + register ind_t off; + register struct ranlib *ran; + register long count; + register long nran, nchar; + extern long getlong(); + + count = nran = getlong(); + debug("%ld ranlib structs, ", nran, 0, 0, 0); + off = hard_alloc(ALLORANL, nran * sizeof(struct ranlib)); + if (off == BADOFF) + fatal("no space for ranlib structs"); + ran = (struct ranlib *)address(ALLORANL, off); + read_table(ran, count); + nchar = getlong(); + debug("%ld ranlib chars\n", nchar, 0, 0, 0); + if ((off = hard_alloc(ALLORANL, nchar)) == BADOFF) + fatal("no space for ranlib strings"); + read_char(address(ALLORANL, off), nchar); + ran = (struct ranlib *)address(ALLORANL, (ind_t)0); + while (count--) { + /* + * Adjust because names are now in core, not on file. + * Note that `ran_off' is measured from the beginning of the + * string area, NOT from the beginning of the file. + */ + if (ran->ran_off >= nchar) + fatal("bad ranlib string offset"); + ran->ran_off += off; + ran++; + } + return nran; +} + +extern char *modulname; +extern long position; + +/* + * Process archive with table of contents. The table of contents tells + * of symbols in which module they are defined. We scan the table for + * symbols that are known but not yet defined. Then we extract all necessary + * information from the corresponding module. This module may need symbols that + * were defined in modules located before this one in the archive, so we + * scan the table again. We perform these actions as long as new symbols + * are defined. + */ +arch() +{ + long nran; + bool resolved; + + nran = getsymdeftable(); + + savemagic(); + do { + register ind_t ranindex; + register long count; + + debug("(re)scan ranlib table\n", 0, 0, 0, 0); + ranindex = (ind_t)0; + count = nran; + resolved = FALSE; + while (count > 0) { + register struct ranlib *ran; + register char *string; + register struct outname *name; + register long pos; + extern int hash(); + extern struct outname *searchname(); + + ran = (struct ranlib *)address(ALLORANL, ranindex); + string = address(ALLORANL, (ind_t)ran->ran_off); + name = searchname(string, hash(string)); + if (name == (struct outname *)0 || !ISUNDEFINED(name)) { + ranindex += sizeof(struct ranlib); + count--; + continue; + } + seek(ran->ran_pos); + get_archive_header(&arhdr); + modulname = arhdr.ar_name; + debug("%s defines %s\n", modulname, string, 0, 0); + position = ran->ran_pos + SZ_ARCH; + resolved = TRUE; + /* + * This archive member is going to be linked, + * so we don't need to know what else it defines. + * Note that we assume that all ranlib information of + * one archive member is contiguous. + */ + pos = ran->ran_pos; + do { + count--; ran++; + ranindex += sizeof(struct ranlib); + } while (count > 0 && ran->ran_pos == pos); + notelib(pos); + savehdr(&arhdr); + extract(); + } + } while (resolved); + + dealloc(ALLORANL); + notelib(ENDLIB); +} + +/* + * An archive member that will be loaded is remembered by storing its position + * in the archive into the table of positions. + */ +notelib(pos) + long pos; +{ + register ind_t off; + + if ((off = hard_alloc(ALLOARCH, (long)sizeof(long))) == BADOFF) + fatal("no space for archive position"); + *(long *)address(ALLOARCH, off) = pos; +} + +/* + * Index of position of first archive member of next archive. + */ +static ind_t posindex = (ind_t)0; + +/* + * Process the archive in pass 2. + * We walk through the table of positions telling at what byte offset the + * archive header + module is located, until this position is ENDLIB, meaning + * that we've processed all needed modules in this archive. Each group of + * positions of an archive is terminated with ENDLIB. + */ +arch2() +{ + register long *pos; + register ind_t localpos; + + localpos = posindex; + for ( pos = (long *)address(ALLOARCH, localpos); + *pos != ENDLIB; + pos++, localpos += sizeof(long) + ) { + seek(*pos); + get_archive_header(&arhdr); + modulname = arhdr.ar_name; + debug("%s: archive member\n", modulname, 0, 0, 0); + position = *pos + SZ_ARCH; + finish(); + } + localpos += sizeof(long); /* Skip ENDLIB. */ + posindex = localpos; /* Remember for next call. */ +} diff --git a/util/led/assert.h b/util/led/assert.h new file mode 100644 index 00000000..9ff3ae98 --- /dev/null +++ b/util/led/assert.h @@ -0,0 +1,18 @@ +/* $Header$ */ + +#ifndef lint +#ifdef NASSERT + +#define assert(ex) + +#else NASSERT + +#define assert(ex) \ +{if (!(ex)) fatal("Assertion failed: file %s, line %d", __FILE__, __LINE__);} + +#endif NASSERT +#else lint + +#define assert(ex) + +#endif lint diff --git a/util/led/byte_order.c b/util/led/byte_order.c new file mode 100644 index 00000000..0172ec3d --- /dev/null +++ b/util/led/byte_order.c @@ -0,0 +1,90 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif lint + +#include "const.h" +#include "assert.h" + +bool bytes_reversed = FALSE; +bool words_reversed = FALSE; + +/* + * Determine the byte/word order in shorts/longs, assuming the size of a short + * is 2 chars, and the size of a long is 4 chars. Not all theoretical + * possibilities are tested; only bytes reversed and/or words reversed. + */ +determine_ordering() +{ + short s; + long l; + register char *cp; + register short *sp; + + cp = (char *)&s; + cp[0] = 0x01; cp[1] = 0x02; + if (s != 0x01 + (0x02 << 8)) + bytes_reversed = TRUE; + sp = (short *)&l; + sp[0] = 0x0001; sp[1] = 0x0002; + if (l != 0x0001 + (0x0002 << 16)) + words_reversed = TRUE; +} + +/* + * `Format' is a string of digits indicating how many bytes must be taken + * from `buf' to form an integer of some type. E.g. if the digit is '2', two + * bytes are taken to form a short. + */ +swap(buf, format) + register char *buf; + register char *format; +{ + register char savebyte; + + while (*format) { + switch (*format++) { + case '1': + buf += 1; + break; + case '2': + if (bytes_reversed) { + savebyte = buf[0]; + buf[0] = buf[1]; + buf[1] = savebyte; + } + buf += 2; + break; + case '4': + /* + * Written out to save recursive calls. + */ + if (bytes_reversed && words_reversed) { + savebyte = buf[0]; + buf[0] = buf[3]; + buf[3] = savebyte; + savebyte = buf[1]; + buf[1] = buf[2]; + buf[2] = savebyte; + } else if (bytes_reversed) { + savebyte = buf[0]; + buf[0] = buf[1]; + buf[1] = savebyte; + savebyte = buf[2]; + buf[2] = buf[3]; + buf[3] = savebyte; + } else if (words_reversed) { + savebyte = buf[0]; + buf[0] = buf[2]; + buf[2] = savebyte; + savebyte = buf[1]; + buf[1] = buf[3]; + buf[3] = savebyte; + } + buf += 4; + break; + default: + assert(FALSE); + break; + } + } +} diff --git a/util/led/const.h b/util/led/const.h new file mode 100644 index 00000000..6c70358d --- /dev/null +++ b/util/led/const.h @@ -0,0 +1,26 @@ +/* $Header$ */ + +typedef int bool; + +#define FALSE 0 +#define TRUE 1 + +#define S_ZER 0x2000 /* Internal use only. */ + +#define WIDTH 8 /* Number of bits in a byte. */ +#define BYTEMASK 0xFF /* Mask to get low order byte. */ +#define MININT (1 << (sizeof(int) * WIDTH - 1)) +#define MAXCHUNK (-(MININT + 1)) /* Highest count we write(2). */ + +#define RFLAG 0x01 /* -r flag given. */ +#define SFLAG 0x02 /* -s flag given. */ + +#define MAXSECT 64 /* Maximum number of sections. */ + +#define PLAIN 0 /* Input file is a normal file. */ +#define ARCHIVE 1 /* Input file is an archive. */ + +#define FIRST 1 /* Pass number. */ +#define SECOND 2 /* Idem. */ + +#define BADOFF ((ind_t)-1) diff --git a/util/led/debug.h b/util/led/debug.h new file mode 100644 index 00000000..16fff039 --- /dev/null +++ b/util/led/debug.h @@ -0,0 +1,11 @@ +/* $Header$ */ + +#ifdef NDEBUG + +#define debug(s, a1, a2, a3, a4) + +#else + +#define debug(s, a1, a2, a3, a4) printf(s, a1, a2, a3, a4) + +#endif diff --git a/util/led/defs.h b/util/led/defs.h new file mode 100644 index 00000000..721986a0 --- /dev/null +++ b/util/led/defs.h @@ -0,0 +1,10 @@ +/* $Header$ */ + +/* + * We need the S_EXT because we leave locals alone. + */ +#define ISUNDEFINED(n) (((n)->on_type & (S_TYP | S_EXT)) == (S_UND | S_EXT)) +#define ISABSOLUTE(n) (((n)->on_type & (S_TYP | S_EXT)) == (S_ABS | S_EXT)) +#define ISCOMMON(n) (((n)->on_type & (S_COM | S_EXT)) == (S_COM | S_EXT)) + +#define mustsavelocal(name) (!((name)->on_type & S_SCT)) diff --git a/util/led/error.c b/util/led/error.c new file mode 100644 index 00000000..59c011e2 --- /dev/null +++ b/util/led/error.c @@ -0,0 +1,71 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include +#include +#include "out.h" +#include "const.h" + +static short nerrors = 0; + +static +stop() +{ + extern char *outputname; + + if (nerrors) + unlink(outputname); + + exit(nerrors); +} + +trap_signals() +{ + static int trap_them[] = { SIGHUP, SIGINT, SIGQUIT, SIGTERM, 0 }; + register int *ip; + + for (ip = trap_them; *ip; ip++) + if (signal(*ip, stop) == SIG_IGN) + signal(*ip, SIG_IGN); /* Oops, reset. */ +} + +/* VARARGS1 */ +fatal(format, a1, a2, a3, a4) + char *format; +{ + nerrors++; + diag("fatal", format, a1, a2, a3, a4); + stop(); +} + +/* VARARGS1 */ +warning(format, a1, a2, a3, a4) + char *format; +{ + diag("warning", format, a1, a2, a3, a4); +} + +/* VARARGS1 */ +error(format, a1, a2, a3, a4) + char *format; +{ + nerrors++; + diag("error", format, a1, a2, a3, a4); +} + +static +diag(tail, format, a1, a2, a3, a4) + char *tail; + char *format; +{ + extern char *progname, *archname, *modulname; + + fprintf(stderr, "%s: ", progname); + if (archname) + fprintf(stderr, "%s: ", archname); + if (modulname) + fprintf(stderr, "%s: ", modulname); + fprintf(stderr, format, a1, a2, a3, a4); + fprintf(stderr, " (%s)\n", tail); +} diff --git a/util/led/extract.c b/util/led/extract.c new file mode 100644 index 00000000..1b186f3a --- /dev/null +++ b/util/led/extract.c @@ -0,0 +1,234 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include "out.h" +#include "const.h" +#include "debug.h" +#include "defs.h" +#include "memory.h" +#include "orig.h" +#include "scan.h" + +/* + * Get section sizes and symboltable information from present module. + */ +extract() +{ + struct outhead head; + + get_modul(); + /* + * Copy head because we need it so often but it can change place, + * so we can't trust a pointer to it. + */ + head = *(struct outhead *)modulptr(IND_HEAD); + get_names(&head); + process(&head); + skip_modul(&head); +} + +ushort NLocals = 0; /* Number of local names to be saved. */ +ushort NGlobals = 0; /* Number of global names. */ + +/* + * Walk through the nametable of this module, counting the locals that must + * appear in the final output file if this module is linked. + * That number will be returned. + */ +static +get_names(head) + register struct outhead *head; +{ + register int nnames; + register ind_t sectindex, nameindex, charindex; + register ind_t charoff; + extern int flagword; + + nnames = head->oh_nname; + sectindex = IND_SECT(*head); + nameindex = IND_NAME(*head); + charindex = IND_CHAR(*head); + charoff = OFF_CHAR(*head); + while (nnames--) { + register struct outsect *sects; + struct outname name; /* A local copy. */ + /* + * Because savelocal/getexternal might relocate the modules + * we have to compute the core addresses again. + */ + sects = (struct outsect *)modulptr(sectindex); + name = *(struct outname *)modulptr(nameindex); + /* + * Change the offset in file into an offset in the memory area. + * There will always be at least a header before the string + * area, so we don't have to be afraid to confuse "no name" + * with "the first name". + */ + if (name.on_foff) + name.on_foff += charindex - charoff; + namerelocate(&name, sects); + if (name.on_type & S_EXT) { + getexternal(&name); + } else { + /* + * The only thing we want to know about locals is + * whether they must appear in the output file. + */ + if (!(flagword & SFLAG) && mustsavelocal(&name)) { + NLocals++; + savelocal(&name); + } + } + nameindex += sizeof(struct outname); + } +} + +extern struct orig relorig[]; + +static +process(head) + register struct outhead *head; +{ + register struct outsect *sects; + register struct outsect *outsp; + register int nsect; + register struct orig *orig = relorig; + extern struct outhead outhead; + extern struct outsect outsect[]; + + outhead.oh_nrelo += head->oh_nrelo; + outhead.oh_nemit += head->oh_nemit; + if (head->oh_nsect > outhead.oh_nsect) + outhead.oh_nsect = head->oh_nsect; + sects = (struct outsect *)modulptr(IND_SECT(*head)); + nsect = head->oh_nsect; + outsp = outsect; + while (nsect--) { + outsp->os_size += sects->os_size; + outsp->os_flen += sects->os_flen; + /* + * Add all flen's and all (size - flen == zero)'s of + * preceding sections with the same number. + */ + orig->org_flen += sects->os_flen; + orig->org_zero += sects->os_size - sects->os_flen; + orig++; outsp++; sects++; + } +} + +/* + * Add relocation constant for names in user defined sections. + * The value of a common name indicates a size instead of an offset, + * and hence shouldn't be relocated. + * The value of a name in the zero part of a section is relative from the + * beginning of the section, not from the beginning of the zero part; but + * all zero parts will be put after the normal section contents, so we + * must subtract the flen of its section from the value (and later on add + * the total flen of its section) and add the accumulated size of all + * zero parts in preceding sections with the same number. + * Otherwise we just add the accumulated size of all normal parts in preceding + * sections with the same size. + */ +namerelocate(name, sects) + register struct outname *name; + struct outsect *sects; +{ + register int type = name->on_type; + register int sectindex; + + if ((type & S_TYP) == S_UND || (type & S_TYP) == S_ABS) + return; + if (type & S_COM) + return; + + sectindex = (type & S_TYP) - S_MIN; + if (name->on_valu >= sects[sectindex].os_flen) { + name->on_type |= S_ZER; + name->on_valu -= sects[sectindex].os_flen; + name->on_valu += relorig[sectindex].org_zero; + } else { + name->on_valu += relorig[sectindex].org_flen; + } +} + +/* + * If we see this name for the first time, we must remember it for + * we might need it later on. Otherwise it must confirm to what we already + * know about it, and eventually add to that knowledge. + */ +static +getexternal(name) + register struct outname *name; +{ + register char *string; + register int h; + register struct outname *old; + extern int hash(); + extern struct outname *searchname(); + + string = modulptr((ind_t)name->on_foff); + h = hash(string); + old = searchname(string, h); + if (old == (struct outname *)0) { + NGlobals++; + entername(name, h); + } else if (!ISUNDEFINED(name)) { + if (ISUNDEFINED(old)) { + transfer(name, old); + } else { + name->on_mptr = string; /* Just for convenience. */ + redefine(name, old); + } + } +} + +/* + * Handle the redefinition of `new' in the current module. + * A name can be defined in three ways, in increasing priority: + * undefined, + * common, + * defined in a section. + * A name may become "higher" when defined, but not "lower". + * A redefinition as common is allowed. It is ignored, but a warning is given + * when the desired section of `new' doesn't correspond with the section of + * `old'. If a common definition is given again for a name, we take the + * greatest value so that the common declared name always has enough space. + * If a common is defined as a not-common, the old definition is ignored. + */ +static +redefine(new, old) + register struct outname *new, *old; +{ + if (!ISCOMMON(old)) { + if (!ISCOMMON(new)) + error("%s: multiply defined", new->on_mptr); + + if ((new->on_type & S_TYP) != (old->on_type & S_TYP)) + warning("%s: sections differ", new->on_mptr); + } else { + /* `Old' is common. */ + if ((new->on_type & S_TYP) != (old->on_type & S_TYP)) + warning("%s: sections differ", new->on_mptr); + + if (ISCOMMON(new)) { + if (new->on_valu > old->on_valu) + old->on_valu = new->on_valu; + } else { + transfer(new, old); + } + } +} + +/* + * Transfer things we want to know from `src' to `dst'. + */ +static +transfer(src, dst) + register struct outname *src, *dst; +{ + debug("%s defined here\n", src->on_mptr, 0, 0, 0); + dst->on_valu = src->on_valu; + dst->on_type = src->on_type; + dst->on_desc = src->on_desc; +} diff --git a/util/led/finish.c b/util/led/finish.c new file mode 100644 index 00000000..00125f67 --- /dev/null +++ b/util/led/finish.c @@ -0,0 +1,182 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include "out.h" +#include "const.h" +#include "defs.h" +#include "memory.h" +#include "orig.h" +#include "scan.h" + +extern bool incore; +extern int flagword; + +/* + * We know all there is to know about the current module. + * Now we relocate the values in the emitted bytes and write + * those to the final output file. Then we compute the relative origins + * for the next module. + */ +finish() +{ + struct outhead *head; + struct outsect *sects; + struct outname *names; + char *chars; + + get_modul(); + head = (struct outhead *)modulptr(IND_HEAD); + sects = (struct outsect *)modulptr(IND_SECT(*head)); + names = (struct outname *)modulptr(IND_NAME(*head)); + chars = (char *)modulptr(IND_CHAR(*head)); + adjust_names(names, head, chars); + handle_relos(head, sects, names); + if (!incore && !(flagword & SFLAG)) { + put_locals(names, head->oh_nname, sects); +#ifdef SYMDBUG + put_dbug(OFF_DBUG(*head)); +#endif SYMDBUG + } + compute_origins(sects, head->oh_nsect); + skip_modul(head); +} + +/* + * Adjust all local names for the move into core. + */ +static +adjust_names(name, head, chars) + register struct outname *name; + struct outhead *head; + register char *chars; +{ + register int cnt; + register ind_t charoff; + + cnt = head->oh_nname; + charoff = OFF_CHAR(*head); + while (cnt--) { + if (name->on_foff != (long)0) + name->on_mptr = chars + name->on_foff - charoff; + name++; + } +} + +/* + * If all sections are in core, we can access them randomly, so we need only + * scan the relocation table once. Otherwise we must for each section scan + * the relocation table again, because the relocation entries of one section + * need not be consecutive. + */ +static +handle_relos(head, sects, names) + struct outhead *head; + struct outsect *sects; + struct outname *names; +{ + register struct outrelo *relo; + register int sectindex; + register int nrelo; + register char *emit; + extern char *getemit(); + extern struct outrelo *nextrelo(); + + if (incore) { + nrelo = head->oh_nrelo; sectindex = -1; + startrelo(head); relo = nextrelo(); + while (nrelo--) { + if (sectindex != relo->or_sect - S_MIN) { + sectindex = relo->or_sect - S_MIN; + emit = getemit(head, sects, sectindex); + } + relocate(head, emit, names, relo, sects); + relo++; + } + } else { + for (sectindex = 0; sectindex < head->oh_nsect; sectindex++) { + emit = getemit(head, sects, sectindex); + nrelo = head->oh_nrelo; startrelo(head); + while (nrelo--) { + relo = nextrelo(); + if (relo->or_sect - S_MIN == sectindex) { + relocate(head,emit,names,relo,sects); + /* + * Write out the (probably changed) + * relocation information. + */ + if (flagword & RFLAG) + wrt_relo(relo); + } + } + wrt_emit(emit, sectindex, sects[sectindex].os_flen); + /* + * XXX We should be able to free the emitted bytes. + */ + } + } +} + +/* + * Write out the local names that must be saved. + */ +static +put_locals(name, nnames, sects) + register struct outname *name; + register ushort nnames; + register struct outsect *sects; +{ + while (nnames--) { + if ((name->on_type & S_EXT) == 0 && mustsavelocal(name)) { + namerelocate(name, sects); + addbase(name); + wrt_name(name); + } + name++; + } +} + +/* + * Add all flen's and all (size - flen == zero)'s of preceding sections + * with the same number. + */ +static +compute_origins(sect, nsect) + register struct outsect *sect; + register ushort nsect; +{ + extern struct orig relorig[]; + register struct orig *orig = relorig; + + while (nsect--) { + orig->org_flen += sect->os_flen; + orig->org_zero += sect->os_size - sect->os_flen; + orig++; sect++; + } +} +#ifdef SYMDBUG + +/* + * Write out what is after the string area. This is likely to be + * debugging information. + */ +static +put_dbug(offdbug) + long offdbug; +{ + char buf[512]; + register int nbytes; + register long dbugsize; + extern long objectsize; + extern long position; + + dbugsize = objectsize - offdbug; + seek(position + offdbug); + while (dbugsize) { + nbytes = dbugsize > 512 ? 512 : dbugsize; + read_char(buf, (long)nbytes); + wrt_dbug(buf, nbytes); + dbugsize -= nbytes; + } +} +#endif SYMDBUG diff --git a/util/led/mach.c b/util/led/mach.c new file mode 100644 index 00000000..e17bf121 --- /dev/null +++ b/util/led/mach.c @@ -0,0 +1,24 @@ +/* + * $Header$ + */ +/* + * Values depend on the machine on which this program should run. + * Now for Vax 11/750. + */ + +#define K 1024 + + mems[ALLOEMIT + 0].mem_left = 64 * K; + mems[ALLOEMIT + 1].mem_left = 64 * K; + mems[ALLORELO].mem_left = 64 * K; + mems[ALLOLOCL].mem_left = 64 * K; + mems[ALLOGLOB].mem_left = 64 * K; + mems[ALLOLCHR].mem_left = 64 * K; + mems[ALLOGCHR].mem_left = 64 * K; +#ifdef SYMDBUG + mems[ALLODBUG].mem_left = 64 * K; +#endif SYMDBUG + mems[ALLOSYMB].mem_left = 4 * K; + mems[ALLOARCH].mem_left = 1 * K; + mems[ALLOMODL].mem_left = 3 * 64 * K; + mems[ALLORANL].mem_left = 4 * K; diff --git a/util/led/main.c b/util/led/main.c new file mode 100644 index 00000000..9f47cd16 --- /dev/null +++ b/util/led/main.c @@ -0,0 +1,554 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * led - linkage editor for ACK assemblers output format + */ + +#include +#include "out.h" +#include "const.h" +#include "debug.h" +#include "defs.h" +#include "memory.h" +#include "orig.h" + +extern bool incore; + +main(argc, argv) + int argc; + char **argv; +{ + initializations(argc, argv); + first_pass(argv); + freeze_core(); + evaluate(); + beginoutput(); + second_pass(argv); + endoutput(); + exit(0); +} + +char *progname; /* Name this program was invoked with. */ +int passnumber; /* Pass we are in. */ +struct outhead outhead; /* Header of final output file. */ +struct outsect outsect[MAXSECT];/* Its section table. */ + +/* ARGSUSED */ +static +initializations(argc, argv) + int argc; + char *argv[]; +{ + /* + * Avoid malloc()s. + */ + setbuf(stdin, (char *)NULL); + setbuf(stdout, (char *)NULL); + setbuf(stderr, (char *)NULL); + + progname = argv[0]; + passnumber = FIRST; + determine_ordering(); + init_core(); + init_symboltable(); + outhead.oh_magic = O_MAGIC; + outhead.oh_stamp = O_STAMP; +} + +/* ------------------------ ROUTINES OF FIRST PASS ------------------------- */ + +int flagword = 0; /* To store command-line options. */ +char *outputname = "a.out"; /* Name of the resulting object file. */ + +/* + * Scan the arguments. + * If the argument starts with a '-', it's a flag, else it is either + * a plain file to be loaded, or an archive. + */ +static +first_pass(argv) + register char **argv; +{ + register char *argp; + int sectno; + int h; + extern int atoi(); + extern long number(); + extern char *index(); + extern int hash(); + extern struct outname *searchname(); + extern struct outname *makename(); + + while (*++argv) { + argp = *argv; + if (*argp != '-') { + pass1(argp); + continue; + } + /* It's a flag. */ + switch (*++argp) { + case 'a': + /* + * The rest of the argument must be of the form + * `
:', where + *
and are numbers. + * will be the alignment in the machine of + * section
. + */ + sectno = atoi(++argp); + if ((argp = index(argp, ':')) == (char *)0) + fatal("usage: -a
:"); + setlign(sectno, number(++argp)); + break; + case 'b': + /* + * The rest of the argument must be of the form + * `
:', where
+ * and base are decimal numbers. will be + * the base address in the machine of section + *
. + */ + sectno = atoi(++argp); + if ((argp = index(argp, ':')) == (char *)0) + fatal("usage: -b
:"); + setbase(sectno, number(++argp)); + break; + case 'o': + /* + * The `name' argument after -o is used as name + * of the led output file, instead of "a.out". + */ + if ((outputname = *++argv) == (char *)0) + fatal("-o needs filename"); + break; + case 'r': + /* + * Generate relocation information in the output file + * so that it can be the subject of another led run. + * This flag also prevents final definitions from being + * given to common symbols, and suppresses the + * `Undefined:' diagnostic. + */ + if (flagword & SFLAG) + warning("-r contradicts -s: -s ignored"); + flagword |= RFLAG; + break; + case 's': + /* + * `Strip' the output, that is, remove the symbol table + * and relocation table to save space (but impair the + * usefullness of the debuggers). This information can + * also be removed by astrip(1). + */ + if (flagword & RFLAG) + warning("-s contradicts -r: -s ignored"); + else + flagword |= SFLAG; + break; + case 'u': + /* + * Take the following argument as a symbol and enter it + * as undefined in the symbol table. This is useful for + * loading wholly from a library, since initially the + * symbol table is empty and an unresolved reference is + * needed to force the loading of the first routine. + */ + if (*++argv == (char *)0) + fatal("-u needs symbol name"); + h = hash(*argv); + if (searchname(*argv, h) == (struct outname *)0) + entername(makename(*argv), h); + break; + default: + fatal("bad flag letter %c", *argp); + break; + } + } +} + +/* + * If `s' starts with 0x/0X, it's hexadecimal, + * else if it starts with 0b/0B, it's binary, + * else if it starts with 0, it's octal, + * else it's decimal. + */ +static long +number(s) + register char *s; +{ + register int digit; + register long value = 0; + register int radix = 10; + + if (*s == '0') { + radix = 8; + s++; + if (*s == 'x' || *s == 'X') { + radix = 16; + s++; + } else if (*s == 'b' || *s == 'B') { + radix = 2; + s++; + } + } + while (digit = *s++) { + if (digit >= 'A' && digit <= 'F') + digit -= 'A' + 10; + else if (digit >= 'a' && digit <= 'f') + digit -= 'a' + 10; + else if (digit >= '0' && digit <= '9') + digit -= '0'; + else + fatal("wrong digit %c", digit); + if (digit >= radix) + fatal("digit %c exceeds radix %d", digit, radix); + value = radix * value + digit; + } + return value; +} + +/* + * We use one bit per section to indicate whether a base was already given or + * not. Only one base may be given. The same applies for alignments. + */ +static char basemap[MAXSECT / WIDTH]; +static long sect_base[MAXSECT]; +static char lignmap[MAXSECT / WIDTH]; +static long sect_lign[MAXSECT]; + +/* +/* + * Set the alignment of section `sectno' to `lign', if this doesn't + * conflict with earlier alignment. + */ +static +setlign(sectno, lign) + register int sectno; + register long lign; +{ + extern bool setbit(); + + if (setbit(sectno, lignmap) && sect_lign[sectno] != lign) + fatal("section has different alignments"); + if (lign == (long)0) + fatal("alignment cannot be zero"); + sect_lign[sectno] = lign; +} + +/* + * Set the base of section `sectno' to `base', if no other base has been + * given yet. + */ +static +setbase(sectno, base) + register int sectno; + register long base; +{ + extern bool setbit(); + + if (setbit(sectno, basemap) && sect_base[sectno] != base) + fatal("section has different bases"); + sect_base[sectno] = base; +} + +static struct outname * +makename(string) + char *string; +{ + static struct outname namebuf; + + namebuf.on_mptr = string; + namebuf.on_type = S_UND + S_EXT; + namebuf.on_valu = (long)0; + + return &namebuf; +} + +/* + * If `file' is a plain file, symboltable information and section sizes are + * extracted. If it is an archive it is examined to see if it defines any + * undefined symbols. + */ +static +pass1(file) + char *file; +{ + if (getfile(file) == PLAIN) { + debug("%s: plain file\n", file, 0, 0, 0); + extract(); + } else { + /* It must be an archive. */ + debug("%s: archive\n", file, 0, 0, 0); + arch(); + } + closefile(file); +} + +/* ---------------- ROUTINES BETWEEN FIRST AND SECOND PASS ----------------- */ + +/* + * After pass 1 we know the sizes of all commons so we can give each common + * name an address within its section and we can compute the sizes of all + * sections in the machine. After this we can compute the bases of all + * sections. We then add the section bases to the values of names in + * corresponding sections. + */ +static +evaluate() +{ + if (!(flagword & RFLAG)) + norm_commons(); + complete_sections(); + if (!(flagword & RFLAG)) + change_names(); +} + +extern ushort NGlobals, NLocals; + +/* + * Sect_comm[N] is the number of common bytes in section N. + * It is computed after pass 1. + */ +static long sect_comm[MAXSECT]; + +/* + * If there are undefined names, we print them and we set a flag so that + * the output can be subject to another led run and we return. + * We now know how much space each common name needs. We change the value + * of the common name from the size to the address within its section, + * just like "normal" names. We also count the total size of common names + * within each section to be able to compute the final size in the machine. + */ +static +norm_commons() +{ + register struct outname *name; + register int cnt; + register int und = FALSE; + + name = (struct outname *)address(ALLOGLOB, (ind_t)0); + cnt = NGlobals; + while (cnt-- > 0) { + if (ISUNDEFINED(name)) { + if (!und) { + und = TRUE; + outhead.oh_flags |= HF_LINK; + flagword = (flagword & ~SFLAG) | RFLAG; + fprintf(stderr, "Undefined:\n"); + } + fprintf(stderr, "\t%s\n", + address(ALLOGCHR, (ind_t)name->on_foff) + ); + } + name++; + } + if (flagword & RFLAG) return; + + /* + * RFLAG is off, so we need not produce relocatable output. + * We can now assign an address to common names. + * It also means that there are no undefined names. + */ + name = (struct outname *)address(ALLOGLOB, (ind_t)0); + cnt = NGlobals; + while (cnt-- > 0) { + if (!ISABSOLUTE(name) && ISCOMMON(name)) { + register long size; + register int sectindex; + + size = name->on_valu; /* XXX rounding? */ + sectindex = (name->on_type & S_TYP) - S_MIN; + name->on_valu = + outsect[sectindex].os_size + + sect_comm[sectindex]; + sect_comm[sectindex] += size; + name->on_type &= ~S_COM; + } + name++; + } +} + +struct orig relorig[MAXSECT]; + +/* + * Compute the offsets in file and machine that the sections will have. + * Also set the origins to 0. + */ +static +complete_sections() +{ + register long base = 0; + register long foff; + register int sectindex; + extern bool tstbit(); + + foff = SZ_HEAD + outhead.oh_nsect * SZ_SECT; + for (sectindex = 0; sectindex < outhead.oh_nsect; sectindex++) { + relorig[sectindex].org_flen = (long)0; + relorig[sectindex].org_zero = (long)0; + outsect[sectindex].os_foff = foff; + foff += outsect[sectindex].os_flen; + + if (flagword & RFLAG) + continue; + + outsect[sectindex].os_size += sect_comm[sectindex]; + outsect[sectindex].os_lign = + tstbit(sectindex, lignmap) ? sect_lign[sectindex] : 1; + if (tstbit(sectindex, basemap)) { + base = sect_base[sectindex]; + if (base % outsect[sectindex].os_lign) + fatal("base not aligned"); + } else { + base += outsect[sectindex].os_lign - 1; + base -= base % outsect[sectindex].os_lign; + } + outsect[sectindex].os_base = base; + base += outsect[sectindex].os_size; + } +} + +/* + * For each name we add the base of its section to its value, unless + * the output has to be able to be linked again, as indicated by RFLAG. + */ +static +change_names() +{ + register int cnt; + register struct outname *name; + + name = (struct outname *)address(ALLOGLOB, (ind_t)0); + cnt = NGlobals; + while (cnt-- > 0) { + addbase(name); + name++; + } + if (!incore) + return; + /* + * Do the same with the local names. + */ + name = (struct outname *)address(ALLOLOCL, (ind_t)0); + cnt = NLocals; + while (cnt-- > 0) { + addbase(name); + name++; + } +} + +#define BIT 0x01 + +/* + * This function sets a bit with index `indx' in string. + * It returns whether it was already set. + */ +bool +setbit(indx, string) + int indx; + char string[]; +{ + register int byte_index, bit_index; + register int byte; + + byte_index = indx / WIDTH; /* Index of byte with bit we need. */ + bit_index = indx % WIDTH; /* Index of bit we need. */ + byte = string[byte_index]; + byte >>= bit_index; + if (byte & BIT) return TRUE; + + byte = BIT; + byte <<= bit_index; + string[byte_index] |= byte; + return FALSE; +} + +/* + * This function returns whether the bit given by `indx' is set in `string'. + */ +static bool +tstbit(indx, string) + int indx; + char string[]; +{ + register int byte_index, bit_index; + register int byte; + + byte_index = indx / WIDTH; /* Index of byte with bit we need. */ + bit_index = indx % WIDTH; /* Index of bit we need. */ + byte = string[byte_index]; + byte >>= bit_index; + + return byte & BIT; +} + +/* + * Add the base of the section of a name to its value. For a name in the zero + * part, the size of the normal part is also a "base". + */ +addbase(name) + struct outname *name; +{ + register int type = name->on_type & S_TYP; + register int sectindex = type - S_MIN; + + if (type == S_UND || type == S_ABS) + return; + if (name->on_type & S_COM) + return; + + if (name->on_type & S_ZER) { + name->on_valu += outsect[sectindex].os_flen; + name->on_type &= ~S_ZER; + } + name->on_valu += outsect[sectindex].os_base; + debug( "%s: type 0x%x, value %ld\n", + address((name->on_type & S_EXT) ? ALLOGCHR : ALLOLCHR, + (ind_t)name->on_foff + ), + name->on_type, name->on_valu, 0 + ); +} + +/* ------------------------ ROUTINES OF SECOND PASS ------------------------ */ + +/* + * Flags have already been processed, so we ignore them here. + */ +static +second_pass(argv) + char **argv; +{ + passnumber = SECOND; + while (*++argv) { + if ((*argv)[0] != '-') { + pass2(*argv); + continue; + } + switch ((*argv)[1]) { + case 'o': + case 'u': + ++argv; + break; + default: + break; + } + } +} + +static +pass2(file) + char *file; +{ + if (getfile(file) == PLAIN) { + debug("%s: plain file\n", file, 0, 0, 0); + finish(); + } else { + /* It must be an archive. */ + debug("%s: archive\n", file, 0, 0, 0); + arch2(); + } + closefile(file); +} diff --git a/util/led/memory.c b/util/led/memory.c new file mode 100644 index 00000000..8069af18 --- /dev/null +++ b/util/led/memory.c @@ -0,0 +1,459 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * Memory manager. Memory is divided into NMEMS pieces. There is a struct + * for each piece telling where it is, how many bytes are used, and how may + * are left. If a request for core doesn't fit in the left bytes, an sbrk() + * is done and pieces after the one that requested the growth are moved up. + */ + +#include "out.h" +#include "const.h" +#include "assert.h" +#include "debug.h" +#include "memory.h" + +struct memory mems[NMEMS]; + +bool incore = TRUE; /* TRUE while everything can be kept in core. */ +ind_t core_position = (ind_t)0; /* Index of current module. */ + +#define AT_LEAST 2 /* See comment about string areas. */ + +/* + * Initialize some pieces of core. We hope that this will be our last + * real allocation, meaning we've made the right choices. + */ +init_core() +{ + register char *base; + register ind_t total_size; + register struct memory *mem; + extern char *sbrk(); + +#include "mach.c" + + total_size = (ind_t)0; /* Will accumulate the sizes. */ + base = sbrk(0); /* First free. */ + for (mem = mems; mem < &mems[NMEMS]; mem++) { + mem->mem_base = base; + mem->mem_full = (ind_t)0; + base += mem->mem_left; /* Each piece will start after prev. */ + total_size += mem->mem_left; + } + /* + * String areas are special-cased. The first byte is unused as a way to + * distinguish a name without string from a name which has the first + * string in the string area. + */ + if (mems[ALLOLCHR].mem_left == 0) + total_size += 1; + else + mems[ALLOLCHR].mem_left -= 1; + if (mems[ALLOGCHR].mem_left == 0) + total_size += 1; + else + mems[ALLOGCHR].mem_left -= 1; + mems[ALLOLCHR].mem_full = 1; + mems[ALLOGCHR].mem_full = 1; + + if (total_size != (int)total_size || (int)sbrk((int)total_size) == -1) { + incore = FALSE; /* In core strategy failed. */ + if ((int)sbrk(AT_LEAST) == -1) + fatal("no core at all"); + } +} + +/* + * Allocate an extra block of `incr' bytes and move all pieces with index + * higher than `piece' up with the size of the block. Return whether the + * allocate succeeded. + */ +static bool +move_up(piece, incr) + register int piece; + register ind_t incr; +{ + register struct memory *mem; + extern char *sbrk(); + + debug("move_up(%d, %d)\n", piece, (int)incr, 0, 0); + if (incr != (int)incr || (int)sbrk((int)incr) == -1) + return FALSE; + + for (mem = &mems[NMEMS - 1]; mem > &mems[piece]; mem--) + copy_up(mem, incr); + + mems[piece].mem_left += incr; + return TRUE; +} + +extern int passnumber; + +/* + * This routine is called if `piece' needs `incr' bytes and the system won't + * give them. We first steal the free bytes of all lower pieces and move them + * and `piece' down. If that doesn't give us enough bytes, we steal the free + * bytes of all higher pieces and move them up. We return whether we have + * enough bytes, the first or the second time. + */ +static bool +compact(piece, incr) + register int piece; + register ind_t incr; +{ + register ind_t gain; + register struct memory *mem; + + debug("compact(%d, %d)\n", piece, (int)incr, 0, 0); + gain = mems[0].mem_left; + mems[0].mem_left = (ind_t)0; + for (mem = &mems[1]; mem <= &mems[piece]; mem++) { + /* Here memory is inserted before a piece. */ + assert(passnumber == FIRST || gain == (ind_t)0); + copy_down(mem, gain); + gain += mem->mem_left; + mem->mem_left = (ind_t)0; + } + /* + * Note that we already added the left bytes of the piece we want to + * enlarge to `gain'. + */ + if (gain < incr) { + register ind_t up = (ind_t)0; + + for (mem = &mems[NMEMS - 1]; mem > &mems[piece]; mem--) { + /* Here memory is appended after a piece. */ + up += mem->mem_left; + copy_up(mem, up); + mem->mem_left = (ind_t)0; + } + gain += up; + } + mems[piece].mem_left = gain; + return gain >= incr; +} + +/* + * The bytes of `mem' must be moved `dist' down in the address space. + * We copy the bytes from low to high, because the tail of the new area may + * overlap with the old area, but we do not want to overwrite them before they + * are copied. + */ +static +copy_down(mem, dist) + register struct memory *mem; + ind_t dist; +{ + register char *old; + register char *new; + register ind_t size; + + size = mem->mem_full; + old = mem->mem_base; + new = old - dist; + mem->mem_base = new; + while (size--) + *new++ = *old++; +} + +/* + * The bytes of `mem' must be moved `dist' up in the address space. + * We copy the bytes from high to low, because the tail of the new area may + * overlap with the old area, but we do not want to overwrite them before they + * are copied. + */ +static +copy_up(mem, dist) + register struct memory *mem; + ind_t dist; +{ + register char *old; + register char *new; + register ind_t size; + + size = mem->mem_full; + old = mem->mem_base + size; + new = old + dist; + while (size--) + *--new = *--old; + mem->mem_base = new; +} + +/* + * Add `size' bytes to the bytes already allocated for `piece'. If it has no + * free bytes left, ask them from memory or, if that fails, from the free + * bytes of other pieces. The offset of the new area is returned. No matter + * how many times the area is moved, because of another allocate, this offset + * remains valid. + */ +ind_t +alloc(piece, size) + register int piece; + register long size; +{ + register ind_t incr = 0; + register ind_t left = mems[piece].mem_left; + register ind_t full = mems[piece].mem_full; + + assert(passnumber == FIRST || (!incore && piece == ALLOMODL)); + if (size == (long)0) + return full; + if (size != (ind_t)size) + return BADOFF; + + while (left + incr < size) + incr += INCRSIZE; + + if (incr == 0 || move_up(piece, incr) || compact(piece, incr)) { + mems[piece].mem_full += size; + mems[piece].mem_left -= size; + return full; + } else { + incore = FALSE; + return BADOFF; + } +} + +/* + * Same as alloc() but for a piece which really needs it. If the first + * attempt fails, release the space occupied by other pieces and try again. + */ +ind_t +hard_alloc(piece, size) + register int piece; + register long size; +{ + register ind_t ret; + register int i; + + if (size != (ind_t)size) + return BADOFF; + if ((ret = alloc(piece, size)) != BADOFF) + return ret; + + /* + * Deallocate what we don't need. + */ + for (i = 0; i < NMEMS; i++) { + switch (i) { + case ALLOGLOB: + case ALLOGCHR: + case ALLOSYMB: + case ALLOARCH: + case ALLOMODL: + break; /* Do not try to deallocate this. */ + default: + dealloc(i); + break; + } + } + free_saved_moduls(); + + return alloc(piece, size); +} + +/* + * We don't need the previous modules, so we put the current module + * at the start of the piece allocated for module contents, thereby + * overwriting the saved modules, and release its space. + */ +static +free_saved_moduls() +{ + register ind_t size; + register char *old, *new; + register struct memory *mem = &mems[ALLOMODL]; + + size = mem->mem_full - core_position; + new = mem->mem_base; + old = new + core_position; + while (size--) + *new++ = *old++; + mem->mem_full -= core_position; + mem->mem_left += core_position; + core_position = (ind_t)0; +} + +/* + * The piece of memory with index `piece' is no longer needed. + * We take care that it can be used by compact() later, if needed. + */ +dealloc(piece) + register int piece; +{ + /* + * Some pieces need their memory throughout the program. + */ + assert(piece != ALLOGLOB); + assert(piece != ALLOGCHR); + assert(piece != ALLOSYMB); + assert(piece != ALLOARCH); + mems[piece].mem_left += mems[piece].mem_full; + mems[piece].mem_full = (ind_t)0; +} + +char * +core_alloc(piece, size) + register int piece; + register long size; +{ + register ind_t off; + + if ((off = alloc(piece, size)) == BADOFF) + return (char *)0; + return address(piece, off); +} + +/* + * Reset index into piece of memory for modules and + * take care that the allocated pieces will not be moved. + */ +freeze_core() +{ + register int i; + + core_position = (ind_t)0; + + if (incore) + return; + + for (i = 0; i < NMEMS; i++) { + switch (i) { + case ALLOGLOB: + case ALLOGCHR: + case ALLOSYMB: + case ALLOARCH: + break; /* Do not try to deallocate this. */ + default: + dealloc(i); + break; + } + } + compact(NMEMS - 1, (ind_t)0); +} + +/* ------------------------------------------------------------------------- */ + +extern bool bytes_reversed; +extern bool words_reversed; + +/* + * To transform the various pieces of the output in core to the file format, + * we must order the bytes in the ushorts and longs as ACK prescribes. + */ +write_bytes() +{ + ushort nsect, nrelo; + long offchar; + int fd; + register struct memory *mem; + extern ushort NLocals, NGlobals; + extern long NLChars, NGChars; + extern int flagword; + extern struct outhead outhead; + extern struct outsect outsect[]; + extern char *outputname; + + nsect = outhead.oh_nsect; + nrelo = outhead.oh_nrelo; + offchar = OFF_CHAR(outhead); + + if (bytes_reversed || words_reversed) { + swap((char *)&outhead, SF_HEAD); + sectswap(outsect, nsect); + reloswap(nrelo); + } + /* + * We allocated two areas: one for local and one for global names. + * Also, we used another kind of on_foff than on file. + * At the end of the global area we have put the section names. + */ + if (!(flagword & SFLAG)) { + namecpy((struct outname *)mems[ALLOLOCL].mem_base, + NLocals, + offchar + ); + namecpy((struct outname *)mems[ALLOGLOB].mem_base, + NGlobals + nsect, + offchar + NLChars + ); + } + if ((fd = creat(outputname, 0666)) < 0) + fatal("can't create %s", outputname); + /* + * These pieces must always be written. + */ + writelong(fd, (char *)&outhead, (ind_t)SZ_HEAD); + writelong(fd, (char *)outsect, (ind_t)nsect * SZ_SECT); + for (mem = &mems[ALLOEMIT]; mem < &mems[ALLORELO]; mem++) + writelong(fd, mem->mem_base, mem->mem_full); + /* + * The rest depends on the flags. + */ + if (flagword & RFLAG) + writelong(fd, mems[ALLORELO].mem_base, mems[ALLORELO].mem_full); + if (!(flagword & SFLAG)) { + writelong(fd, mems[ALLOLOCL].mem_base, mems[ALLOLOCL].mem_full); + writelong(fd, mems[ALLOGLOB].mem_base, mems[ALLOGLOB].mem_full); + writelong(fd, mems[ALLOLCHR].mem_base + 1, (ind_t)NLChars); + writelong(fd, mems[ALLOGCHR].mem_base + 1, (ind_t)NGChars); +#ifdef SYMDBUG + writelong(fd, mems[ALLODBUG].mem_base, mems[ALLODBUG].mem_full); +#endif SYMDBUG + } + close(fd); +} + +static +writelong(fd, base, size) + register int fd; + register char *base; + register ind_t size; +{ + register int chunk; + + while (size) { + chunk = size > (ind_t)MAXCHUNK ? MAXCHUNK : size; + write(fd, base, chunk); + size -= chunk; + base += chunk; + } +} + +static +sectswap(sect, nsect) + register struct outsect *sect; + register ushort nsect; +{ + while (nsect--) + swap((char *)sect++, SF_SECT); +} + +static +reloswap(nrelo) + register ushort nrelo; +{ + register struct outrelo *relo; + + relo = (struct outrelo *)mems[ALLORELO].mem_base; + while (nrelo--) + swap((char *)relo++, SF_RELO); +} + +static +namecpy(name, nname, offchar) + register struct outname *name; + register ushort nname; + register long offchar; +{ + while (nname--) { + if (name->on_foff) + name->on_foff += offchar - 1; + if (bytes_reversed || words_reversed) + swap((char *)name, SF_NAME); + name++; + } +} diff --git a/util/led/memory.h b/util/led/memory.h new file mode 100644 index 00000000..e78b065d --- /dev/null +++ b/util/led/memory.h @@ -0,0 +1,35 @@ +/* $Header$ */ + +#define ALLOEMIT 0 /* Section contents. */ +#define ALLORELO (ALLOEMIT + MAXSECT) /* Relocation table. */ +#define ALLOLOCL (ALLORELO + 1) /* Saved local names. */ +#define ALLOGLOB (ALLOLOCL + 1) /* Saved global names. */ +#define ALLOLCHR (ALLOGLOB + 1) /* Strings of local names. */ +#define ALLOGCHR (ALLOLCHR + 1) /* Strings of global names. */ +#ifdef SYMDEBUG +#define ALLODBUG (ALLOGCHR + 1) /* Symbolic debugging info. */ +#else SYMDEBUG +#define ALLODBUG ALLOGCHR +#endif SYMDEBUG +#define ALLOSYMB (ALLODBUG + 1) /* Symbol table. */ +#define ALLOARCH (ALLOSYMB + 1) /* Archive positions. */ +#define ALLOMODL (ALLOARCH + 1) /* Modules. */ +#define ALLORANL (ALLOMODL + 1) /* Ranlib information. */ +#define NMEMS (ALLORANL + 1) + +#define INCRSIZE 1024 + +typedef unsigned int ind_t; +#define BADOFF ((ind_t)-1) + +struct memory { + char *mem_base; + ind_t mem_full; + ind_t mem_left; +}; +extern struct memory mems[]; + +#define address(piece,offset) (mems[(piece)].mem_base+(offset)) +#define modulptr(offset) (mems[ALLOMODL].mem_base+core_position+(offset)) + +extern ind_t core_position; diff --git a/util/led/orig.h b/util/led/orig.h new file mode 100644 index 00000000..0fed9e97 --- /dev/null +++ b/util/led/orig.h @@ -0,0 +1,6 @@ +/* $Header$ */ + +struct orig { + long org_flen; /* Accumulated length of preceding sections. */ + long org_zero; /* " " " zeroparts. */ +}; diff --git a/util/led/output.c b/util/led/output.c new file mode 100644 index 00000000..9547e9eb --- /dev/null +++ b/util/led/output.c @@ -0,0 +1,80 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include "out.h" +#include "const.h" +#include "memory.h" + +extern struct outhead outhead; +extern bool incore; +extern int flagword; + +/* + * We have counted all relocation structs but we know only now if + * these must be emitted.We add all names here,unless the -s(trip) + * flag was given. + * If this flag is given we don't need the string table either. + */ +beginoutput() +{ + extern ushort NLocals, NGlobals; + extern long NLChars, NGChars; + + if (incore) + generate_section_names(); + + if (!(flagword & RFLAG)) + outhead.oh_nrelo = (ushort)0; + if (flagword & SFLAG) { + outhead.oh_nname = (ushort)0; + outhead.oh_nchar = (long)0; + } else { + outhead.oh_nname = NLocals + NGlobals + outhead.oh_nsect; + outhead.oh_nchar = NLChars + NGChars; + } + trap_signals(); + if (!incore) + begin_write(); +} + +/* + * Generate names for all sections and put them after the global names. + * Section names are used for relocation. + */ +static +generate_section_names() +{ + register struct outname *name; + register int sectindex; + register long size; + extern struct outsect outsect[]; + extern char *core_alloc(); + + size = (long)outhead.oh_nsect * sizeof(struct outname); + name = (struct outname *)core_alloc(ALLOGLOB, size); + if (name == (struct outname *)0) + return; + + for (sectindex = 0; sectindex < outhead.oh_nsect; sectindex++, name++) { + name->on_foff = (long)0; /* No string name. */ + name->on_type = (S_MIN + sectindex) | S_SCT; + name->on_desc = (ushort)0; + name->on_valu = outsect[sectindex].os_base; + } +} + +/* + * If we didn't keep the whole output file in core, most of it has been + * written out, and we just finish that. + * If we did, we write out our pieces of core. + */ +endoutput() +{ + if (!incore) { + if (!(flagword & SFLAG)) + end_write(); + } else { + write_bytes(); + } +} diff --git a/util/led/read.c b/util/led/read.c new file mode 100644 index 00000000..f888a71a --- /dev/null +++ b/util/led/read.c @@ -0,0 +1,134 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * Routines to read in the various parts of the object file. + */ + +#include "arch.h" +#include "out.h" +#include "ranlib.h" +#include "const.h" +#include "assert.h" + +int infile; /* The current input file. */ + +extern bool bytes_reversed; +extern bool words_reversed; + +ushort +getushort() +{ + ushort ubuf; + + if (read(infile, (char *)&ubuf, 2) != 2) + fatal("premature EOF"); + if (bytes_reversed) + swap((char *)&ubuf, "2"); + return ubuf; +} + +long +getlong() +{ + long lbuf; + + if (read(infile, (char *)&lbuf, 4) != 4) + fatal("premature EOF"); + if (bytes_reversed || words_reversed) + swap((char *)&lbuf, "4"); + return lbuf; +} + +read_head(head) + register struct outhead *head; +{ + if (read(infile, (char *)head, SZ_HEAD) != SZ_HEAD) + fatal("premature EOF"); + if (bytes_reversed || words_reversed) + swap((char *)head, SF_HEAD); + if (BADMAGIC(*head)) + fatal("bad magic number"); +} + +/* + * Someone inadvertently misaligned a long, thereby creating a hole. + * Therefore we can't read the header in one chunk. + */ +read_arhdr(arhdr) + register struct ar_hdr *arhdr; +{ + if (read(infile, (char *)arhdr, 14) != 14) + fatal("premature EOF"); + if (read(infile, (char *)&arhdr->ar_date, SZ_ARCH - 14) != SZ_ARCH - 14) + fatal("premature EOF"); + if (bytes_reversed || words_reversed) + swap((char *)&arhdr->ar_date, SF_ARCH); +} + +read_table(ran, cnt) + register struct ranlib *ran; + register long cnt; +{ + read_char((char *)ran, cnt * SZ_RAN); + if (bytes_reversed || words_reversed) + while (cnt--) + swap((char *)ran++, SF_RAN); +} + +read_sect(sect, cnt) + register struct outsect *sect; + register ushort cnt; +{ + if (read(infile, (char *)sect, cnt * SZ_SECT) != cnt * SZ_SECT) + fatal("premature EOF"); + if (bytes_reversed || words_reversed) + while (cnt--) + swap((char *)sect++, SF_SECT); +} + +read_emit(emit, cnt) + register char *emit; + register long cnt; +{ + read_char(emit, cnt); +} + +read_relo(relo, cnt) + register struct outrelo *relo; + register ushort cnt; +{ + read_char((char *)relo, (long)cnt * SZ_RELO); + if (bytes_reversed || words_reversed) + while (cnt--) + swap((char *)relo++, SF_RELO); +} + +read_name(name, cnt) + register struct outname *name; + register ushort cnt; +{ + read_char((char *)name, (long)cnt * SZ_NAME); + if (bytes_reversed || words_reversed) + while (cnt--) + swap((char *)name++, SF_NAME); +} + +/* + * We don't have to worry about byte order here. + */ +read_char(string, cnt) + register char *string; + register long cnt; +{ + register int n; + + while (cnt) { + n = cnt >= MAXCHUNK ? MAXCHUNK : cnt; + if (read(infile, string, n) != n) + fatal("premature EOF"); + string += n; + cnt -= n; + } +} diff --git a/util/led/relocate.c b/util/led/relocate.c new file mode 100644 index 00000000..05d60482 --- /dev/null +++ b/util/led/relocate.c @@ -0,0 +1,256 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#include "out.h" +#include "const.h" +#include "debug.h" +#include "defs.h" +#include "orig.h" + +#define UBYTE(x) ((x) & BYTEMASK) + +/* + * The bits in type indicate how many bytes the value occupies and what + * significance should be attributed to each byte. + */ +static long +getvalu(addr, type) + char addr[]; + char type; +{ + ushort word0, word1; + + switch (type & RELSZ) { + case RELO1: + return UBYTE(addr[0]); + case RELO2: + if (type & RELBR) + return (UBYTE(addr[0]) << WIDTH) + UBYTE(addr[1]); + else + return (UBYTE(addr[1]) << WIDTH) + UBYTE(addr[0]); + case RELO4: + if (type & RELBR) { + word0 = (UBYTE(addr[0]) << WIDTH) + UBYTE(addr[1]); + word1 = (UBYTE(addr[2]) << WIDTH) + UBYTE(addr[3]); + } else { + word0 = (UBYTE(addr[1]) << WIDTH) + UBYTE(addr[0]); + word1 = (UBYTE(addr[3]) << WIDTH) + UBYTE(addr[2]); + } + if (type & RELWR) + return ((long)word0 << (2 * WIDTH)) + word1; + else + return ((long)word1 << (2 * WIDTH)) + word0; + default: + fatal("bad relocation size"); + } + /* NOTREACHED */ +} + +/* + * The bits in type indicate how many bytes the value occupies and what + * significance should be attributed to each byte. + * We do not check for overflow. + */ +static +putvalu(valu, addr, type) + long valu; + char addr[]; + char type; +{ + ushort word0, word1; + + switch (type & RELSZ) { + case RELO1: + addr[0] = valu; + break; + case RELO2: + if (type & RELBR) { + addr[0] = valu >> WIDTH; + addr[1] = valu; + } else { + addr[0] = valu; + addr[1] = valu >> WIDTH; + } + break; + case RELO4: + if (type & RELWR) { + word0 = valu >> (2 * WIDTH); + word1 = valu; + } else { + word0 = valu; + word1 = valu >> (2 * WIDTH); + } + if (type & RELBR) { + addr[0] = word0 >> WIDTH; + addr[1] = word0; + addr[2] = word1 >> WIDTH; + addr[3] = word1; + } else { + addr[0] = word0; + addr[1] = word0 >> WIDTH; + addr[2] = word1; + addr[3] = word1 >> WIDTH; + } + break; + default: + fatal("bad relocation size"); + } +} + +/* + * Returns whether `valu' refers to the zero part of its section. + * The address of its zero part (relative to the beginning of the section) + * is in `zero_addr'. If `valu' is used in a pc-relative address computation, + * we have to do that computation ourselves. A pc-relative address is the + * difference between the address of the byte after the value and the "real" + * address: + * referencing address + its size + pc-relative address == "real" address. + */ +static bool +refers_zero(valu, relo, zero_addr) + register long valu; + struct outrelo *relo; + long zero_addr; +{ + if (relo->or_type & RELPC) { + valu += relo->or_addr; + /* + * Below is a dirty switch-statement. But an even dirtier + * statement would be: valu += (relo->or_type & RELSZ), + * because in that case you would have to know the values + * of the RELO[124] symbols. + */ + switch (relo->or_type & RELSZ) { + case RELO4: valu += 1; + valu += 1; + case RELO2: valu += 1; + case RELO1: valu += 1; + } + } + return valu >= zero_addr; +} + +extern ushort NLocals, NGlobals; +extern struct outsect outsect[]; +extern struct orig relorig[]; + +/* + * There are two cases: `local' is an undefined external or common name, + * or `local' is a section name. + * First case: if the name has been defined in another module, + * its value is known and can be added. Or_nami will be the + * index of the name of the section in which this name was + * defined. Otherwise we must change or_nami to the index of + * this name in the name table of the output file and leave + * its value unchanged. + * Second case: we must update the value by the change + * in position of the section of local. + */ +static ushort +addrelo(relo, names, sects, valu_out) + struct outrelo *relo; + struct outname *names; + struct outsect *sects; + long *valu_out; /* Out variable. */ +{ + register struct outname *local = &names[relo->or_nami]; + register ushort index = NLocals; + register long valu = *valu_out; + + if (ISUNDEFINED(local) || ISCOMMON(local)) { + register struct outname *name; + extern int hash(); + extern struct outname *searchname(); + extern ushort indexof(); + + name = searchname(local->on_mptr, hash(local->on_mptr)); + if (name == (struct outname *)0) + fatal("name %s not found in pass 2", local->on_mptr); + if (ISCOMMON(name) || ISUNDEFINED(name)) { + debug("can't relocate from %s\n",local->on_mptr,0,0,0); + index += indexof(name); + } else { + valu += name->on_valu; + index += NGlobals + (name->on_type & S_TYP) - S_MIN; + } + } else { + register int sectindex = (local->on_type & S_TYP) - S_MIN; + + if (!(local->on_type & S_SCT)) + fatal("bad relocation index"); + if (refers_zero(valu, relo, sects[sectindex].os_flen)) { + valu -= sects[sectindex].os_flen; + valu += outsect[sectindex].os_flen; + valu += relorig[sectindex].org_zero; + } else { + valu += relorig[sectindex].org_flen; + } + valu += outsect[sectindex].os_base; + index += NGlobals + sectindex; + } + *valu_out = valu; + return index; +} + +/* + * This routine relocates a value in a section pointed to by `emit', of + * which the header is pointed to by `head'. Relocation is relative to the + * names in `names'; `relo' tells how to relocate. + */ +relocate(head, emit, names, relo, sects) + struct outhead *head; + char *emit; + struct outname names[]; + struct outrelo *relo; + struct outsect *sects; +{ + long valu; + int sectindex = relo->or_sect - S_MIN; + extern struct outhead outhead; + + /* + * Pick up previous value at location to be relocated. + */ + valu = getvalu(emit + relo->or_addr, relo->or_type); + /* + * Or_nami is an index in the name table of the considered module. + * The name of which it is an index can be: + * - an undefined external or a common name + * - a section name + * - the first name outside! the name table (argh) + */ + if (relo->or_nami < head->oh_nname) { + /* First two cases. */ + relo->or_nami = addrelo(relo, names, sects, &valu); + } else { + /* + * Third case: it is absolute. The relocation of absolute + * names is always 0. We only need to change the index. + */ + relo->or_nami = NLocals + NGlobals + outhead.oh_nsect; + } + + /* + * If relocation is pc-relative, we had to update the value by + * the change in distance between the referencING and referencED + * section. We already added the origin of the referencED section; + * now we subtract the origin of the referencING section. + * Note that the the value to be relocated cannot lie within the + * zero part. + */ + if (relo->or_type & RELPC) + valu -= relorig[sectindex].org_flen+outsect[sectindex].os_base; + + /* + * Now put the value back. + */ + putvalu(valu, emit + relo->or_addr, relo->or_type); + + /* + * We must change the offset within the section of the value to be + * relocated to its offset in the new section. `Or_addr' must again be + * in the normal part, of course. + */ + relo->or_addr += relorig[sectindex].org_flen; +} diff --git a/util/led/save.c b/util/led/save.c new file mode 100644 index 00000000..807c79e6 --- /dev/null +++ b/util/led/save.c @@ -0,0 +1,104 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * If everything is kept in core, we must save some things for the second pass. + */ + +#include "arch.h" +#include "out.h" +#include "const.h" +#include "assert.h" +#include "memory.h" + +extern bool incore; +extern char *core_alloc(); + +savemagic() +{ + register char *p; + + if (!incore) + return; + + if ((p = core_alloc(ALLOMODL, (long)sizeof(ushort))) != (char *)0) { + *(ushort *)p = ARMAG; + core_position += sizeof(ushort); + } +} + +savehdr(hdr) + struct ar_hdr *hdr; +{ + register char *p; + + if (!incore) + return; + + if ((p=core_alloc(ALLOMODL,(long)sizeof(struct ar_hdr)))!=(char *)0) { + *(struct ar_hdr *)p = *hdr; + core_position += sizeof(struct ar_hdr); + } +} + +long NLChars = 0; /* Size of string area for local names. */ +long NGChars = 0; /* Idem for global names. */ + +/* + * Put the string in cp into the block allocated for the string area. + * Return its offset in this area. We don't use the first char of the string + * area, so that empty strings can be distinguished from the first string. + */ +ind_t +savechar(piece, off) + register int piece; + register ind_t off; +{ + register long len; + register ind_t newoff; + extern int strlen(); + extern ind_t alloc(); + extern ind_t hard_alloc(); + extern char *strcpy(); + + if (off == (ind_t)0) + return 0; + + len = strlen(modulptr(off)) + 1; + if (piece == ALLOLCHR) { + NLChars += len; + if (!incore || (newoff = alloc(piece, len)) == BADOFF) + return BADOFF; + } else { + assert(piece == ALLOGCHR); + NGChars += len; + if ((newoff = hard_alloc(piece, len)) == BADOFF) + return BADOFF; + } + strcpy(address(piece, newoff), modulptr(off)); + return newoff; +} + +/* + * Put the local in `name' in the piece allocated for local names that must + * be saved. `Name' points to a private copy, so will not become invalid after + * allocation, but the string of which name->on_foff is the offset may be + * destroyed, so we save that first. + */ +savelocal(name) + struct outname *name; +{ + ind_t savindex; + struct outname *new; + + if ((savindex = savechar(ALLOLCHR, (ind_t)name->on_foff)) == BADOFF) + return; + + new = (struct outname *) + core_alloc(ALLOLOCL, (long)sizeof(struct outname)); + if (new != (struct outname *)0) { + *new = *name; + new->on_foff = savindex; + } +} diff --git a/util/led/scan.c b/util/led/scan.c new file mode 100644 index 00000000..32ed1efd --- /dev/null +++ b/util/led/scan.c @@ -0,0 +1,524 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +#ifdef SYMDBUG +#include +#include +#endif SYMDBUG +#include "arch.h" +#include "out.h" +#include "ranlib.h" +#include "const.h" +#include "assert.h" +#include "memory.h" +#include "scan.h" + +#define READ 0 + +#define IND_EMIT(x) (IND_CHAR(x) + (ind_t)align((x).oh_nchar)) +#define IND_RELO(x) (IND_EMIT(x) + (x).oh_nsect * sizeof(ind_t)) +#ifdef SYMDBUG +#define IND_DBUG(x) (IND_RELO(x) + sizeof(ind_t)) +#endif SYMDBUG + +extern long lseek(); +extern bool incore; +extern int infile; +extern int passnumber; + +char *archname; /* Name of archive, if reading from archive. */ +char *modulname; /* Name of object module. */ +long position; /* Byte offset within cuurent input file. */ +#ifdef SYMDBUG +long objectsize; +#endif SYMDBUG + +static long align(); +static char *modulbase; +static long modulsize(); + +/* + * Open the file with name `filename' (if necessary) and examine the first + * few bytes to see if it's a plain file or an archive. + * In case of a plain file, the file pointer is repositioned after the + * examination. Otherwise it is at the beginning of the table of contents. + */ +int +getfile(filename) + char *filename; +{ + struct ar_hdr archive_header; + ushort magic_number; +#ifdef SYMDBUG + struct stat statbuf; + extern int fstat(); +#endif SYMDBUG + extern ushort getushort(); + + archname = (char *)0; + modulname = (char *)0; + + if (passnumber == FIRST || !incore) { + if ((infile = open(filename, READ)) < 0) + fatal("can't read %s", filename); + magic_number = getushort(); + } else { + modulbase = modulptr((ind_t)0); + magic_number = *(ushort *)modulbase; + } + + switch (magic_number) { + case O_MAGIC: +#ifdef SYMDBUG + if (passnumber == FIRST || !incore) { + if (fstat(infile, &statbuf) < 0) + fatal("cannot stat"); + objectsize = statbuf.st_size; + } +#endif SYMDBUG + position = (long)0; + seek((long)0); + modulname = filename; + return PLAIN; + case ARMAG: + archname = filename; + if (passnumber == FIRST) { + read_arhdr(&archive_header); + if (strcmp(archive_header.ar_name, SYMDEF)) + fatal("no table of contents"); + } else if (incore) { + modulbase += sizeof(ushort); + core_position += sizeof(ushort); + } + return ARCHIVE; + default: + fatal("wrong magic number"); + } + /* NOTREACHED */ +} + +/* ARGSUSED */ +closefile(filename) + char *filename; +{ + if (passnumber == FIRST || !incore) + close(infile); +} + +get_archive_header(archive_header) + register struct ar_hdr *archive_header; +{ + if (passnumber == FIRST || !incore) { + read_arhdr(archive_header); + } else { + /* Copy structs. */ + *archive_header = *(struct ar_hdr *)modulbase; + modulbase += sizeof(struct ar_hdr); + core_position += sizeof(struct ar_hdr); + } +#ifdef SYMDBUG + objectsize = archive_header.ar_size; +#endif SYMDBUG +} + +get_modul() +{ + if (passnumber == FIRST) { + scan_modul(); + } else if (!incore) { + read_modul(); + } +} + +/* + * Read module from the current file. If it doesn't fit into core, the strategy + * to keep everything in core is abandoned, but we will always put the header, + * the section table, and the name and string table into core. + */ +static +scan_modul() +{ + bool space; + struct outhead *head; + struct outsect *sect; + + space = all_alloc(); + head = (struct outhead *)modulptr(IND_HEAD); + if (space) { + sect = (struct outsect *)modulptr(IND_SECT(*head)); + get_indirect(head, sect); + } else { + lseek(infile, OFF_NAME(*head) - OFF_EMIT(*head), 1); + } + read_name((struct outname *)modulptr(IND_NAME(*head)), head->oh_nname); + read_char((char *)modulptr(IND_CHAR(*head)), head->oh_nchar); +#ifdef SYMDBUG + if (space) { + get_dbug(*(ind_t *)modulptr(IND_DBUG(*head)), + ojectsize - OFF_DBUG(*head) + ); + } +#endif SYMDBUG +} + +/* + * Allocate space for and read in the header and section table. + * First get the header. With this we can determine what to allocate + * for the rest of the module, and with the rest we can determine what + * to allocate for the section contents. + * If possible, allocate space for the rest of the module. Return whether + * this was possible. + */ +static bool +all_alloc() +{ + struct outhead head; + extern ind_t hard_alloc(); + + if (hard_alloc(ALLOMODL, (long)sizeof(struct outhead)) == BADOFF) + fatal("no space for module header"); + read_head((struct outhead *)modulptr(IND_HEAD)); + /* + * Copy the header because we need it so often. + */ + head = *(struct outhead *)modulptr(IND_HEAD); + return direct_alloc(&head) && indirect_alloc(&head); +} + +/* + * Allocate space for the rest of the direct bytes. + * First allocate the section table and read it in, then allocate the rest + * and return whether this succeeded. + */ +static bool +direct_alloc(head) + struct outhead *head; +{ + ind_t sectindex = IND_SECT(*head); + ushort nsect = head->oh_nsect; + long size, rest; + extern ind_t hard_alloc(); + extern ind_t alloc(); + +#ifdef SYMDBUG + rest = nsect * sizeof(ind_t) + sizeof(ind_t) + sizeof(ind_t); +#else SYMDBUG + rest = nsect * sizeof(ind_t) + sizeof(ind_t); +#endif SYMDBUG + /* + * We already allocated space for the header, we now need + * the section, name an string table. + */ + size = modulsize(head) - sizeof(struct outhead) - rest; + if (hard_alloc(ALLOMODL, size) == BADOFF) + fatal("no space for module"); + read_sect((struct outsect *)modulptr(sectindex), nsect); + + return incore && alloc(ALLOMODL, rest) != BADOFF; +} + +/* + * Allocate space for the indirectly accessed pieces: the section contents and + * the relocation table, and put their indices in the right place. + */ +static bool +indirect_alloc(head) + struct outhead *head; +{ + register int allopiece; + ushort nsect = head->oh_nsect; + ushort nrelo = head->oh_nrelo; + ind_t sectindex = IND_SECT(*head); + ind_t emitoff = IND_EMIT(*head); + ind_t relooff = IND_RELO(*head); +#ifdef SYMDBUG + ind_t dbugoff = IND_DBUG(*head); + extern long objectsize; + long dbugsize = objectsize - OFF_DBUG(*head); +#endif SYMDBUG + + assert(incore); + for (allopiece = ALLOEMIT; allopiece < ALLOEMIT + nsect; allopiece++) { + if (!putemitindex(sectindex, emitoff, allopiece)) + return FALSE; + sectindex += sizeof(struct outsect); + emitoff += sizeof(ind_t); + } +#ifdef SYMDBUG + return putreloindex(relooff, (long)nrelo * sizeof(struct outrelo)) + && + putdbugindex(dbugoff, dbugsize); +#else SYMDBUG + return putreloindex(relooff, (long)nrelo * sizeof(struct outrelo)); +#endif SYMDBUG +} + +/* + * Allocate space for the contents of the section of which the table entry is + * at offset `sectindex'. Put the offset of the allocated piece at offset + * `emitoff'. + */ +static bool +putemitindex(sectindex, emitoff, allopiece) + ind_t sectindex; + ind_t emitoff; + int allopiece; +{ + long flen; + ind_t emitindex; + extern ind_t alloc(); + + flen = ((struct outsect *)modulptr(sectindex))->os_flen; + if ((emitindex = alloc(allopiece, flen)) != BADOFF) { + *(ind_t *)modulptr(emitoff) = emitindex; + return TRUE; + } + return FALSE; +} + +/* + * Allocate space for a relocation table with `nrelobytes' bytes, and put the + * offset at `relooff'. + */ +static bool +putreloindex(relooff, nrelobytes) + ind_t relooff; + long nrelobytes; +{ + ind_t reloindex; + extern ind_t alloc(); + + if ((reloindex = alloc(ALLORELO, nrelobytes)) != BADOFF) { + *(ind_t *)modulptr(relooff) = reloindex; + return TRUE; + } + return FALSE; +} +#ifdef SYMDBUG +/* + * Allocate space for debugging information and put the offset at `dbugoff'. + */ +static bool +putdbugindex(dbugoff, ndbugbytes) + ind_t relooff; + long ndbugbytes; +{ + ind_t dbugindex; + extern ind_t alloc(); + + if ((dbugindex = alloc(ALLORELO, ndbugbytes)) != BADOFF) { + *(ind_t *)modulptr(dbugoff) = dbugindex; + return TRUE; + } + return FALSE; +} +#endif SYMDBUG + +/* + * Compute addresses and read in. Remember that the contents of the sections + * and also the relocation table are accessed indirectly. + */ +static +get_indirect(head, sect) + register struct outhead *head; + register struct outsect *sect; +{ + register ind_t *emitindex; + register int nsect; + register int piece; + ind_t *reloindex; + + emitindex = (ind_t *)modulptr(IND_EMIT(*head)); + nsect = head->oh_nsect; piece = ALLOEMIT; + while (nsect--) { + read_emit(address(piece, *emitindex), sect->os_flen); + piece++; emitindex++; sect++; + } + reloindex = (ind_t *)modulptr(IND_RELO(*head)); + read_relo((struct outrelo *)address(ALLORELO, *reloindex), + head->oh_nrelo + ); +} + +/* + * Set the file pointer at `pos'. + */ +seek(pos) + long pos; +{ + if (passnumber == FIRST || !incore) + lseek(infile, pos, 0); +} + +/* + * A file pointer is advanced automatically when reading, a char pointer + * is not. That's why we do it here. If we don't keep everything in core, + * we give the space allocated for a module back. + */ +skip_modul(head) + struct outhead *head; +{ + register ind_t skip = modulsize(head); + + if (incore) { + core_position += skip; + if (passnumber == SECOND) + modulbase += skip; + } else { + dealloc(ALLOMODL); + core_position = (ind_t)0; + } +} + +/* + * Read in what we need in pass 2, because we couldn't keep it in core. + */ +static +read_modul() +{ + struct outhead *head; + struct outsect *sects; + struct outname *names; + char *chars; + ind_t sectindex, nameindex, charindex; + ushort nsect, nname; + long size; + long nchar; + long skip; + extern ind_t hard_alloc(); + + assert(passnumber == SECOND); + assert(!incore); + if (hard_alloc(ALLOMODL, (long)sizeof(struct outhead)) == BADOFF) + fatal("no space for module header"); + head = (struct outhead *)modulptr(IND_HEAD); + read_head(head); + nsect = head->oh_nsect; sectindex = IND_SECT(*head); + nname = head->oh_nname; nameindex = IND_NAME(*head); + nchar = head->oh_nchar; charindex = IND_CHAR(*head); + skip = OFF_NAME(*head) - OFF_EMIT(*head); +#ifdef SYMDBUG + size = modulsize(head) - (nsect * sizeof(ind_t) + 2 * sizeof(ind_t)); +#else SYMDBUG + size = modulsize(head) - (nsect * sizeof(ind_t) + sizeof(ind_t)); +#endif SYMDBUG + if (hard_alloc(ALLOMODL, size) == BADOFF) + fatal("no space for module"); + + sects = (struct outsect *)modulptr(sectindex); + names = (struct outname *)modulptr(nameindex); + chars = modulptr(charindex); + + read_sect(sects, nsect); + lseek(infile, skip, 1); + read_name(names, nname); + read_char(chars, nchar); +} + +/* + * Align `size' to a multiple of the size of a double. + * This is assumed to be a power of 2. + */ +static long +align(size) + register long size; +{ + size += sizeof(double) - 1; + return size - (size & (sizeof(double) - 1)); +} + +/* + * Compute how many DIRECT bytes must be allocated for a module of which the + * header is pointed to by `head': + * 0. the header, + * 1. the section table, + * 2. the name table, + * 3. the string table, + * 4. for each section the offset of its contents, + * 5. the offset of the relocation table. +#ifdef SYMDBUG + * 6. the offset of the debugging information. +#endif SYMDBUG + */ +static long +modulsize(head) + register struct outhead *head; +{ + return sizeof(struct outhead) + /* 0 */ + head->oh_nsect * sizeof(struct outsect) + /* 1 */ + head->oh_nname * sizeof(struct outname) + /* 2 */ + align(head->oh_nchar) + /* 3 */ + head->oh_nsect * sizeof(ind_t) + /* 4 */ +#ifdef SYMDBUG + sizeof(ind_t) + /* 5 */ + sizeof(ind_t); /* 6 */ +#else SYMDBUG + sizeof(ind_t); /* 5 */ +#endif SYMDBUG +} + +/* ------------------------------------------------------------------------- */ + +/* + * Walk through the relocation table of the current module. We must either walk + * through core or through file. Startrelo() should be called first. + */ + +static struct outrelo *walkrelo; + +startrelo(head) + struct outhead *head; +{ + ind_t reloindex; + + if (incore) { + reloindex = *(ind_t *)(modulbase + IND_RELO(*head)); + walkrelo = (struct outrelo *)address(ALLORELO, reloindex); + } else + lseek(infile, position + OFF_RELO(*head), 0); +} + +struct outrelo * +nextrelo() +{ + static struct outrelo relobuf; + + if (incore) + return walkrelo++; + + read_relo(&relobuf, (ushort)1); + return &relobuf; +} + +/* ------------------------------------------------------------------------- */ + +/* + * Get the section contents in core of which the describing struct has index + * `sectindex'. `Head' points to the header of the module. + */ +char * +getemit(head, sects, sectindex) + struct outhead *head; + struct outsect *sects; + int sectindex; +{ + char *ret; + ind_t off; + extern char *core_alloc(); + + if (!incore) { + ret = core_alloc(ALLOMODL, sects[sectindex].os_flen); + if (ret == (char *)0) + fatal("no space for section contents"); + lseek(infile, position + sects[sectindex].os_foff, 0); + read_emit(ret, sects[sectindex].os_flen); + return ret; + } + /* + * We have an offset in the contents of the final output + * "file" where normally the contents would be. + */ + off = *((ind_t *)(modulbase + IND_EMIT(*head)) + sectindex); + return address(ALLOEMIT + sectindex, off); +} diff --git a/util/led/scan.h b/util/led/scan.h new file mode 100644 index 00000000..a35b015b --- /dev/null +++ b/util/led/scan.h @@ -0,0 +1,13 @@ +/* $Header$ */ + +/* + * Offsets of the pieces of the input module in core. + */ + +#define IND_HEAD ((ind_t)0) +#define IND_SECT(x) (IND_HEAD + sizeof(struct outhead)) +#define IND_NAME(x) (IND_SECT(x) + (x).oh_nsect * sizeof(struct outsect)) +#define IND_CHAR(x) (IND_NAME(x) + (x).oh_nname * sizeof(struct outname)) +#ifdef SYMDBUG +#define OFF_DBUG(x) (OFF_CHAR(x) + (x).oh_nchar) +#endif SYMDBUG diff --git a/util/led/sym.c b/util/led/sym.c new file mode 100644 index 00000000..b257fba6 --- /dev/null +++ b/util/led/sym.c @@ -0,0 +1,132 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * Symbol table management. + */ + +#include "out.h" +#include "const.h" +#include "memory.h" + +/* + * Symbol table types. Each hash table entry contains the offset of a symbol + * struct. `Sy_name' contains the offset the name in the piece of global + * names. `Sy_next' contains the offset of the next symbol of which the + * corresponding name has the same hash value. + */ +struct symbol { + ind_t sy_name; + ind_t sy_next; +}; + +#define NHASH 256 /* Size of hash table. Should be even. */ + +static ind_t hashtable[NHASH]; + +/* + * Initialize the symbol table. All indices should be noticeably invalid. + */ +init_symboltable() +{ + register ind_t *rap; + + for (rap = hashtable; rap < &hashtable[NHASH]; rap++) + *rap = BADOFF; +} + +/* + * Search for `string' in the symboltable. The hash value of `string' is in + * `hashval'. The linked list belonging to the entry of hashval + * in the hash table is followed. If the names match, a pointer to the outname + * in this element of the list is returned. When a match cannot be found, + * NIL is returned. + */ +struct outname * +searchname(string, hashval) + char *string; + int hashval; +{ + register char *rcp; + register char *namestring; + register ind_t symindex; + register struct outname *name; + register struct symbol *sym; + + symindex = hashtable[hashval]; + while (symindex != BADOFF) { + sym = (struct symbol *)address(ALLOSYMB, symindex); + name = (struct outname *)address(ALLOGLOB, sym->sy_name); + namestring = address(ALLOGCHR, (ind_t)name->on_foff); + rcp = string; + while (*rcp == *namestring++) + if (*rcp++ == '\0') + return name; + symindex = sym->sy_next; + } + /* Not found. */ + return (struct outname *)0; +} + +/* + * Enter a new name in the symbol table. We must copy everything to a + * new entry. `Name' is a private copy, i.e. the pointer to it will not be + * destroyed by allocation. However, the string of which name->on_foff is the + * offset can be destroyed, so we save it first. + */ +entername(name, hashval) + struct outname *name; + int hashval; +{ + ind_t savindex; + ind_t symindex; + ind_t namindex; + struct symbol *sym; + struct outname *newname; + extern ind_t savechar(); + extern ind_t hard_alloc(); + + savindex = savechar(ALLOGCHR, (ind_t)name->on_foff); + symindex = hard_alloc(ALLOSYMB, (long)sizeof(struct symbol)); + namindex = hard_alloc(ALLOGLOB, (long)sizeof(struct outname)); + if (savindex == BADOFF || symindex == BADOFF || namindex == BADOFF) + fatal("symbol table overflow"); + sym = (struct symbol *)address(ALLOSYMB, symindex); + sym->sy_name = namindex; + newname = (struct outname *)address(ALLOGLOB, namindex); + *newname = *name; + newname->on_foff = savindex; + sym->sy_next = hashtable[hashval]; + hashtable[hashval] = symindex; +} + +/* + * Return the index of `name' in the symbol table in the order in which + * it was entered. We need a REAL index, not a byte offset. + */ +ushort +indexof(name) + struct outname *name; +{ + return name - (struct outname *)address(ALLOGLOB, (ind_t)0); +} + +/* + * Assign an integer to the string in p. + * 0 <= hash(p) < NHASH, so it can - and will - be used + * as index in a hash table. + */ +int +hash(p) + register char *p; +{ + register unsigned int h = 0; + register int c; + + while (c = *p++) { + h <<= 2; + h += c; + } + return h & (NHASH - 1); +} diff --git a/util/led/write.c b/util/led/write.c new file mode 100644 index 00000000..bb4014dc --- /dev/null +++ b/util/led/write.c @@ -0,0 +1,297 @@ +#ifndef lint +static char rcsid[] = "$Header$"; +#endif + +/* + * You can choose between two strategies: + * - Open the output file several times, once for each logical part, and + * write to it in multiple places. + * - Open the output file once and seek back and forth to each logical + * part. In this case #define OUTSEEK. + */ + +#include +#include "out.h" +#include "const.h" +#include "assert.h" +#include "memory.h" +#include "orig.h" + +extern long lseek(); + +#define WRITE 1 /* Argument to open(). */ + +/* + * Parts of the output file. + */ +#define PARTEMIT 0 +#define PARTRELO 1 +#define PARTNAME 2 +#define PARTCHAR 3 +#ifdef SYMDBUG +#define PARTDBUG 4 +#else SYMDBUG +#define PARTDBUG PARTCHAR +#endif SYMDBUG +#define NPARTS (PARTDBUG + 1) + +/* + * Call OUTPART() with the part you want to write on as argument, before + * you call OUTWRITE(). + */ +static int outpart = NPARTS; + +#ifdef OUTSEEK + +static int outfile; +static long outseek[NPARTS]; + +#define OUTPART(p) \ + { if (outpart != (p)) {\ + outpart = (p);\ + lseek(outfile, outseek[(p)], 0);\ + }\ + } +#define OUTSECT(i) \ + { outpart = NPARTS;\ + outseek[PARTEMIT] =\ + outsect[(i)].os_foff + relorig[(i)].org_flen;\ + } +#define OUTWRITE(b, n) \ + { if (write(outfile, (b), (n)) != (n))\ + fatal("write error");\ + outseek[outpart] += (n);\ + } +#define BEGINSEEK(p, o) \ + { outseek[(p)] = (o);\ + } + +#else OUTSEEK + +static int outfile[NPARTS]; + +#define OUTPART(p) \ + { outpart = (p);\ + } +#define OUTSECT(i) \ + { lseek( outfile[PARTEMIT],\ + outsect[(i)].os_foff + relorig[(i)].org_flen,\ + 0\ + );\ + } +#define OUTWRITE(b, n) \ + { if (write(outfile[outpart], (b), (n)) != (n))\ + fatal("write error");\ + } +#define BEGINSEEK(p, o) \ + { lseek(outfile[(p)], (o), 0);\ + } + +#endif OUTSEEK + +extern struct outhead outhead; +extern struct outsect outsect[]; +extern int flagword; +extern struct orig relorig[]; +extern bool bytes_reversed, words_reversed; +extern bool incore; + + +static long offchar; + +/* + * Open the output file according to the chosen strategy. + * Write away the header and section table: they will not change anymore. + */ +begin_write() +{ + register long off; + + openoutput(); + BEGINSEEK(PARTEMIT, (long)0); + wrt_head(&outhead); + wrt_sect(outsect, outhead.oh_nsect); + + off = SZ_HEAD + (long)outhead.oh_nsect * SZ_SECT + outhead.oh_nemit; + + if (flagword & RFLAG) { + /* A relocation table will be produced. */ + BEGINSEEK(PARTRELO, off); + off += (long)outhead.oh_nrelo * SZ_RELO; + } + + if (flagword & SFLAG) + return; + + /* A name table will be produced. */ + BEGINSEEK(PARTNAME, off); + off += (long)outhead.oh_nname * SZ_NAME; + BEGINSEEK(PARTCHAR, off); + offchar = off; /* See wrt_name(). */ +#ifdef SYMDBUG + off += outhead.oh_nchar; + BEGINSEEK(PARTDBUG, off); +#endif SYMDBUG +} + +static +openoutput() +{ +#ifndef OUTSEEK + register int *fdp; +#endif OUTSEEK + extern char *outputname; + + close(creat(outputname, 0666)); +#ifdef OUTSEEK + if ((outfile = open(outputname, WRITE)) < 0) + fatal("can't write %s", outputname); +#else OUTSEEK + for (fdp = &outfile[PARTEMIT]; fdp < &outfile[NPARTS]; fdp++) + if ((*fdp = open(outputname, WRITE)) < 0) + fatal("can't write %s", outputname); +#endif OUTSEEK +} + +static struct outname * +sectname(sectindex) + int sectindex; +{ + static struct outname namebuf; + + namebuf.on_foff = (long)0; /* No string name. */ + namebuf.on_type = (S_MIN + sectindex) | S_SCT; + namebuf.on_desc = 0; + namebuf.on_valu = outsect[sectindex].os_base; + + return &namebuf; +} + +/* + * Write out the symbol table and the section names. + */ +end_write() +{ + register ushort cnt; + register struct outname *name; + register int sectindex; + extern ushort NGlobals; + + assert(!incore); + assert(!(flagword & SFLAG)); + cnt = NGlobals; + name = (struct outname *)address(ALLOGLOB, (ind_t)0); + while (cnt--) { + if (name->on_foff != (long)0) { + name->on_mptr = address(ALLOGCHR, (ind_t)name->on_foff); + } else { + name->on_mptr = (char *)0; + } + wrt_name(name); + name++; + } + + for (sectindex = 0; sectindex < outhead.oh_nsect; sectindex++) + wrt_name(sectname(sectindex)); +} + +static +wrt_head(head) + register struct outhead *head; +{ + assert(!incore); + OUTPART(PARTEMIT); + if (bytes_reversed || words_reversed) + swap((char *)head, SF_HEAD); + OUTWRITE((char *)head, SZ_HEAD); + /* + * Swap back because we will need it again. + */ + if (bytes_reversed || words_reversed) + swap((char *)head, SF_HEAD); +} + +static +wrt_sect(sect, cnt) + register struct outsect *sect; + register ushort cnt; +{ + assert(!incore); + OUTPART(PARTEMIT); + while (cnt--) { + if (bytes_reversed || words_reversed) + swap((char *)sect, SF_SECT); + OUTWRITE((char *)sect, SZ_SECT); + /* + * Swap back because we will need it again. + */ + if (bytes_reversed || words_reversed) + swap((char *)sect, SF_SECT); + sect++; + } +} + +/* + * We don't have to worry about byte order here. + */ +wrt_emit(emit, sectindex, cnt) + register char *emit; + int sectindex; + register long cnt; +{ + register int n; + + assert(!incore); + OUTPART(PARTEMIT); + OUTSECT(sectindex); + while (cnt) { + n = cnt >= BUFSIZ ? BUFSIZ : cnt; + OUTWRITE(emit, n); + emit += n; + cnt -= n; + } +} + +wrt_relo(relo) + register struct outrelo *relo; +{ + assert(!incore); + assert(flagword & RFLAG); + OUTPART(PARTRELO); + if (bytes_reversed || words_reversed) + swap((char *)relo, SF_RELO); + OUTWRITE((char *)relo, SZ_RELO); +} + +wrt_name(name) + register struct outname *name; +{ + assert(!incore); + assert(!(flagword & SFLAG)); + if (name->on_mptr != (char *)0) { + register int len = strlen(name->on_mptr) + 1; + + OUTPART(PARTCHAR); + OUTWRITE(name->on_mptr, len); + name->on_foff = offchar; + offchar += len; + } else { + name->on_foff = (long)0; + } + OUTPART(PARTNAME); + if (bytes_reversed || words_reversed) + swap((char *)name, SF_NAME); + OUTWRITE((char *)name, SZ_NAME); +} +#ifdef SYMDBUG + +wrt_dbug(buf, size) + char *buf; + int size; +{ + assert(!incore); + assert(!(flagword & SFLAG)); + OUTPART(PARTDBUG); + OUTWRITE((char *)buf, size); +} +#endif SYMDBUG diff --git a/util/misc/Makefile b/util/misc/Makefile new file mode 100644 index 00000000..32cd9ad0 --- /dev/null +++ b/util/misc/Makefile @@ -0,0 +1,38 @@ +# $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 diff --git a/util/misc/decode.c b/util/misc/decode.c new file mode 100644 index 00000000..6edcc8b6 --- /dev/null +++ b/util/misc/decode.c @@ -0,0 +1,499 @@ +/* + * (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 +#include +#include +#include +#include +#include +#include +#include + +#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); +} diff --git a/util/misc/em_decode.6 b/util/misc/em_decode.6 new file mode 100644 index 00000000..d1901baa --- /dev/null +++ b/util/misc/em_decode.6 @@ -0,0 +1,40 @@ +.\" $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. diff --git a/util/misc/encode.c b/util/misc/encode.c new file mode 100644 index 00000000..0aee6277 --- /dev/null +++ b/util/misc/encode.c @@ -0,0 +1,761 @@ +/* + * (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 +#include +#include +#include +#include +#include +#include +#include +#include + +#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); +} diff --git a/util/ncgg/Makefile b/util/ncgg/Makefile new file mode 100644 index 00000000..29339467 --- /dev/null +++ b/util/ncgg/Makefile @@ -0,0 +1,171 @@ +# $Header$ + +CFILES=cgg.c subr.c main.c coerc.c enterkeyw.c error.c emlookup.c expr.c instruct.c iocc.c lookup.c output.c set.c strlookup.c var.c hall.c +OFILES=cgg.o subr.o main.o coerc.o enterkeyw.o error.o emlookup.o expr.o instruct.o iocc.o lookup.o set.o strlookup.o var.o hall.o +SOURCES=*.h cgg.y scan.l cvtkeywords keywords coerc.c emlookup.c error.c expr.c hall.c instruct.c iocc.c lookup.c main.c output.c set.c strlookup.c subr.c var.c +EMH=../../h +CFLAGS=-I$(EMH) +YFLAGS=-v -d + + +cgg: cgg.o $(OFILES) output.o + cc $(LDFLAGS) $(OFILES) output.o ../../lib/em_data.a -ll -o cgg + +install: cgg + cp cgg ../../lib/ncgg + +cmp: cgg + cmp cgg ../../lib/ncgg + +debugcgg: cgg.o $(OFILES) debugoutput.o + cc $(LDFLAGS) $(OFILES) debugoutput.o ../../lib/em_data.a -ll -o cgg + +cgg.o: scan.c + +enterkeyw.c: cvtkeywords keywords y.tab.h + cvtkeywords + +debugoutput.o: debugoutput.c + $(CC) $(CFLAGS) -DCODEDEBUG -c debugoutput.c + +debugoutput.c: output.c + cp output.c debugoutput.c + +lint: $(CFILES) + lint $(CFLAGS) $(CFILES) + touch lint + +clean: + rm -f cgg.c scan.c y.output y.tab.h enterkeyw.c + rm -f $(OFILES) output.o debugoutput.o cgg lint + +pr: + pr $(SOURCES) + +lpr: + make pr|lpr + +depend: + makedepend + +cgg.o: $(EMH)/cgg_cg.h +coerc.o: $(EMH)/cgg_cg.h +debugoutput.o: $(EMH)/cgg_cg.h +expr.o: $(EMH)/cgg_cg.h +instruct.o: $(EMH)/cgg_cg.h +iocc.o: $(EMH)/cgg_cg.h +output.o: $(EMH)/cgg_cg.h +set.o: $(EMH)/cgg_cg.h +subr.o: $(EMH)/cgg_cg.h +var.o: $(EMH)/cgg_cg.h +# AUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTOAUTO +cgg.o: expr.h +cgg.o: extern.h +cgg.o: instruct.h +cgg.o: iocc.h +cgg.o: lookup.h +cgg.o: param.h +cgg.o: scan.c +cgg.o: set.h +cgg.o: varinfo.h +coerc.o: assert.h +coerc.o: extern.h +coerc.o: iocc.h +coerc.o: param.h +coerc.o: property.h +coerc.o: pseudo.h +coerc.o: reg.h +coerc.o: set.h +coerc.o: token.h +coerc.o: varinfo.h +debugoutput.o: assert.h +debugoutput.o: extern.h +debugoutput.o: instruct.h +debugoutput.o: lookup.h +debugoutput.o: param.h +debugoutput.o: property.h +debugoutput.o: pseudo.h +debugoutput.o: reg.h +debugoutput.o: regvar.h +debugoutput.o: set.h +debugoutput.o: token.h +debugoutput.o: varinfo.h +emlookup.o: expr.h +emlookup.o: param.h +enterkeyw.o: lookup.h +expr.o: assert.h +expr.o: expr.h +expr.o: extern.h +expr.o: lookup.h +expr.o: param.h +expr.o: property.h +expr.o: reg.h +expr.o: regvar.h +expr.o: set.h +expr.o: token.h +hall.o: assert.h +hall.o: param.h +hall.o: set.h +instruct.o: expr.h +instruct.o: extern.h +instruct.o: instruct.h +instruct.o: iocc.h +instruct.o: param.h +instruct.o: pseudo.h +instruct.o: set.h +instruct.o: varinfo.h +iocc.o: assert.h +iocc.o: expr.h +iocc.o: extern.h +iocc.o: iocc.h +iocc.o: lookup.h +iocc.o: param.h +iocc.o: property.h +iocc.o: regvar.h +iocc.o: set.h +iocc.o: token.h +lookup.o: assert.h +lookup.o: lookup.h +lookup.o: param.h +output.o: assert.h +output.o: extern.h +output.o: instruct.h +output.o: lookup.h +output.o: param.h +output.o: property.h +output.o: pseudo.h +output.o: reg.h +output.o: regvar.h +output.o: set.h +output.o: token.h +output.o: varinfo.h +scan.o: stdio.h +set.o: extern.h +set.o: lookup.h +set.o: param.h +set.o: property.h +set.o: set.h +set.o: token.h +strlookup.o: param.h +subr.o: expr.h +subr.o: extern.h +subr.o: instruct.h +subr.o: lookup.h +subr.o: param.h +subr.o: property.h +subr.o: reg.h +subr.o: regvar.h +subr.o: set.h +subr.o: token.h +subr.o: varinfo.h +tables.o: data.h +tables.o: param.h +tables.o: tables.h +tables.o: types.h +var.o: instruct.h +var.o: lookup.h +var.o: param.h +var.o: property.h +var.o: reg.h +var.o: set.h +var.o: token.h diff --git a/util/ncgg/assert.h b/util/ncgg/assert.h new file mode 100644 index 00000000..6e909f08 --- /dev/null +++ b/util/ncgg/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if (!(x)) badassertion("x",__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/util/ncgg/cgg.y b/util/ncgg/cgg.y new file mode 100644 index 00000000..34af468e --- /dev/null +++ b/util/ncgg/cgg.y @@ -0,0 +1,992 @@ +%{ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "param.h" +#include "varinfo.h" +#include "lookup.h" +#include "set.h" +#include "iocc.h" +#include "instruct.h" +#include "expr.h" +#include "extern.h" +#include +#include + +extern int lineno; +int instline,saveline; +int startline; +int npatterns; +int patindex[MAXPATTERNS]; + +int emhere=0; /* lexical analyzer flag */ +int optexact=0; /* Inside "with exact" rule */ +int optstack=0; /* Inside with STACK rule */ +int saferulefound=0; +int maxempatlen=0; +int maxrule=0; +struct varinfo *defcost; + +struct varinfo *gen_inst(),*gen_move(),*gen_test(),*gen_preturn(),*gen_tlab(); +struct varinfo *make_erase(); +expr_t make_expr(),ident_expr(),subreg_expr(),tokm_expr(),all_expr(); +expr_t perc_ident_expr(),sum_expr(),regvar_expr(); + +set_t ident_to_set(),setproduct(),setsum(),setdiff(); + +iocc_t subr_iocc(),tokm_iocc(),ident_iocc(),all_iocc(),descr_iocc(); + +extern int narexpr; +extern expr_t arexp[]; + +int niops; +iocc_t iops[20]; +%} + +%union { + int yy_int; + char * yy_str; + varinfo * yy_varinfo; + set_t yy_set; + operand *yy_oplist; + expr_t yy_expr; + iocc_t yy_iocc; +} + +%token PROPERTIES +%token REGISTERS +%token TOKENS +%token SETS +%token MOVES +%token TESTS +%token STACKINGRULES COERCIONS +%token INSTRUCTIONS +%token PROC CALL EXAMPLE +%token FROM TO +%token TEST MOVE STACK RETURN +%token PATTERNS PAT WITH EXACT KILLS USES REUSING GEN YIELDS LEAVING +%token DEFINED SAMESIGN SFIT UFIT ROM LOWW HIGHW +%token CMPEQ CMPNE CMPLT CMPGT CMPLE CMPGE OR2 AND2 LSHIFT RSHIFT NOT COMP +%token INREG REGVAR REG_ANY REG_FLOAT REG_LOOP REG_POINTER +%token ADORNACCESS +%token ADORNCC +%token INT +%token ADDR +%token EMMNEM +%token NUMBER +%token DOLLAR PERCENT ALLREG +%token IDENT PERC_IDENT +%token STRING +%token TIMEFACTOR SIZEFACTOR +%token COST +%type prop_list property ident_list ident_list_el +%type att_list att_list_el structdecl optcost optformat +%type kills allocates yields leaving +%type generates kill_list kill_list_el uselist uselist_el genlist yieldlist +%type leavelist leavelist_el gen_instruction +%type opt_erase_list erase_list erase_list_el +%type opt_par_string optstring +%type register propno att_list_el_type tokenset_no +%type adornlist optstar optuses optregvar regvartype optregvartype +%type emarg tokarg subreg allreg optsecondstring +%type expr +%type tokeninstance +%type optexpr optexact optstack +%type tokenset +%type oplist oplist_el + +%left OR2 +%left AND2 +%left CMPEQ,CMPNE +%left CMPLT,CMPLE,CMPGT,CMPGE +%left RSHIFT,LSHIFT +%left '+','-' +%left '*','/','%' +%nonassoc NOT,COMP,UMINUS + +%start machtable + +%% +/* + * The machine table consists of a number of sections, with their + * own associated parsers. + */ +machtable + : constants + properties + registers + tokens + { make_std_sets(); } + sets + instructions + moves + tests + stacks + coercs + code + ; + +/* + * Constants are parsed as name=value pairs + */ +constants + : constdeflist + ; +constdeflist + : /* empty */ + | constdeflist constdef + ; +constdef + : IDENT'=' NUMBER + { n_const($1,$3); free($1); } + | IDENT '=' STRING + { n_sconst($1,$3); free($1); free($3); } + | TIMEFACTOR '=' NUMBER '/' NUMBER + { fc1 = $3; fc2 = $5; } + | SIZEFACTOR '=' NUMBER '/' NUMBER + { fc3 = $3; fc4 = $5; } + | error + ; + +/* + * Properties are parsed as a list of names optionally followed by their size + */ +properties + : PROPERTIES { make_const(); } prdef_list + ; +prdef_list + : prdef_list_el + | prdef_list optcomma prdef_list_el + ; +prdef_list_el + : IDENT + { n_prop($1,wordsize); free($1); } + | IDENT '(' NUMBER ')' + { n_prop($1,$3); free($1); } + ; + +/* + * Registers are rows of reglist:proplist pairs + */ +registers + : REGISTERS regdef_list + ; +regdef_list + : regdef_list_el + | regdef_list regdef_list_el + ; +regdef_list_el + : ident_list ':' prop_list optregvar '.' + { regline($1,$3,$4); free((char *) $1); free((char *) $3); } + | error '.' + ; +optregvar + : /* empty */ + { $$ = -1; } + | REGVAR + { $$ = reg_any; } + | REGVAR '(' regvartype ')' + { $$ = $3; } + ; + +regvartype + : REG_ANY + { $$ = reg_any;} + | REG_FLOAT + { $$ = reg_float;} + | REG_LOOP + { $$ = reg_loop;} + | REG_POINTER + { $$ = reg_pointer;} + ; + +ident_list + : ident_list_el + | ident_list optcomma ident_list_el + { $3->vi_next = $1; $$ = $3; } + ; +ident_list_el + : IDENT opt_par_string + { NEW($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0] = n_reg($1,$2,0,0,0); + free($1); if($2!=0) free($2); + } + | IDENT opt_par_string '=' register + { NEW($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0] = n_reg($1,$2,1,$4,0); + free($1); if($2!=0) free($2); + } + | IDENT opt_par_string '=' register '+' register + { NEW($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0] = n_reg($1,$2,2,$4,$6); + free($1); if($2!=0) free($2); + } + ; +opt_par_string + : /* empty */ + { $$ = 0; } + | '(' STRING ')' + { $$ = $2; } + ; +register + : IDENT + { register symbol *sy_p; + + sy_p = lookup($1,symreg,mustexist); + $$ = sy_p->sy_value.syv_regno; + free($1); + } + ; +prop_list + : property + | prop_list optcomma property + { $3->vi_next = $1; $$ = $3; } + ; +property + : IDENT + { register symbol *sy_p; + sy_p = lookup($1,symprop,mustexist); + NEW($$,struct varinfo); + $$->vi_next=0; + $$->vi_int[0]=sy_p->sy_value.syv_propno; + free($1); + } + ; +propno + : IDENT + { register symbol *sy_p; + sy_p = lookup($1,symprop,mustexist); + $$ = sy_p->sy_value.syv_propno; + free($1); + } + ; + +/* tokens are parsed as struct definitions + * types in the struct can be register properties, ADDR or INT + */ + +tokens + : TOKENS tokdeflist + ; +tokdeflist + : tokdeflist_el + | tokdeflist tokdeflist_el + ; +tokdeflist_el + : IDENT '=' structdecl NUMBER optcost optformat '.' + { n_tok($1,$3,$4,$5,$6); + free($1); + freevi($3); + freevi($5); + freevi($6); + } + | error '.' + ; +structdecl + : '{' att_list '}' + { $$ = $2; } + ; +att_list + : /* empty */ + { $$ = 0; } + | att_list_el att_list + { $1->vi_next = $2; $$ = $1; } + ; +att_list_el + : att_list_el_type IDENT ';' + { NEW ($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0] = $1; + $$->vi_str[0] = $2; + } + ; +att_list_el_type + : INT + { $$ = -1; } + | ADDR + { $$ = -2; } + | propno + ; +optcost + : + { if (defcost==VI_NULL) + $$=VI_NULL; + else { + NEW($$,struct varinfo); + *$$ = *defcost; + } + } + | COST '(' NUMBER ',' NUMBER ')' + { NEW ($$,struct varinfo); + $$->vi_int[0] = $3; + $$->vi_int[1] = $5; + } + ; +optformat + : + { $$ = 0; } + | STRING optformat + { NEW($$,struct varinfo); + $$->vi_next = $2; + $$->vi_int[0] = 0; + $$->vi_str[0] = $1; + } + | IDENT optformat + { NEW($$,struct varinfo); + $$->vi_next = $2; + $$->vi_int[0] = 1; + $$->vi_str[0] = $1; + } + ; +optcomma + : ',' + | /* empty */ + ; + +/* sets are parsed as ident = expression */ + +sets + : SETS setdeflist + ; +setdeflist + : setdeflist_el + | setdeflist setdeflist_el + ; +setdeflist_el + : IDENT '=' tokenset_no '.' + { n_set($1,$3); free($1); } + | error '.' + ; +tokenset_no + : tokenset + { $$ = setlookup($1); } + ; +tokenset + : IDENT + { $$ = ident_to_set($1); free($1); } + | tokenset '*' tokenset + { $$ = setproduct($1,$3); } + | tokenset '+' tokenset + { $$ = setsum($1,$3); } + | tokenset '-' tokenset + { $$ = setdiff($1,$3); } + | '(' tokenset ')' + { $$ = $2; } + ; + +instructions + : INSTRUCTIONS optcost instdef_list + { defcost = $2; } + ; +instdef_list + : instdef_list_el + | instdef_list instdef_list_el + ; +instdef_list_el + : IDENT optstring oplist opt_erase_list optcost '.' + { n_instr($1,$2,$3,$4,$5); freevi($5); } + | error '.' + ; +oplist + : /* empty */ + { $$ = 0; } + | oplist_el + | oplist_el ',' oplist + { $$ = $1; $$->o_next = $3; } + ; +oplist_el + : tokenset_no adornlist + { NEW($$,struct operand); + $$->o_next = 0 ; + $$->o_setno = $1; + $$->o_adorn = $2; + checkprintformat($1); + } + ; +adornlist + : /* empty */ + { $$ = 0; } + | ADORNACCESS adornlist + { if ($2&AD_RWMASK) + error("Only one of :ro,:wo,:rw allowed"); + $$ = $1 | $2; + } + | ADORNCC adornlist + { $$ = $1|$2; } + ; +opt_erase_list + : /* empty */ + { $$ = VI_NULL;} + | KILLS erase_list + { $$ = $2; } + ; +erase_list + : erase_list_el + { $$ = $1; } + | erase_list_el erase_list + { $1->vi_next = $2; $$ = $1; } + ; +erase_list_el + : IDENT + { $$ = make_erase($1); } + | ADORNCC + { NEW($$, struct varinfo); + $$->vi_int[0] = -1; + $$->vi_next = VI_NULL; + } + ; + +/* Now the moves */ + +moves + : MOVES movedeflist + | /* empty */ + ; +movedeflist + : movedeflist_el + | movedeflist movedeflist_el + ; +movedeflist_el + : FROM + {startline = lineno; } + tokenset_no + { cursetno = $3; } + optexpr TO tokenset_no + { cursetno = $7; + tokpatlen=2; + tokpatset[0] = $3; + tokpatset[1] = $7; + tokpatro[0] = 1; + } + optexpr GEN genlist + { tokpatlen=0; + tokpatro[0]=0; + n_move($3,$5,$7,$9,$11); + freevi($11); + } + | error + ; + +/* Now the test part */ + +tests + : TESTS testdeflist + | /* empty */ + ; +testdeflist + : testdeflist_el + | testdeflist testdeflist_el + ; +testdeflist_el + : TO + { startline = lineno;} + TEST tokenset_no + { cursetno = $4; + tokpatlen=1; + tokpatset[0]=$4; + tokpatro[0] = 1; + } + optexpr GEN genlist + { tokpatlen=0; + tokpatro[0] = 0; + n_test($4,$6,$8); + freevi($8); + } + | error + ; + +/* Now the stacks */ + +stacks + : STACKINGRULES stackdeflist + ; +stackdeflist + : stackdeflist_el + | stackdeflist stackdeflist_el + ; +stackdeflist_el + : FROM + {startline = lineno;} + tokenset_no + { cursetno = $3; + tokpatlen=1; + tokpatset[0] = $3; + tokpatro[0] = 1; + } + optexpr TO STACK optuses GEN genlist + { tokpatro[0] = 0; + n_stack($3,$5,$8,$10); + freevi($10); + } + ; +optuses + : /* empty */ + { $$ = -1; nallreg=0;} + | USES propno + { $$ = $2; nallreg = 1; allreg[0] = $2; } + ; + +/* Now the one-to-one coercion rules */ + +coercs + : COERCIONS coercdeflist + ; +coercdeflist + : coercdeflist_el + | coercdeflist coercdeflist_el + ; +coercdeflist_el + : FROM + {startline = lineno; tokpatlen=0; inithall();} + STACK allocates GEN genlist YIELDS tokeninstance + { checkhall(); + n_coerc(0,0,$4,$6,(struct varinfo *) 0,$8); + freevi($4); + freevi($6); + } + | FROM + {startline = lineno;} + tokenset_no + { cursetno = $3; + tokpatlen=1; + tokpatset[0]=$3; + tokpatro[0] = 1; + inithall(); + } + optexpr allocates generates yields + { tokpatro[0] = 0; + checkhall(); + n_coerc($3,$5,$6,$7,$8); + freevi($6); + freevi($7); + } + ; + +/* Now the code part */ + +code + : PATTERNS coderules + ; +coderules + : coderule + | coderules coderule + ; +coderule + : PAT {emhere=1;} empattern {emhere=0;} optexpr + { empatexpr = $5; + npatterns = 0; + saferulefound=0; + if (empatlen>maxempatlen) + maxempatlen=empatlen; + } + patterns + { if (!saferulefound) + error("Previous rule impossible on empty stack"); + outpatterns(); + } + | PROC IDENT example + { npatterns = 0; saferulefound=0; inproc=1; n_proc($2); } + patterns + { if (!saferulefound) + error("Previous rule impossible on empty stack"); + outpatterns(); inproc=0; + } + | error + { skipupto(PAT,"pat"); yyerrok; yyclearin; } + ; +example + : /* empty */ + { empatlen = 0; } + | EXAMPLE {emhere=1;} empattern {emhere=0;} + ; +empattern + : EMMNEM + { empatlen = 1; emmnem[0] = $1; } + | empattern EMMNEM + { NEXT(empatlen,EMPATMAX,"Em pattern"); + emmnem[empatlen-1] = $2; + } + ; +patterns + : onepattern + { saferulefound=1; + callproc=0; + } + | morepatterns + { callproc=0; + if (npatterns>maxrule) + maxrule=npatterns; + } + | CALL IDENT '(' STRING optsecondstring ')' + { register symbol *sy_p; + saferulefound=1; + sy_p=lookup($2,symproc,mustexist); + callproc=sy_p->sy_value.syv_procoff; + procarg[0] = strlookup($4); + procarg[1] = $5; + free($2); + free($4); + } + ; +optsecondstring + : /* empty */ + { $$ = 0; } + | ',' STRING + { $$ = strlookup($2); free($2); } + ; + +onepattern + : { inithall(); startline=lineno; tokpatlen=0; } + kills allocates generates yields leaving + { optexact=0; optstack=0; + patindex[npatterns++]=codeindex; + checkhall(); + dopattern(0,$2,$3,$4,$5,$6); + freevi($2); + freevi($3); + freevi($4); + freevi($5); + freevi($6); + } + ; +morepatterns + : { inithall(); } pattern + | morepatterns { inithall(); } pattern + ; + +pattern + : stackpattern kills allocates generates yields leaving + { patindex[NEXT(npatterns,MAXPATTERNS,"Patterns")]=codeindex; + if (hall() && !optexact) saferulefound=1; + dopattern(0,$2,$3,$4,$5,$6); + freevi($2); + freevi($3); + freevi($4); + freevi($5); + freevi($6); + } + ; +stackpattern + : WITH optexact + { startline = lineno; } + setlist optstack + ; +optexact + : /* empty */ + { $$ = optexact = 0; } + | EXACT + { $$ = optexact = 1; } + ; +optstack + : /* empty */ + { $$ = optstack = 0; } + | STACK + { $$ = optstack = 1; } + ; + +setlist + : /* empty */ + { tokpatlen = 0; } + | setlist tokenset_no + { NEXT(tokpatlen,TOKPATMAX,"Stack pattern"); + tokpatset[tokpatlen-1] = $2; + checkunstacking($2); + } + ; +kills + : /* empty */ + { $$ = 0; } + | KILLS kill_list + { $$ = $2; + if (optstack) + error("No sense in giving kills in this pattern"); + } + ; +kill_list + : kill_list_el + | kill_list_el ',' kill_list + { $$=$1; $$->vi_next = $3; } + ; +kill_list_el + : tokenset_no { cursetno=$1; } optexpr + { NEW($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0]=$1; + $$->vi_int[1]=$3; + } + ; +allocates + : /* empty */ + { $$ = 0; nallreg=0;} + | USES uselist + { $$ = $2; setallreg($2); } + ; +uselist + : uselist_el + { prophall($1->vi_int[0]); } + | uselist_el ',' uselist + { prophall($1->vi_int[0]); $$=$1; $$->vi_next=$3; } + ; +uselist_el + : property + { $$=$1; $$->vi_int[1] = 0; } + | property '=' tokeninstance + { if (!existalmove($3,$$->vi_int[0])) + error("No such move defined"); + $$=$1; $$->vi_int[1] = $3.in_index; + } + | REUSING tokeninstance + { NEW($$,struct varinfo); + $$->vi_next = 0; + $$->vi_int[0] = -1; + $$->vi_int[1] = $2.in_index; + } + ; + + +generates + : /* empty */ + { $$ = 0; } + | GEN genlist + { $$ = $2; } + ; +genlist + : /* empty */ + { $$ = 0; } + | gen_instruction genlist + { if ($1!=0) { + register struct varinfo *tvip; + $$=tvip=$1; + while (tvip->vi_next!=VI_NULL) + tvip=tvip->vi_next; + tvip->vi_next = $2; + } else { + $$ = $2; + } + } + ; +gen_instruction + : {instline = lineno; } IDENT optstar gen_oplist + { saveline =lineno; lineno=instline; + $$ = gen_inst($2,$3); free($2); + lineno = saveline; + } + | NUMBER ':' + { $$ = gen_tlab($1); } + | MOVE tokeninstance ',' tokeninstance + { $$ = gen_move($2,$4); } + | TEST tokeninstance + { $$ = gen_test($2);} + | RETURN + { $$ = gen_preturn(); } + ; +optstar + : /* empty */ + { $$=0; } + | '*' + { $$=1; } + | '[' NUMBER ']' + { $$=$2; } + ; +gen_oplist + : '.' /* empty gives conflicts */ + { niops=0; } + | tokeninstance + { niops=1;iops[0]=$1; } + | gen_oplist ',' tokeninstance + { iops[niops++] = $3; } + ; + +yields + : /* empty */ + { $$ = 0; } + | YIELDS yieldlist + { $$ = $2; } + ; +yieldlist + : /* empty */ + { $$ = 0; } + | tokeninstance yieldlist + { checkstacking($1.in_set); + NEW($$,struct varinfo); + $$->vi_next = $2; + $$->vi_int[0] = $1.in_index; + } + ; + +leaving + : /* empty */ + { $$ = 0; } + | LEAVING {emhere=1; } leavelist + { emhere=0; $$ = $3; } + ; +leavelist + : leavelist_el + | leavelist_el leavelist + { $$=$1; $$->vi_next=$2; } + ; +leavelist_el + : EMMNEM optexpr + { NEW($$,struct varinfo); + $$->vi_next=0; + $$->vi_int[0] = $1; + $$->vi_int[1] = $2; + } + ; + +optstring + : /* empty */ + { $$ = 0; } + | STRING + ; +optexpr + : /* empty */ + { $$ = 0; } + | expr + { $$ = $1.ex_index; } /* type checking ? */ + ; + +tokeninstance + : tokarg subreg + { $$ = subr_iocc($1,$2); } + | tokarg '.' IDENT + { $$ = tokm_iocc($1,$3); free($3); } + | IDENT + { $$ = ident_iocc($1); free($1);} + | allreg subreg + { $$ = all_iocc($1,$2); } + | '{' IDENT attlist '}' + { $$ = descr_iocc($2); free($2); } + ; +attlist + : /* empty */ + { narexpr = 0; } + | attlist ',' expr + { arexp[narexpr++] = $3; } + ; + +emarg + : DOLLAR + { if ($1<1 || $1>empatlen) + error("Only %d instructions in pattern",empatlen); + $$ = $1; + } + ; +tokarg + : PERCENT + { if ($1<1 || $1>tokpatlen) { + error("Only %d tokens in stackpattern",tokpatlen); + $$ =1; + } else { + $$ = $1; + } + } + ; +subreg + : /* empty */ + { $$ = 0; } + | '.' NUMBER + { if ($2<1 || $2>2) { + error("Only 2 subregisters allowed"); + $$ = 1; + } else { + $$ = $2; + } + } + ; +allreg + : ALLREG + { if ($1>=nallreg) + fatal("Only %d registers allocated",nallreg); + $$ = $1; + } + ; + +expr + : NUMBER + { $$ = make_expr(TYPINT,EX_CON, (int) ($1 & 0xFFFF), (int) ($1>>16)); + } + | emarg + { $$ = make_expr(argtyp(emmnem[$1-1]),EX_ARG,$1,0); } + | STRING + { $$ = make_expr(TYPADDR,EX_STRING,strlookup($1),0); free($1); } + | IDENT + { $$ = ident_expr($1); free($1); } + | tokarg subreg + { $$ = subreg_expr($1,$2); } + | tokarg '.' IDENT + { $$ = tokm_expr($1,$3); free($3); } + | allreg subreg + { $$ = all_expr($1,$2); } + | PERC_IDENT + { $$ = perc_ident_expr($1); free($1); } + | DEFINED '(' expr ')' + { $$ = make_expr(TYPBOOL,EX_DEFINED,i_expr($3),0); } + | SAMESIGN '(' expr ',' expr ')' + { $$ = make_expr(TYPBOOL,EX_SAMESIGN,i_expr($3),i_expr($5)); } + | SFIT '(' expr ',' expr ')' + { $$ = make_expr(TYPBOOL,EX_SFIT,i_expr($3),i_expr($5)); } + | UFIT '(' expr ',' expr ')' + { $$ = make_expr(TYPBOOL,EX_UFIT,i_expr($3),i_expr($5)); } + | ROM '(' emarg ',' NUMBER ')' + { $$ = make_expr(TYPINT,EX_ROM,$3-1,chkincl($5,1,3)-1); } + | LOWW '(' emarg ')' + { $$ = make_expr(TYPINT,EX_LOWW,$3-1,0); } + | HIGHW '(' emarg ')' + { $$ = make_expr(TYPINT,EX_HIGHW,$3-1,0); } + | '(' expr ')' + { $$ = $2; } + | expr CMPEQ expr + { $$ = make_expr(TYPBOOL,eq2expr($1,$3),$1.ex_index,$3.ex_index); } + | expr CMPNE expr + { $$ = make_expr(TYPBOOL,ne2expr($1,$3),$1.ex_index,$3.ex_index); } + | expr CMPLT expr + { $$ = make_expr(TYPBOOL,EX_NCPLT,i_expr($1),i_expr($3)); } + | expr CMPGT expr + { $$ = make_expr(TYPBOOL,EX_NCPGT,i_expr($1),i_expr($3)); } + | expr CMPLE expr + { $$ = make_expr(TYPBOOL,EX_NCPLE,i_expr($1),i_expr($3)); } + | expr CMPGE expr + { $$ = make_expr(TYPBOOL,EX_NCPGE,i_expr($1),i_expr($3)); } + | expr OR2 expr + { $$ = make_expr(TYPBOOL,EX_OR2,b_expr($1),b_expr($3)); } + | expr AND2 expr + { $$ = make_expr(TYPBOOL,EX_AND2,b_expr($1),b_expr($3)); } + | expr '+' expr + { $$ = sum_expr($1,$3); } + | expr '-' expr + { $$ = make_expr(TYPINT,EX_MINUS,i_expr($1),i_expr($3)); } + | expr '*' expr + { $$ = make_expr(TYPINT,EX_TIMES,i_expr($1),i_expr($3)); } + | expr '/' expr + { $$ = make_expr(TYPINT,EX_DIVIDE,i_expr($1),i_expr($3)); } + | expr '%' expr + { $$ = make_expr(TYPINT,EX_MOD,i_expr($1),i_expr($3)); } + | expr LSHIFT expr + { $$ = make_expr(TYPINT,EX_LSHIFT,i_expr($1),i_expr($3)); } + | expr RSHIFT expr + { $$ = make_expr(TYPINT,EX_RSHIFT,i_expr($1),i_expr($3)); } + | NOT expr + { $$ = make_expr(TYPBOOL,EX_NOT,b_expr($2),0); } + | COMP expr + { $$ = make_expr(TYPINT,EX_COMP,i_expr($2),0); } + | INREG '(' expr ')' + { $$ = make_expr(TYPINT,EX_INREG,i_expr($3),0); } + | regvartype + { $$ = make_expr(TYPINT,EX_CON, $1+1, 0); } + | REGVAR '(' expr optregvartype ')' + { $$ = regvar_expr($3,$4); } + ; + +optregvartype + : /* empty */ + { $$ = reg_any; } + | ',' regvartype + { $$ = $2; } + ; +%% +#include "scan.c" diff --git a/util/ncgg/coerc.c b/util/ncgg/coerc.c new file mode 100644 index 00000000..a9991d3f --- /dev/null +++ b/util/ncgg/coerc.c @@ -0,0 +1,249 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "set.h" +#include "property.h" +#include "reg.h" +#include "token.h" +#include "varinfo.h" +#include "iocc.h" +#include +#include "pseudo.h" +#include "extern.h" + +extern set_t l_sets[]; + +int nmoves; +move_t l_moves[MAXMOVES]; +short posmoves[MAXREGS+MAXTOKENS][SETSIZE]; + +n_move(s1,e1,s2,e2,vi) struct varinfo *vi; { + register move_p mp; + register i,j; + + NEXT(nmoves,MAXMOVES,"Moves"); + mp = &l_moves[nmoves-1]; + mp->m_set1 = s1; + mp->m_expr1 = e1; + mp->m_set2 = s2; + mp->m_expr2 = e2; + mp->m_cindex = codeindex; + dopattern(0,VI_NULL,VI_NULL,vi,VI_NULL,VI_NULL); + if (mp->m_expr1!=0 || mp->m_expr2!=0) + return; + for (i=0;im_set1].set_val,i)) + for(j=0;jm_set2].set_val[j]; +} + +existmove(from,sp) iocc_t from; short *sp; { + register i; + + for (i=0;ivi_int[0] = INSMOVE; + vp->vi_int[1] = from.in_index; + vp->vi_int[2] = to.in_index; + return(vp); +} + +int ntests; +test_t l_tests[MAXTESTS]; +short postests[SETSIZE]; + +n_test(s,e,vi) struct varinfo *vi; { + register test_p tp; + register i; + + NEXT(ntests,MAXTESTS,"Tests"); + tp = &l_tests[ntests-1]; + tp->t_set = s; + tp->t_expr = e; + tp->t_cindex = codeindex; + dopattern(0,VI_NULL,VI_NULL,vi,VI_NULL,VI_NULL); + if (tp->t_expr!=0) + return; + for(i=0;it_set].set_val[i]; +} + +struct varinfo *gen_test(from) iocc_t from; { + register struct varinfo *vp; + + if (!subset(from.in_set,postests,SETSIZE)) { + error("No such test"); + return(0); + } + NEW(vp,struct varinfo); + vp->vi_int[0] = INSTEST; + vp->vi_int[1] = from.in_index; + return(vp); +} + +struct varinfo *gen_preturn() { + register struct varinfo *vp; + + NEW(vp,struct varinfo); + vp->vi_int[0] = INSPRETURN; + return(vp); +} + +struct varinfo *gen_tlab(n) { + register struct varinfo *vp; + + assert(n>=0 && n<=9); + NEW(vp,struct varinfo); + vp->vi_int[0] = INSTLAB; + vp->vi_int[1] = n; + return(vp); +} + +int nstacks; +c1_t l_stacks[MAXSTACKS]; +set_t ustackset,cstackset; + +n_stack(s,e,p,vi) struct varinfo *vi; { + register c1_p c1p; + register short *sp; + register i; + + NEXT(nstacks,MAXSTACKS,"Stacks"); + c1p= & l_stacks[nstacks-1]; + c1p->c1_texpno = s; + c1p->c1_expr = e; + c1p->c1_prop = p; + c1p->c1_codep = codeindex; + dopattern(0,VI_NULL,VI_NULL,vi,VI_NULL,VI_NULL); + + if (e==0 && p== -1) + sp = ustackset.set_val; + else + sp = cstackset.set_val; + for(i=0;itk_name); +} + +int ncoercs; +c3_t l_coercs[MAXCOERCS]; +set_t unstackset; + +/*VARARGS5*/ + +n_coerc(ti,be,al,ge,rp,in) struct varinfo *al,*ge,*rp; iocc_t in; { + register c3_p c3p; + register i; + register struct varinfo *vi; + + if (ti!=0) { + for(i=0,vi=rp;vi!=0;vi=vi->vi_next,i++) + ; + if (i>1) { + n_split(ti,be,al,ge,rp,i); + return; + } else { + if (i==0) { + error("Coercion should have a result!"); + return; + } + } + } else { + NEW(rp,struct varinfo); + rp->vi_next = 0; + rp->vi_int[0] = in.in_index; + } + if (nallreg>1) + error("More than 1 register may not be allocated"); + NEXT(ncoercs,MAXCOERCS,"Coercions"); + c3p = & l_coercs[ncoercs-1]; + c3p->c3_texpno = ti; + c3p->c3_expr = be; + c3p->c3_prop = nallreg==0 ? 0 : allreg[0]; + c3p->c3_repl = rp->vi_int[0]; + c3p->c3_codep = codeindex; + dopattern(ti==0,VI_NULL,al,ge,rp,VI_NULL); + if (ti==0) + for(i=0;iMAXSPLIT) { + error("Maximum split factor is %d",MAXSPLIT); + n = MAXSPLIT; + } + if (n>maxsplit) maxsplit=n; + c2p->c2_texpno = ti; + c2p->c2_expr = be; + if (nallreg) + error("No register uses allowed in splitting coercion"); + c2p->c2_nsplit = n; + for (i=0,vi=rp; ivi_next) + c2p->c2_repl[i] = vi->vi_int[0]; + c2p->c2_codep = codeindex; + dopattern(0,VI_NULL,al,ge,rp,VI_NULL); +} diff --git a/util/ncgg/cost.h b/util/ncgg/cost.h new file mode 100644 index 00000000..e5f3f52b --- /dev/null +++ b/util/ncgg/cost.h @@ -0,0 +1,8 @@ +/* $Header$ */ + +#define _COST_ + +typedef struct cost { + int ct_space; + int ct_time; +} cost_t,*cost_p; diff --git a/util/ncgg/cvtkeywords b/util/ncgg/cvtkeywords new file mode 100755 index 00000000..31fc0b45 --- /dev/null +++ b/util/ncgg/cvtkeywords @@ -0,0 +1,22 @@ +: '$Header$' +grep '^#' y.tab.h >tokendefs +ed - keywords <<'!Funky!Stuff!' +g/^#/d +1,$s/\([^ ]*\)[ ][ ]*\(.*\)/ sy_p=lookup("\1",symkeyw,newsymbol);sy_p->sy_value.syv_keywno=\2;/ +1i +#include "lookup.h" +. +.r tokendefs +a + +enterkeyw() { + register symbol *sy_p; + +. +$a +} +. +w enterkeyw.c +q +!Funky!Stuff! +rm tokendefs diff --git a/util/ncgg/emlookup.c b/util/ncgg/emlookup.c new file mode 100644 index 00000000..85289a77 --- /dev/null +++ b/util/ncgg/emlookup.c @@ -0,0 +1,73 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "param.h" +#include "expr.h" +#include +#include + +extern char em_mnem[][4]; + +#define HASHSIZE (2*(sp_lmnem-sp_fmnem)) + +struct emhashmnem { + char h_name[3]; + char h_value; +} emhashmnem[HASHSIZE]; + +initemhash() { + register i; + + for(i=0;i<=sp_lmnem-sp_fmnem;i++) + enter(em_mnem[i],i+sp_fmnem); +} + +unsigned emhash(name) register char *name; { + register unsigned sum; + register i; + + for (sum=i=0;*name;i+=3) + sum ^= (*name++)<<(i&07); + return(sum); +} + +enter(name,value) char *name; { + register unsigned h; + + h=emhash(name)%HASHSIZE; + while (emhashmnem[h].h_name[0] != 0) + h = (h+1)%HASHSIZE; + strncpy(emhashmnem[h].h_name,name,3); + emhashmnem[h].h_value = value; +} + +int mlookup(name) char *name; { + register unsigned h; + + h = emhash(name)%HASHSIZE; + while (strncmp(emhashmnem[h].h_name,name,3) != 0 && + emhashmnem[h].h_name[0] != 0) + h = (h+1)%HASHSIZE; + return(emhashmnem[h].h_value&0xFF); /* 0 if not found */ +} + +extern char em_flag[]; + +argtyp(mn) { + + switch(em_flag[mn-sp_fmnem]&EM_PAR) { + case PAR_W: + case PAR_S: + case PAR_Z: + case PAR_O: + case PAR_N: + case PAR_L: + case PAR_F: + case PAR_R: + case PAR_C: + return(TYPINT); + default: + return(TYPADDR); + } +} diff --git a/util/ncgg/error.c b/util/ncgg/error.c new file mode 100644 index 00000000..c3bf854d --- /dev/null +++ b/util/ncgg/error.c @@ -0,0 +1,54 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include + +int nerrors=0; + +yyerror(s) char *s; { + + error("Parser gives %s",s); +} + +goodbye() { + + error("This was fatal, goodbye!"); +#ifndef NDEBUG + abort(); +#endif +} + +/*VARARGS1*/ +fatal(s,a,b,c,d) char *s; { + + error(s,a,b,c,d); + errorexit(); + goodbye(); + exit(-1); +} + +/*VARARGS1*/ +error(s,a,b,c,d) char *s; { + extern int lineno; + extern char *filename; + + fprintf(stderr,"\"%s\", line %d:",filename,lineno); + fprintf(stderr,s,a,b,c,d); + fprintf(stderr,"\n"); + nerrors++; +} + +#ifndef NDEBUG +badassertion(string,file,line) char *string,*file; { + + fprintf(stderr,"\"%s\", line %d: Assertion failed \"%s\"\n", + file,line,string); + goodbye(); +} +#endif + +tabovf(string) char *string; { + + fatal("%s overflow",string); +} diff --git a/util/ncgg/expr.c b/util/ncgg/expr.c new file mode 100644 index 00000000..77dd1a09 --- /dev/null +++ b/util/ncgg/expr.c @@ -0,0 +1,311 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "set.h" +#include "reg.h" +#include "lookup.h" +#include "token.h" +#include "property.h" +#include "expr.h" +#include "regvar.h" +#include +#include "extern.h" + +extern set_t l_sets[]; + +i_expr(e) expr_t e; { + + if (e.ex_typ != TYPINT) + error("Expression should be integer"); + return(e.ex_index); +} + +b_expr(e) expr_t e; { + if (e.ex_typ != TYPBOOL) + error("Expression should be boolean"); + return(e.ex_index); +} + +expr_t make_expr(type,operator,op1,op2) { + expr_t result; + + result.ex_typ=type; + result.ex_index=ex_lookup(operator,op1,op2); + return(result); +} + +expr_t regno_expr(regno) { + expr_t result; + register i; + + result.ex_typ = TYPREG; + result.ex_index = ex_lookup(EX_REG,regno,0); + for (i=0;isy_type==symconst) + return(make_expr(TYPINT,EX_CON, + (int) (sy_p->sy_value.syv_cstval&0xFFFF), + (int) (sy_p->sy_value.syv_cstval>>16))); + else if (sy_p->sy_type==symsconst) + return(make_expr(TYPADDR,EX_STRING,sy_p->sy_value.syv_stringno,0)); + else if (sy_p->sy_type!=symreg) + error("Wrong type of identifier %s",name); + return(regno_expr(sy_p->sy_value.syv_regno)); +} + +expr_t subreg_expr(tokarg,subreg) { + expr_t result; + + result.ex_typ = TYPREG; + subregset(l_sets[tokpatset[tokarg-1]].set_val,subreg,result.ex_regset); + result.ex_index = ex_lookup(EX_SUBREG,tokarg,subreg); + return(result); +} + +subregset(sp,subreg,regset) register short *sp; register short *regset; { + register i; + register reginfo *rp; + + for (i=0;iri_memb[subreg-1]==0) + error("Register %s in set has no member %d", + rp->ri_name,subreg); + BIS(regset,rp->ri_memb[subreg-1]); + } else + BIS(regset,i); + } + for(;itk_name); +} + +membset(setno,name,regset,appearance,restyp,typp) +char *name,*appearance; +short *regset; +int *typp; +{ + register short *sp; + register token_p tp; + register i,j,k; + int thistyp; + int typesdiffer=0; + int res_j= -1; + + sp = l_sets[setno].set_val; + for (i=1;itk_att[j].ta_type == -3 || + strcmp(tp->tk_att[j].ta_name,name));j++) + ; + if (j==MAXATT) + error("Token %s does not contain %s",tp->tk_name,name); + else if (j!=res_j && res_j != -1) + typesdiffer=1; + else { + res_j = j; + thistyp = tp->tk_att[j].ta_type; + if (thistyp== -2) { + if (restyp!=TYPADDR && restyp!=0) + typesdiffer=1; + else + restyp=TYPADDR; + } else if (thistyp== -1) { + if (restyp!=TYPINT && restyp!=0) + typesdiffer=1; + else + restyp=TYPINT; + } else { + if (restyp!=TYPREG && restyp!=0) + typesdiffer=1; + else { + restyp=TYPREG; + for(k=0;ktk_att[j].ta_type].pr_regset[k]; + } + } + } + } + if (typesdiffer) + error("%s is not a valid expression; types differ in the set", + appearance); + *typp = restyp==0 ? TYPINT : restyp; + return(res_j == -1 ? 0 : res_j); +} + +expr_t memb_expr(setno,name,appearance,tokarg) char *name,*appearance; { + expr_t result; + int res_j; + + res_j = membset(setno,name,result.ex_regset,appearance,0,&result.ex_typ); + result.ex_index = ex_lookup(EX_TOKFIELD,tokarg,res_j+1); + return(result); +} + +expr_t tokm_expr(tokarg,name) char *name; { + char app[100]; + + sprintf(app,"%%%d.%s",tokarg,name); + return(memb_expr(tokpatset[tokarg-1],name,app,tokarg)); +} + +expr_t perc_ident_expr(name) char *name; { + char app[100]; + + sprintf(app,"%%%s",name); + return(memb_expr(cursetno,name,app,0)); +} + +expr_t all_expr(all_no,subreg) { + set_t localset; + register i; + register short *sp; + expr_t result; + + sp = l_props[allreg[all_no]].pr_regset; + for (i=0;iex_operator != operator) + continue; + if (p->ex_lnode != lnode) + continue; + if (p->ex_rnode != rnode) + continue; + return(p-nodes); + } + NEXT(nnodes,MAXNODES,"Node"); + p->ex_operator = operator; + p->ex_lnode = lnode; + p->ex_rnode = rnode; + return(p-nodes); +} diff --git a/util/ncgg/expr.h b/util/ncgg/expr.h new file mode 100644 index 00000000..fb9c3e74 --- /dev/null +++ b/util/ncgg/expr.h @@ -0,0 +1,16 @@ +/* $Header$ */ + +typedef struct expr { + int ex_typ; + short ex_regset[SZOFSET(MAXREGS)]; + int ex_index; +} expr_t,*expr_p; + +#define TYPINT 1 +#define TYPBOOL 2 +#define TYPADDR 3 +#define TYPREG 4 + +/* When the type is register the regset contains the set of + possible registers for checking purposes only. +*/ diff --git a/util/ncgg/extern.h b/util/ncgg/extern.h new file mode 100644 index 00000000..418b526d --- /dev/null +++ b/util/ncgg/extern.h @@ -0,0 +1,30 @@ +/* $Header$ */ + +extern int wordsize; +extern int pointersize; +extern int nregs; +extern int nprops; +extern int ntokens; +extern int nsets; +extern int ninstr; +extern int empatlen; +extern int emmnem[]; +extern int empatexpr; +extern int codeindex; +extern int tokpatlen; +extern int tokpatro[]; +extern int tokpatset[]; +extern int nallreg; +extern int allreg[]; +extern int cursetno; +extern int allsetno; +extern int inproc; +extern int callproc; +extern int procarg[2]; +extern int fc1,fc2,fc3,fc4; +extern int maxmembers; +extern int regclass; +extern int maxtokensize; + +extern char *mystrcpy(); +extern char *myalloc(); diff --git a/util/ncgg/hall.c b/util/ncgg/hall.c new file mode 100644 index 00000000..94eb5504 --- /dev/null +++ b/util/ncgg/hall.c @@ -0,0 +1,155 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "set.h" +#include + +/* + * This file implements the marriage thesis from Hall. + * The thesis says that given a number, say N, of subsets from + * a finite set, it is possible to create a set with cardinality N, + * that contains one member for each of the subsets, + * iff for each number, say M, of subsets from 2 to N the union of + * each M-tuple sets has cardinality >= M. + * + * So what, you might say. As indeed I did. + * But this is actually used here to check the possibility of each + * code rule. If a code rule has a number of token_sets in the with + * clause and a number of properties in the uses rule it must be + * possible to do this from an empty fakestack. Hall helps. + */ + +#define MAXHALL (TOKPATMAX+MAXALLREG) +short hallsets[MAXHALL][SETSIZE]; +int nhallsets= -1; +int hallfreq[MAXHALL][2]; + +hallverbose() { + register i; + register max; + + fprintf(stderr,"Table of hall frequencies\n # pre post\n"); + for (max=MAXHALL-1;hallfreq[max][0]==0 && hallfreq[max][1]==0;max--) + ; + for (i=0;i<=max;i++) + fprintf(stderr,"%3d%6d%6d\n",i,hallfreq[i][0],hallfreq[i][1]); +} + +inithall() { + + assert(nhallsets == -1); + nhallsets=0; +} + +nexthall(sp) register short *sp; { + register i; + + assert(nhallsets>=0); + for(i=0;i=0); + if (!hall()) + error("Hall says: \"You can't have those registers\""); +} + +hall() { + register i,j,k; + int ok; + + hallfreq[nhallsets][0]++; + /* + * If a set has cardinality >= nhallsets it can never be the cause + * of the hall algorithm failing. So it can be thrown away. + * But then nhallsets is less, so this step can be re-applied. + */ + + do { + ok = 0; + for(i=0;i=nhallsets) { + for (j=i+1;j +#include "extern.h" + +extern int niops; +extern iocc_t iops[]; +extern inproc; + +extern set_t l_sets[]; +extern inst_t l_instances[]; + +extern expr_t subreg_expr(),regno_expr(); + +struct varinfo * setcoco(n) { + struct varinfo *vi; + + NEW(vi,struct varinfo); + vi->vi_next = VI_NULL; + vi->vi_int[0] = INSSETCC; + vi->vi_int[1] = n; + return(vi); +} + +struct varinfo * generase(n) { + struct varinfo *vi; + + NEW(vi,struct varinfo); + vi->vi_next = VI_NULL; + vi->vi_int[0] = INSERASE; + vi->vi_int[1] = n; + return(vi); +} + +struct varinfo * genremove(n) { + struct varinfo *vi; + + NEW(vi,struct varinfo); + vi->vi_next = VI_NULL; + vi->vi_int[0] = INSREMOVE; + vi->vi_int[1] = n; + return(vi); +} + +onlyreg(argno) { + register bitno; + register short *sp; + + sp = l_sets[tokpatset[argno-1]].set_val; + for(bitno=nregs;bitnoi_name)) + continue; + if (ip->i_nops!=niops) + continue; + for(i=0,op=ip->i_oplist;io_next) { + if (!subset(iops[i].in_set,l_sets[op->o_setno].set_val,SETSIZE)) + goto cont; + } + goto found; /* oh well, one more won't hurt */ + cont:; + } + error("Such an \"%s\" does not exist",ident); + return(0); +found: + NEW(vi,struct varinfo); + vi->vi_int[0] = ip-l_instr; + vi->vi_int[1] = star; + vi->vi_next=0; + retval = vi; + for(i=0;ivi_vi,struct varinfo); + vi=vi->vi_vi; + vi->vi_int[0] = iops[i].in_index; + } + vi->vi_vi = 0; + vi = retval; + for(i=0,op=ip->i_oplist;io_next) { + if(op->o_adorn&AD_CC) { + vi->vi_next = setcoco(iops[i].in_index); + vi=vi->vi_next; + } + switch(op->o_adorn&AD_RWMASK) { + default: + /* Nothing possible to do */ + break; + case AD_RO: + /* It might be possible to do something + * here but not now. + */ + break; + case AD_RW: + case AD_WO: + /* Treated the same for now */ + insta = &l_instances[iops[i].in_index]; + switch(insta->in_which) { + case IN_COPY: + if(insta->in_info[1]==0 && !onlyreg(insta->in_info[0])) + break; + makescratch(insta->in_info[0]); + vi->vi_next = generase( + ex_lookup( + EX_SUBREG,insta->in_info[0], + insta->in_info[1] + ) + ); + vi = vi->vi_next; + break; + case IN_MEMB: + vi->vi_next = generase( + ex_lookup( + EX_TOKFIELD,insta->in_info[0], + insta->in_info[1] + ) + ); + vi=vi->vi_next; + break; + case IN_RIDENT: + vi->vi_next = generase( + ex_lookup( + EX_REG,insta->in_info[0],0 + ) + ); + vi = vi->vi_next; + break; + case IN_ALLOC: + vi->vi_next = generase( + ex_lookup( + EX_ALLREG,insta->in_info[0]+1, + insta->in_info[1] + ) + ); + vi = vi->vi_next; + break; + case IN_S_DESCR: + case IN_D_DESCR: + { int temp; + + temp=ex_lookup(EX_REGVAR,insta->in_info[1],0); + vi->vi_next = generase(temp); + vi = vi->vi_next; + vi->vi_next = genremove(temp); + vi = vi->vi_next; + break; + } + } + break; + } + } + for (eravi=ip->i_erases;eravi != VI_NULL;eravi=eravi->vi_next) { + if (eravi->vi_int[0] < 0) + vi->vi_next = setcoco(0); + else { + vi->vi_next = generase(eravi->vi_int[0]); + vi=vi->vi_next; + vi->vi_next = genremove(eravi->vi_int[0]); + } + vi=vi->vi_next; + } + return(retval); +} diff --git a/util/ncgg/instruct.h b/util/ncgg/instruct.h new file mode 100644 index 00000000..7faf8d18 --- /dev/null +++ b/util/ncgg/instruct.h @@ -0,0 +1,37 @@ +/* $Header$ */ + +#ifndef _COST_ +#include "cost.h" +#endif + +#define AD_RO 01 /* Read only operand */ +#define AD_WO 02 /* Write only operand */ +#define AD_RW 03 /* Read-write operand */ +#define AD_RWMASK 03 /* Mask to select these possiblities */ + +#define AD_CC 04 /* Condition codes set to this one */ + +typedef struct operand { + struct operand *o_next; + short o_setno; + short o_adorn; +} operand; + +typedef struct instruction { + char *i_name; + short i_asname; + short i_nops; + operand *i_oplist; + struct varinfo *i_erases; + cost_t i_cost; +} instr_t,*instr_p; + +extern instr_t l_instr[]; + +/* + * The read only information on the operands is not used at the moment. + * Predicted future use: + * When using :ro data it is possible to use a register in its stead + * if it contains the same information and is allowed as an operand + * in this place. Too difficult for now. + */ diff --git a/util/ncgg/iocc.c b/util/ncgg/iocc.c new file mode 100644 index 00000000..357c644b --- /dev/null +++ b/util/ncgg/iocc.c @@ -0,0 +1,187 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "assert.h" +#include "param.h" +#include "set.h" +#include "expr.h" +#include "lookup.h" +#include "token.h" +#include "property.h" +#include "iocc.h" +#include +#include "regvar.h" +#include "extern.h" + +extern set_t l_sets[]; + +int narexpr; +expr_t arexp[MAXATT]; + +expr_t iextoaddr(); + +iocc_t subr_iocc(tokarg,subreg) { + inst_t insta; + iocc_t result; + register i; + + insta.in_which = IN_COPY; + insta.in_info[0] = tokarg; + insta.in_info[1] = subreg; + result.in_index = instalookup(insta,2); + if (subreg==0) + for (i=0;isy_value.syv_regno; + result.in_index = instalookup(insta,1); + BIS(result.in_set,sy_p->sy_value.syv_regno); + return(result); +} + +iocc_t all_iocc(all_no,subreg) { + iocc_t result; + inst_t insta; + register i; + set_t localset; + register short *sp; + + sp = l_props[allreg[all_no]].pr_regset; + for (i=0;isy_value.syv_tokno]; + BIS(result.in_set,sy_p->sy_value.syv_tokno+nregs); + insta.in_which = IN_DESCR; + if (rvused&SL_REGVAR && strcmp(ident,"LOCAL")==0) + insta.in_which = IN_S_DESCR; + else if (rvused&DL_REGVAR && strcmp(ident,"DLOCAL")==0) + insta.in_which = IN_D_DESCR; + insta.in_info[0] = sy_p->sy_value.syv_tokno; + for (i=0;itk_att[i].ta_type == -3) { + if (narexpr>i) + error("token %s initialized with too many attributes",ident); + break; + } + if (i>= narexpr) { + error("token %s initialized with too few attributes", + ident); + break; + } + typerr = 0; + switch(arexp[i].ex_typ) { + default: assert(0); + case TYPINT: + if (tp->tk_att[i].ta_type != -1) + if (tp->tk_att[i].ta_type == -2) + arexp[i] = iextoaddr(arexp[i]); + else + typerr++; + break; + case TYPBOOL: + typerr++; break; + case TYPADDR: + if (tp->tk_att[i].ta_type != -2) + typerr++; + break; + case TYPREG: + if (tp->tk_att[i].ta_type<0) + typerr++; + else if (!subset(arexp[i].ex_regset, + l_props[tp->tk_att[i].ta_type].pr_regset, + SZOFSET(MAXREGS))) + typerr++; + break; + } + if (typerr) + error("Attribute %s.%s given wrong type of value", + ident,tp->tk_att[i].ta_name); + insta.in_info[i+1] = arexp[i].ex_index; + } + result.in_index = instalookup(insta,i+1); + return(result); +} + +/* low level instance package */ + +int ninstances=1; +inst_t l_instances[MAXINSTANCES]; + +instalookup(insta,filled) inst_t insta; { + register i,j; + + for (j=filled;j<=MAXATT;j++) + insta.in_info[j] = 0; + for (i=0;isy_next) { + if (strcmp(sy_p->sy_name,name)!=0) + continue; + switch(style) { + default: + assert(0); + case justlooking: + case mustexist: + case makeexist: + if (type==symany || type==sy_p->sy_type) + return(sy_p); + continue; + case newsymbol: + error("%s already defined",name); + return(&dumsym); + } + } + switch(style) { + default: + assert(0); + case justlooking: + return((symbol *) 0); + case mustexist: + fatal("%s is unknown symbol",name); + /* NOTREACHED */ + case newsymbol: + case makeexist: + NEW(sy_p,symbol); + sy_p->sy_next = 0; + sy_p->sy_name = mystrcpy(name); + assert(type!=symany); + sy_p->sy_type = type; + *sy_pp = sy_p; + return(sy_p); + } +} + +hashvalue(s) register char *s; { + register unsigned sum=0; + register i; + + for(i=0;*s;s++,i=(i+3)&07) + sum += *s< + +char *filename; + +main(argc,argv) char **argv; { + extern int nerrors; + extern int code_in_c; + extern int tabledebug; + extern int verbose; + + while (argc >1 && argv[1][0]=='-') { + switch(argv[1][1]) { + case 'c': + code_in_c = 0; + break; + case 'd': + tabledebug++; + break; + case 'v': + verbose++; + break; + default: + error("Unknown flag -%c",argv[1][1]); + } + argc--; argv++; + } + if (argc==2) { + if (freopen(argv[1],"r",stdin)==NULL) { + error("Can't open %s",argv[1]); + exit(-1); + } + filename = argv[1]; + } else + error("Usage: %s [-c] [-d] [-v] table",argv[0]); + initemhash(); + enterkeyw(); + initnodes(); + initio(); + yyparse(); + if (nerrors==0) { + finishio(); + statistics(); + if (verbose) + hallverbose(); + } else { + errorexit(); + } + return(nerrors==0 ? 0 : -1); +} diff --git a/util/ncgg/makedepend b/util/ncgg/makedepend new file mode 100755 index 00000000..31e2e20d --- /dev/null +++ b/util/ncgg/makedepend @@ -0,0 +1,15 @@ +: '$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 diff --git a/util/ncgg/ncgg.6 b/util/ncgg/ncgg.6 new file mode 100644 index 00000000..11dc99fe --- /dev/null +++ b/util/ncgg/ncgg.6 @@ -0,0 +1,46 @@ +.\" $Header$ +.TH CGG VI +.ad +.SH NAME +cgg \- Code table translating utility +.SH SYNOPSIS +cgg [-c] [-d] [-v] table +.SH DESCRIPTION +cgg translates a machine description table into the internal +structures needed by em_cg. +Flags recognized are: +.IP -c +Write one of the largest arrays in binary form on the file code. +The resulting code generator must be run in the same directory, +but compile time of the code generator will be less. +Useful during table debugging. +.IP -d +Generate pseudo code for table debugging. +This gives better information when the resulting code generator +is run with the debug flag on. +It also generates the file lineset that can be used as the +bittable described under the -u option of em_cg(VI). +.IP -v +Give statistics about table usage at end of program. +Normally only the tables that have been used more than 75% +are reported. +.SH FILES +tables.H, tables.c +.br +code If the -c flag was given +.br +lineset If the -d flag was given +.SH "SEE ALSO" +ack(I) +.br +em_cg(VI) +.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. +.IP [2] +Hans van Staveren "The table driven code generator from the +Amsterdam Compiler Kit, Second revised edition" +.SH AUTHOR +Hans van Staveren, Vrije Universiteit diff --git a/util/ncgg/output.c b/util/ncgg/output.c new file mode 100644 index 00000000..48ba9510 --- /dev/null +++ b/util/ncgg/output.c @@ -0,0 +1,858 @@ +/* #define CODEDEBUG /* print readable code */ +#ifdef CODEDEBUG +int code_in_c=0; /* put readable code in "code" */ +int tabledebug=1; /* generate code for table debugging */ +#else +int code_in_c=1; /* put code in "tables.c" */ +int tabledebug=0; /* do not generate code for table debugging */ +#endif +int verbose=0; /* print all statistics */ +char *c_file= "tables.c"; +char *h_file= "tables.H"; +char *cd_file= "code"; + +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include +#include +#include "assert.h" +#include "varinfo.h" +#include "param.h" +#include "reg.h" +#include "property.h" +#include "token.h" +#include "set.h" +#include "instruct.h" +#include "lookup.h" +#include +#include "pseudo.h" +#include "regvar.h" +#include "extern.h" + +#define BMASK 0xFF +#define BSHIFT 8 + +FILE *ctable,*htable; +FILE *code; +short *lineset; +int maxline; + +extern int nstrings; +extern char *l_strings[]; + +extern int ninstances; +extern inst_t l_instances[]; + +extern int nmoves; +extern move_t l_moves[]; +extern int ntests; +extern test_t l_tests[]; +extern int nstacks; +extern c1_t l_stacks[]; +extern int ncoercs; +extern c3_t l_coercs[]; +extern int nsplit,maxsplit; +extern c2_t l_split[]; +extern set_t l_sets[]; + +int maxallreg=0; +int maxregvars=0; +int setsize; + +opnfile(f,s) FILE **f; char *s; { + + if ((*f=fopen(s,"w"))==NULL) + fatal("Can't create %s",s); +} + +unlfile(f,s) FILE *f; char *s; { + + fclose(f); + if (unlink(s)<0) + error("%s incorrect, must be removed!!",s); +} + +initio() { + extern char *myalloc(); + + opnfile(&ctable,c_file); + opnfile(&htable,h_file); + if (code_in_c) + fprintf(ctable,"char coderules[] = {"); + else + opnfile(&code,cd_file); + patbyte(0); + if (tabledebug) + lineset = (short *) myalloc(SZOFSET(MAXSOURCELINES)*sizeof(short)); +} + +finishcode() { + + if (code_in_c) + fprintf(ctable,"\n};\n\n"); + if (tabledebug) { + int fd; + int sz; + + if ((fd=creat("lineset",0666))>=0) { + sz = SZOFSET(maxline)*2; + write(fd,&sz,sizeof(int)); + write(fd,lineset,sz); + close(fd); + } else + error("Can't create lineset"); + } +} + +errorexit() { + + unlfile(ctable,c_file); + unlfile(htable,h_file); + if (!code_in_c) + unlfile(code,cd_file); +} + +#ifdef CODEDEBUG +#define code8(x) fprintf(code,"%s","x") +#define code8nl(x) fprintf(code,"%s\n","x") +#define code53(x,y) fprintf(code,"%s-%d","x",y) +#define codeint(x) fprintf(code," %d",x) +#define codenl() fprintf(code,"\n") +#else +code8(x) { + + codeindex++; + if (code_in_c) + fprintf(ctable,"%d,",x&0377); + else + putc(x,code); +} + +code8nl(x) { + + code8(x); +} + +code53(x,y) { + + code8(x+(y<<5)); +} + +codeint(x) { + + assert(x>=0 && x<=32767); + if (x<128) { + code8(x); + } else { + code8(x/256+128); + code8(x%256); + } +} + +codenl() { +} +#endif +int prevind=0; +int npatbytes=0; +char pattern[MAXPATBYTES]; +int pathash[256]; + +outpatterns() { + extern int npatterns; + extern int patindex[]; + extern int empatlen; + extern int emmnem[]; + extern int empatexpr; + register i; + + if (!inproc) { + patbyte(0); + patshort(prevind); + prevind = npatbytes-3; + patbyte(empatlen); + for(i=0;i=0); + if (n<128) + patbyte(n); + else { + patbyte(n/256+128); + patbyte(n%256); + } +} + +patshort(n) { + + patbyte(n%256); + patbyte(n/256); +} + +patbyte(n) { + + pattern[npatbytes++]=n; +} + +hashpatterns() { + short index; + register char *bp,*tp; + register short i; + unsigned short hashvalue; + int patlen; + + index = prevind; + while (index != 0) { + bp = &pattern[index]; + tp = &bp[PO_MATCH]; + i = *tp++&BMASK; + if (i==BMASK) { + i = *tp++&BMASK; + i |= (*tp++&BMASK)<>BSHIFT; + hashvalue &= BMASK; + bp[PO_NEXT] = pathash[hashvalue]&BMASK; + bp[PO_NEXT+1] = pathash[hashvalue]>>BSHIFT; + pathash[hashvalue] = i; + } +} + +outincludes() { + + fprintf(ctable,"#include \"param.h\"\n"); + fprintf(ctable,"#include \"tables.h\"\n"); + fprintf(ctable,"#include \"types.h\"\n"); + fprintf(ctable,"#include \n"); + fprintf(ctable,"#include \"data.h\"\n"); +} + +outregs() { + register i,j,k; + short rset[SZOFSET(MAXREGS)]; + int t,ready; + + + fprintf(ctable,"char stregclass[] = {\n"); + for (i=0;i=0); + fprintf(ctable,"},\n"); + } + fprintf(ctable,"};\n\n"); +} + +outregvars() { + register i,j; + + fprintf(htable,"#define REGVARS\n"); + fprintf(ctable,"#include \"regvar.h\"\n"); + fprintf(ctable,"int nregvar[4] = { "); + for (i=0;i<4;i++) { + fprintf(ctable,"%d, ",nregvar[i]); + if (nregvar[i]>maxregvars) + maxregvars = nregvar[i]; + } + fprintf(ctable,"};\n"); + for (i=0;i<4;i++) + if (nregvar[i]>0) + fprintf(ctable,"struct regassigned ratar%d[%d];\n", + i,nregvar[i]); + for (i=0;i<4;i++) if (nregvar[i]>0) { + fprintf(ctable,"int rvtar%d[] = {",i); + for (j=0;j0) + fprintf(ctable,"\trvtar%d,\n",i); + else + fprintf(ctable,"\t0,\n"); + fprintf(ctable,"};\n\nstruct regassigned *regassigned[] = {\n"); + for (i=0;i<4;i++) + if (nregvar[i]>0) + fprintf(ctable,"\tratar%d,\n",i); + else + fprintf(ctable,"\t0,\n"); + fprintf(ctable,"};\n"); +} + +typeconv(n) { + + if (n>=0) return(2); + if (n== -1) return(1); + if (n== -2) return(3); + assert (n== -3); + return(0); +} + +outtokens() { + register tokno,i; + register token_p tp; + + fprintf(ctable,"tkdef_t tokens[] = {{0},\n"); + for (tokno=1;toknotk_size, tp->tk_cost.ct_space, tp->tk_cost.ct_time); + for(i=0;itk_att[i].ta_type)); + fprintf(ctable,"},%d},\n",tp->tk_format); + } + fprintf(ctable,"{0}};\n\n"); +} + +outenodes() { + register node_p np; + extern node_t nodes[]; + extern int nnodes; + + fprintf(ctable,"node_t enodes[] = {\n"); + for (np=nodes;np<&nodes[nnodes];np++) + fprintf(ctable,"{%d,%d,%d},\n", + np->ex_operator,np->ex_lnode,np->ex_rnode); + fprintf(ctable,"};\n\n"); +} + +outstrings() { + register i; + register char *p,c; + extern char * filename; + + if (tabledebug) + fprintf(ctable,"char *tablename = \"%s\";\n",filename); + fprintf(ctable,"string codestrings[] = {\n"); + for(i=0;iset_size); + for (i=0;iset_val[i]&0xFFFF); + fprintf(ctable,"}},\n"); + } + fprintf(ctable,"};\n\n"); +} + +outinstances() { + register inst_p ip; + register i; + + fprintf(ctable,"inst_t tokeninstances[] = {\n"); + for (ip=l_instances;ip< &l_instances[ninstances]; ip++) { + fprintf(ctable,"{ %d, {",ip->in_which); + for(i=0;i<=maxtokensize;i++) + fprintf(ctable,"%d,",ip->in_info[i]); + fprintf(ctable,"}},\n"); + } + fprintf(ctable,"};\n\n"); +} + +outmoves() { + register move_p mp; + + fprintf(ctable,"move_t moves[] = {\n"); + for (mp=l_moves; mp< &l_moves[nmoves]; mp++) + fprintf(ctable,"{%d,%d,%d,%d,%d},\n", + mp->m_set1, mp->m_expr1, + mp->m_set2, mp->m_expr2, + mp->m_cindex); + fprintf(ctable,"{-1}\n};\n\n"); +} + +outtests() { + register test_p tp; + + fprintf(ctable,"test_t tests[] = {\n"); + for (tp=l_tests; tp< &l_tests[ntests]; tp++) + fprintf(ctable,"{%d,%d,%d},\n", + tp->t_set, tp->t_expr, + tp->t_cindex); + fprintf(ctable,"{-1}\n};\n\n"); +} + +outstacks() { + register c1_p cp; + + fprintf(ctable,"c1_t c1coercs[] = {\n"); + for (cp=l_stacks; cp< &l_stacks[nstacks]; cp++) + fprintf(ctable,"{%d,%d,%d,%d},\n", + cp->c1_texpno, cp->c1_expr, + cp->c1_prop, cp->c1_codep); + fprintf(ctable,"{-1}\n};\n\n"); +} + +outsplits() { + register c2_p cp; + register i; + + fprintf(ctable,"c2_t c2coercs[] = {\n"); + for (cp=l_split; cp< &l_split[nsplit]; cp++) { + fprintf(ctable,"{%d,%d,%d,{", + cp->c2_texpno, cp->c2_expr, cp->c2_nsplit); + for (i=0;ic2_repl[i]); + fprintf(ctable,"},%d},\n",cp->c2_codep); + } + fprintf(ctable,"{-1}\n};\n\n"); +} + +outcoercs() { + register c3_p cp; + + fprintf(ctable,"c3_t c3coercs[] = {\n"); + for (cp=l_coercs; cp< &l_coercs[ncoercs]; cp++) + fprintf(ctable,"{%d,%d,%d,%d,%d},\n", + cp->c3_texpno, cp->c3_expr, + cp->c3_prop, cp->c3_repl, cp->c3_codep); + fprintf(ctable,"{-1}\n};\n\n"); +} + +outproplists() { + register propno; + register regno; + + for(propno=0;propnosy_value.syv_stringno]; + else if (wordsize<=2) + wrdfmt = "%d"; + else + wrdfmt = "%ld"; + fprintf(ctable,"char wrd_fmt[]= \"%s\";\n", wrdfmt); + fprintf(htable,"#define WRD_FMT wrd_fmt\n"); + fprintf(htable,"extern char wrd_fmt[];\n"); + cdef("MAXALLREG",maxallreg); + cdef("SETSIZE",setsize); + cdef("NREGS",nregs); + cdef("REGSETSIZE",SZOFSET(nregs)); + cdef("TOKENSIZE",maxtokensize); + cdef("MAXMEMBERS",maxmembers); + cdef("LONGESTPATTERN",maxempatlen); + cdef("MAXRULE",maxrule<16 ? 16 : maxrule); + if (nsplit>0) { + cdef("MAXSPLIT",maxsplit); + } + if (tabledebug) + cdef("TABLEDEBUG",1); +} + +outars() { + register i; + + if (code_in_c) + fprintf(htable,"#define CODEINC 1\n"); + else { + fprintf(ctable,"char coderules[%d];\n",codeindex); + fprintf(ctable,"int ncodebytes=%d;\n",codeindex); + } + fprintf(ctable,"char pattern[%d]={\n",npatbytes); + for(i=0;i0) + outsplits(); + outcoercs(); + outproplists(); + outconsts(); + if (rvused) + outregvars(); + outars(); +} + +codecoco(cocono) { + + if (cocono== -1) + return; + code8(DO_SETCC); + codeint(cocono); + codenl(); +} + +dopattern(stackcoerc,kills,allocates,generates,yields,leaving) +varinfo *kills,*allocates,*generates,*yields,*leaving; +{ + register i; + int n,nops; + register struct varinfo *vp,*vivp; + register instr_p instp; + int al,deal; + int vil; + int cocono= -1; + cost_t totcost; + int nremoves; + int removelist[100]; + static char tlab[] = "0:"; + extern int optexact,optstack,startline; + extern char *filename; + extern int lineno; + +#ifdef CODEDEBUG + fprintf(code,"Code(%d) at \"%s\", line %d\n",stackcoerc,filename,lineno); +#endif + if (code_in_c) + fprintf(ctable,"\n/* \"%s\", line %d */ ",filename,lineno); + if (tabledebug) { + code8(DO_DLINE); + codeint(startline); + codenl(); + if (startlinemaxline) + maxline=startline; + BIS(lineset,startline); + } else { + static int beenhere=0; + + if (!beenhere) { + beenhere++; + error("Too many source lines for table debug"); + } + } + } + /* MATCH part */ + if (tokpatlen) { + if (optexact) + if (optstack) + code53(DO_XXMATCH,tokpatlen); + else + code53(DO_XMATCH,tokpatlen); + else + code53(DO_MATCH,tokpatlen); + for (i=0;ivi_next) { + if (vp->vi_int[1] != 0) { + code53(DO_REMOVE,1); + codeint(vp->vi_int[0]); + codeint(vp->vi_int[1]); + codenl(); + } else { + code53(DO_REMOVE,0); + codeint(vp->vi_int[0]); + codenl(); + } + } + nremoves=0; + for(vp=generates;vp!=0;vp=vp->vi_next) { + if (vp->vi_int[0] != INSREMOVE) + continue; + for(i=0;ivi_int[1]==removelist[i]) + break; + if (i==nremoves) { + assert(nremoves<(sizeof(removelist)/sizeof(int))); + removelist[nremoves++] = vp->vi_int[1]; + } + } + for(i=0;ivi_next) { + if (vp->vi_int[0] == -1) { /* Deallocate */ + deal++; + code8(DO_DEALLOCATE); + codeint(vp->vi_int[1]); + codenl(); + } else { + if (vp->vi_int[1]==0) { + code53(DO_ALLOCATE,0); + codeint(vp->vi_int[0]); + codenl(); + } else { + code53(DO_ALLOCATE,1); + codeint(vp->vi_int[0]); + codeint(vp->vi_int[1]); + codenl(); + } + al++; + } + } + if (deal) + code8nl(DO_REALLOCATE); + if (al>maxallreg) + maxallreg=al; + totcost.ct_space = 0; + totcost.ct_time = 0; + for(vp=generates;vp!=0;vp=vp->vi_next) { + n= vp->vi_int[0]; + switch(n) { + default: + assert(n>=0); + instp = &l_instr[n]; + nops=instp->i_nops; + code53(DO_INSTR,nops); + if (vp->vi_int[1]==0) { + codeint(instp->i_asname); + } else { + codeint(10000+vp->vi_int[1]); + } + vivp=vp->vi_vi; + for(i=0;ivi_int[0]); + vivp = vivp->vi_vi; + } + codenl(); + totcost.ct_space += instp->i_cost.ct_space; + totcost.ct_time += instp->i_cost.ct_time ; + break; + case INSREMOVE: + break; + case INSMOVE: + codecoco(cocono); + code8(DO_MOVE); + codeint(vp->vi_int[1]); + codeint(vp->vi_int[2]); + codenl(); + break; + case INSTEST: + codecoco(cocono); + code8(DO_TEST); + codeint(vp->vi_int[1]); + codenl(); + break; + case INSPRETURN: + code8(DO_PRETURN); + codenl(); + break; + case INSTLAB: + tlab[0] = vp->vi_int[1] + '0'; + code53(DO_INSTR,0); + codeint(strlookup(tlab)); + codenl(); + break; + case INSSETCC: + cocono=vp->vi_int[1]; + break; + case INSERASE: + code8(DO_ERASE); + codeint(vp->vi_int[1]); + codenl(); + break; + } + } + codecoco(cocono); + vil = vilength(yields); + if (vil!=0 || tokpatlen!=0 || allocates!=0) { + code53(DO_TOKREPLACE,vilength(yields)); + for(vp=yields;vp!=0;vp=vp->vi_next) { + codeint(vp->vi_int[0]); + } + codenl(); + } + if (leaving!=0) { + code53(DO_EMREPLACE,vilength(leaving)); + while (leaving!=0) { + codeint(leaving->vi_int[0]); + codeint(leaving->vi_int[1]); + leaving = leaving->vi_next; + } + codenl(); + } + if (totcost.ct_space!=0 || totcost.ct_time!=0) { + code8(DO_COST); + codeint(totcost.ct_space); + codeint(totcost.ct_time); + codenl(); + } + if (empatlen==0 && !inproc) + code8nl(DO_RETURN); + else + code8nl(DO_NEXTEM); +} + +used(resource,use,max) char *resource; { + + if (verbose || 4*use > 3*max) + fprintf(stderr,"%s %d(%d)\n",resource,use,max); +} + +statistics() { + extern char *end,*sbrk(); + + used("Registers",nregs,MAXREGS); + used("Properties",nprops,MAXPROPS); + used("Tokens",ntokens,MAXTOKENS); + used("Tokensize",maxtokensize,MAXATT); + used("Sets",nsets,MAXSETS); + used("Instructions",ninstr,MAXINSTR); + used("Strings",nstrings,MAXSTRINGS); + used("Exp-nodes",nnodes,MAXNODES); + used("EM-pat length",maxempatlen,EMPATMAX); + used("rules/EM-pattern",maxrule,MAXPATTERNS); + used("Allocates/rule",maxallreg,MAXALLREG); + used("Instances",ninstances,MAXINSTANCES); + used("Moves",nmoves,MAXMOVES); + used("Tests",ntests,MAXTESTS); + used("Stacks",nstacks,MAXSTACKS); + used("1->1 Coercions",ncoercs,MAXCOERCS); + used("Splitting coercions",nsplit,MAXSPLCOERC); + used("Register variables",maxregvars,MAXREGVAR); + used("Pat bytes",npatbytes,MAXPATBYTES); + if (tabledebug) + used("Source lines",maxline,MAXSOURCELINES); + fprintf(stderr,"%ldK heap used\n",((long) (sbrk(0)-end+1023))/1024); +} diff --git a/util/ncgg/param.h b/util/ncgg/param.h new file mode 100644 index 00000000..1d82c1b5 --- /dev/null +++ b/util/ncgg/param.h @@ -0,0 +1,38 @@ +/* $Header$ */ + +/* + * Miscellaneous sizes, tunable + */ + +#define MAXREGS 40 +#define MAXPROPS 30 +#define MAXTOKENS 60 +#define MAXATT 3 +#define MAXSETS 100 +#define MAXINSTR 100 +#define MAXSTRINGS 250 +#define MAXNODES 300 +#define EMPATMAX 20 +#define MAXPATTERNS 20 +#define MAXALLREG 5 +#define MAXINSTANCES 300 +#define MAXMOVES 20 +#define MAXTESTS 10 +#define MAXSTACKS 30 +#define MAXCOERCS 25 +#define MAXSPLCOERC 20 +#define MAXSPLIT 2 +#define MAXPATBYTES 7000 +#define MAXREGVAR 8 +#define MAXSOURCELINES 4000 + +/* end of tunable constants */ + +#define TOKPATMAX 7 + +#define SZOFSET(n) (((n)+15)/16) + +#define SETSIZE SZOFSET(MAXREGS+MAXTOKENS) + +#define NEXT(n,max,string) (n" return(CMPGT); +">=" return(CMPGE); +"||" return(OR2); +"&&" return(AND2); +"<<" return(LSHIFT); +">>" return(RSHIFT); +"!" return(NOT); +"~" return(COMP); +":ro" { yylval.yy_int = AD_RO; return(ADORNACCESS); } +":wo" { yylval.yy_int = AD_WO; return(ADORNACCESS); } +":rw" { yylval.yy_int = AD_RW; return(ADORNACCESS); } +":cc" { yylval.yy_int = AD_CC; return(ADORNCC); } +\$[0-9]+ { yylval.yy_int = atoi(yytext+1); return(DOLLAR); } +\%[0-9]+ { yylval.yy_int = atoi(yytext+1); return(PERCENT); } +\%[a-z] { yylval.yy_int = yytext[1]-'a'; return(ALLREG); } +[0-9]+|0x[0-9A-Fa-f]+ { yylval.yy_int = myatoi(yytext); return(NUMBER); } +[_A-Za-z][_A-Za-z0-9]* { register symbol *sy_p; + if ((sy_p=lookup(yytext,symkeyw,justlooking))!=0) + return(sy_p->sy_value.syv_keywno); + yylval.yy_str = mystrcpy(yytext); return(IDENT); + } +\%[_A-Za-z][_A-Za-z0-9]* { yylval.yy_str = mystrcpy(yytext+1); + return(PERC_IDENT); + } +\"[^"\n]*\" { yytext[yyleng-1]=0; + yylval.yy_str = mystrcpy(yytext+1); + return(STRING); + } +[0-9][bf] { yytext[2]=0; + yylval.yy_str = mystrcpy(yytext); + return(STRING); + } +\n { lineno++; } +[ \t]* ; +. return(yytext[0]); +%% +int skipping=0; + +yywrap() { + + if (skipping) + fatal("EOF reached during error recovery"); + return(1); +} + +skipupto(tok,str) char *str; { + register i; + + skipping=1; + while (yylex()!=tok) + ; + for(i=strlen(str); i>0; i--) + unput(str[i-1]); + skipping=0; +} diff --git a/util/ncgg/set.c b/util/ncgg/set.c new file mode 100644 index 00000000..54e3f1f1 --- /dev/null +++ b/util/ncgg/set.c @@ -0,0 +1,118 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "param.h" +#include "property.h" +#include "set.h" +#include "token.h" +#include "lookup.h" +#include +#include "extern.h" + +extern set_t l_sets[]; + +setlookup(s) set_t s; { + register set_p p; + register i; + int setno; + + for(p=l_sets;p<&l_sets[nsets];p++) { + if (p->set_size != s.set_size) + continue; + for (i=0;iset_val[i] != s.set_val[i]) + goto cont; + return(p-l_sets); + cont:; + } + setno = NEXT(nsets,MAXSETS,"Sets"); + l_sets[setno] = s; + return(setno); +} + +make_std_sets() { + set_t s; + register i; + + for(i=0;isy_type) { + default: + error("%s is wrong kind of symbol",name); + return(emptyset); + case symprop: + pp = &l_props[sy_p->sy_value.syv_propno]; + result.set_size = pp->pr_size; + for (i=0;ipr_regset[i]; + BIS(result.set_val,0); + for (;isy_value.syv_tokno+nregs; + for (i=0;isy_value.syv_tokno]->tk_size; + break; + case symset: + return(l_sets[sy_p->sy_value.syv_setno]); + } + return(result); +} + +set_t setproduct(s1,s2) set_t s1,s2; { + set_t result; + register i; + + if ((result.set_size=s1.set_size)==0) + result.set_size = s2.set_size; + for(i=0;i>4] |= 1<<((n)&0xF) +#define BIC(sp,n) (sp)[(n)>>4] &= ~(1<<((n)&0xF)) +#define BIT(sp,n) (((sp)[(n)>>4]&(1<<((n)&0xF)))!=0) diff --git a/util/ncgg/strlookup.c b/util/ncgg/strlookup.c new file mode 100644 index 00000000..4e41786d --- /dev/null +++ b/util/ncgg/strlookup.c @@ -0,0 +1,20 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "param.h" + +int nstrings=0; +char *l_strings[MAXSTRINGS]; + +strlookup(str) char *str; { + register i; + extern char *mystrcpy(); + + for(i=0;i +#include "extern.h" + +n_proc(name) char *name; { + register symbol *sy_p; + extern int npatbytes; + + sy_p = lookup(name,symproc,newsymbol); + sy_p->sy_value.syv_procoff = npatbytes; +} + +struct varinfo * +make_erase(name) char *name; { + expr_t e,ident_expr(); + struct varinfo *result; + + e = ident_expr(name); + if (e.ex_typ != TYPREG) + error("Register name required here"); + NEW(result,struct varinfo); + result->vi_next = VI_NULL; + result->vi_int[0] = e.ex_index; + return(result); +} + +n_instr(name,asname,oplist,eraselist,cost) +char *name,*asname; +operand *oplist; +struct varinfo *eraselist,*cost; +{ + register instrno; + register cc_count; + register instr_p ip; + + instrno = NEXT(ninstr,MAXINSTR,"Instructions"); + ip = &l_instr[instrno]; + ip->i_name = name; + ip->i_asname = strlookup(asname!=0 ? asname : name); + ip->i_nops = 0; + ip->i_oplist = oplist; + ip->i_erases = eraselist; + if (cost==0) { + ip->i_cost.ct_space = 0; + ip->i_cost.ct_time = 0; + } else { + ip->i_cost.ct_space = cost->vi_int[0]; + ip->i_cost.ct_space = cost->vi_int[1]; + } + for (cc_count=0; oplist!=0; oplist = oplist->o_next) { + ip->i_nops++; + if(oplist->o_adorn&AD_CC) + cc_count++; + } + while (eraselist!=VI_NULL) { + if (eraselist->vi_int[0] == -1 && cc_count) + error("Instruction can't both set and break the condition codes"); + eraselist=eraselist->vi_next; + } + if (cc_count>1) + error("No instruction can set condition codes more than once"); +} + +n_set(name,number) char *name; { + register symbol *sy_p; + + sy_p = lookup(name,symset,newsymbol); + sy_p->sy_value.syv_setno = number; +} + +n_tok(name,atts,size,cost,format) +char *name; +struct varinfo *atts,*cost,*format; +{ + register symbol *sy_p; + register token_p tp; + register struct varinfo *vip; + int i; + int tokno; + char formstr[50],smallstr[2]; + + sy_p = lookup(name,symtok,newsymbol); + NEW(tp,token_t); + tokno = NEXT(ntokens,MAXTOKENS,"Tokens"); + sy_p->sy_value.syv_tokno = tokno; + l_tokens[tokno] = tp; + tp->tk_name = sy_p->sy_name; + tp->tk_size = size; + if (cost != 0) { + tp->tk_cost.ct_space = cost->vi_int[0]; + tp->tk_cost.ct_time = cost->vi_int[1]; + } else { + tp->tk_cost.ct_space = 0; + tp->tk_cost.ct_time = 0; + } + for(i=0,vip=atts;ivi_next) { + tp->tk_att[i].ta_type = vip->vi_int[0]; + tp->tk_att[i].ta_name = vip->vi_str[0]; + vip->vi_str[0]=0; + } + if (i>maxtokensize) + maxtokensize=i; + if (vip!=0) + error("More then %d attributes, rest discarded",MAXATT); + for(;itk_att[i].ta_type= -3; + if (format!=0) { + formstr[0] = 0; + for (vip=format;vip!=0;vip=vip->vi_next) { + if (vip->vi_int[0]==0) + strcat(formstr,vip->vi_str[0]); + else { + for(i=0;ivi_str[0],tp->tk_att[i].ta_name)==0) { + smallstr[0] = i+1; + smallstr[1] = 0; + strcat(formstr,smallstr); + break; + } + } + if (i==MAXATT) + error("%s not a known attribute", + vip->vi_str[0]); + } + } + tp->tk_format = strlookup(formstr); + } else + tp->tk_format = -1; +} + +checkprintformat(n) { + register short *s; + register i; + extern set_t l_sets[]; + + s= l_sets[n].set_val; + for(i=nregs;itk_format<0) + error("Token %s in set does not have printformat", + l_tokens[i-nregs]->tk_name); +} + +n_prop(name,size) char *name; int size; { + int propno; + register symbol *sp; + + propno = NEXT(nprops,MAXPROPS,"Properties"); + sp = lookup(name,symprop,newsymbol); + sp->sy_value.syv_propno = propno; + if (size <= 0) { + error("Size of property must be >0"); + size = wordsize; + } + l_props[propno].pr_size = size; +} + +prophall(n) { + register i; + short hallset[SETSIZE]; + + for(i=0;isy_value.syv_regno = regno = NEXT(nregs,MAXREGS,"Number of registers"); + ri_p = &l_regs[regno]; + ri_p->ri_name = mystrcpy(name); + ri_p->ri_repr = printstring!=0 ? mystrcpy(printstring) : ri_p->ri_name; + ri_p->ri_memb[0] = member1; + ri_p->ri_memb[1] = member2; + if (nmemb>maxmembers) + maxmembers=nmemb; + return(regno); +} + +make_const() { + + wordsize = cmustbeset("EM_WSIZE"); + pointersize = cmustbeset("EM_PSIZE"); +} + +cmustbeset(ident) char *ident; { + + return(lookup(ident,symconst,mustexist)->sy_value.syv_cstval); +} + +n_const(ident,val) char *ident; { + register symbol *sy_p; + + sy_p = lookup(ident,symconst,newsymbol); + sy_p->sy_value.syv_cstval = val; +} + +n_sconst(ident,val) char *ident,*val; { + register symbol *sy_p; + + sy_p = lookup(ident,symsconst,newsymbol); + sy_p->sy_value.syv_stringno = strlookup(val); +} + +regline(rl,pl,rv) varinfo *rl,*pl; { + register varinfo *rrl,*rpl; + register short *sp; + register reginfo *regp; + int thissize; + int propno; + + for(rrl=rl;rrl!=0;rrl=rrl->vi_next) { + regp = &l_regs[rrl->vi_int[0]]; + thissize = 0; + for(rpl=pl;rpl!=0;rpl=rpl->vi_next) { + propno = rpl->vi_int[0]; + sp= l_props[propno].pr_regset; + BIS(sp,rrl->vi_int[0]); + if (thissize==0) + thissize = l_props[propno].pr_size; + else if (thissize!=-1 && thissize!=l_props[propno].pr_size) + error("Register %s has no clear size", + regp->ri_name); + } + regp->ri_size = thissize; + regp->ri_class = regclass; + regp->ri_rregvar = rv; + if (rv>=0) { + if (regp->ri_memb[0]!=0) + error("Register variables may not have subregisters"); + rvused |= ANY_REGVAR; + if (regp->ri_size == wordsize) + rvused |= SL_REGVAR; + else if (regp->ri_size == 2*wordsize) + rvused |= DL_REGVAR; + if (nregvar[rv]==0) + rvsize[rv] = regp->ri_size; + else if (rvsize[rv]!=regp->ri_size) + error("All register variables of one type must have the same size"); + NEXT(nregvar[rv],MAXREGVAR,"Register variable"); + rvnumbers[rv][nregvar[rv]-1] = rrl->vi_int[0]; + } + } + regclass++; +} + +setallreg(vi) struct varinfo *vi; { + + nallreg=0; + for(;vi!=0;vi=vi->vi_next) { + if (vi->vi_int[0]<0) + continue; + allreg[nallreg++] = vi->vi_int[0]; + } +} + +freevi(vip) register struct varinfo *vip; { + register i; + extern char *end; + + if (vip==0) + return; + freevi(vip->vi_next); + freevi(vip->vi_vi); + for (i=0;ivi_str[i]>end) + free((char *) vip->vi_str[i]); + free(vip); +} + +int myatoi(s) register char *s; { + register int base=10; + register sum=0; + + if (*s=='0') { + base = 8; + s++; + if (*s=='x') { + base=16; + s++; + } + } + for (;;) { + switch (*s) { + default: return(sum); + case '8': + case '9': + if (base==8) error("Bad digit in octal number"); + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + sum = sum*base + *s++ - '0'; + break; + case 'a': + case 'b': + case 'c': + case 'd': + case 'e': + case 'f': + if (base!=16) error("Hexletter in number not expected"); + sum = sum*base + *s++ - 'a'; + break; + case 'A': + case 'B': + case 'C': + case 'D': + case 'E': + case 'F': + if (base!=16) error("Hexletter in number not expected"); + sum = sum*base + *s++ - 'A'; + break; + } + } +} + +char *mystrcpy(s) char *s; { + register char *p; + char *myalloc(); + + p=myalloc(strlen(s)+1); + strcpy(p,s); + return(p); +} + +char *myalloc(n) register n; { + register char *p,*result; + char *malloc(); + + result=p=malloc(n); + if (p== (char *) 0) + fatal("Out of memory"); + do *p++=0; while (--n); + return(result); +} + +chkincl(value,lwb,upb) { + + if (valueupb) + error("Number %d should have been between %d and %d", + value,lwb,upb); + return(value); +} + +subset(sp1,sp2,setsize) short *sp1,*sp2; { + register i; + + for(i=0;ivi_next; + l++; + } + return(l); +} diff --git a/util/ncgg/token.h b/util/ncgg/token.h new file mode 100644 index 00000000..2f48de5e --- /dev/null +++ b/util/ncgg/token.h @@ -0,0 +1,19 @@ +/* $Header$ */ + +#ifndef _COST_ +#include "cost.h" +#endif + + +typedef struct token { + char *tk_name; + int tk_size; + cost_t tk_cost; + struct { + int ta_type; /* -1 is int, -2 is addr, >=0 is propno */ + char *ta_name; + } tk_att[MAXATT]; + int tk_format; +} token_t,*token_p; + +extern token_p l_tokens[MAXTOKENS]; diff --git a/util/ncgg/var.c b/util/ncgg/var.c new file mode 100644 index 00000000..97ba265d --- /dev/null +++ b/util/ncgg/var.c @@ -0,0 +1,45 @@ +#ifndef NORCSID +static char rcsid[]= "$Header$"; +#endif + +#include "param.h" +#include "reg.h" +#include "property.h" +#include "token.h" +#include "set.h" +#include "instruct.h" +#include "lookup.h" +#include + +int wordsize; +int pointersize; +int nregs=1; +int nprops; +int ntokens=1; +int nsets; +int ninstr; +int codeindex; +int empatlen,emmnem[EMPATMAX]; +int empatexpr; +int tokpatlen,tokpatset[TOKPATMAX],tokpatro[TOKPATMAX]; +int nallreg,allreg[MAXALLREG]; +int cursetno; +int allsetno; +int inproc=0; /* scanning "procedure" */ +int callproc=0; +int procarg[2]; +int fc1=1,fc2=1,fc3=1,fc4=1; +int maxmembers=0; +int regclass=1; +int maxtokensize=0; +int rvused=0; +int nregvar[4]; +int rvsize[4]; +int rvnumbers[4][MAXREGVAR]; + +reginfo l_regs[MAXREGS]; +propinfo l_props[MAXPROPS]; +token_p l_tokens[MAXTOKENS]; +set_t l_sets[MAXSETS]; +instr_t l_instr[MAXINSTR]; +symbol *symhash[NSYMHASH]; diff --git a/util/ncgg/varinfo.h b/util/ncgg/varinfo.h new file mode 100644 index 00000000..3c23ff12 --- /dev/null +++ b/util/ncgg/varinfo.h @@ -0,0 +1,13 @@ +/* $Header$ */ + +#define VI_NSTR 1 +#define VI_NINT 3 + +typedef struct varinfo { + struct varinfo *vi_next; + char *vi_str[VI_NSTR]; + int vi_int[VI_NINT]; + struct varinfo *vi_vi; +} varinfo; + +#define VI_NULL (struct varinfo *) 0 diff --git a/util/opt/Makefile b/util/opt/Makefile new file mode 100644 index 00000000..e2c5e1dc --- /dev/null +++ b/util/opt/Makefile @@ -0,0 +1,202 @@ +# $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 diff --git a/util/opt/alloc.c b/util/opt/alloc.c new file mode 100644 index 00000000..bcb86d0b --- /dev/null +++ b/util/opt/alloc.c @@ -0,0 +1,448 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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;sizeco_next; + tp->co_size = size; + if (corelist==0 || tpco_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 diff --git a/util/opt/alloc.h b/util/opt/alloc.h new file mode 100644 index 00000000..23c2e389 --- /dev/null +++ b/util/opt/alloc.h @@ -0,0 +1,55 @@ +/* $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 */ diff --git a/util/opt/assert.h b/util/opt/assert.h new file mode 100644 index 00000000..c117405c --- /dev/null +++ b/util/opt/assert.h @@ -0,0 +1,7 @@ +/* $Header$ */ + +#ifndef NDEBUG +#define assert(x) if(!(x)) badassertion(__FILE__,__LINE__) +#else +#define assert(x) /* nothing */ +#endif diff --git a/util/opt/backward.c b/util/opt/backward.c new file mode 100644 index 00000000..ab842f84 --- /dev/null +++ b/util/opt/backward.c @@ -0,0 +1,187 @@ +#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;ns_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; +} diff --git a/util/opt/cleanup.c b/util/opt/cleanup.c new file mode 100644 index 00000000..d4525d4a --- /dev/null +++ b/util/opt/cleanup.c @@ -0,0 +1,65 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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); +} diff --git a/util/opt/em_opt.6 b/util/opt/em_opt.6 new file mode 100644 index 00000000..a8b4b9d2 --- /dev/null +++ b/util/opt/em_opt.6 @@ -0,0 +1,35 @@ +.\" $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 diff --git a/util/opt/ext.h b/util/opt/ext.h new file mode 100644 index 00000000..79767b29 --- /dev/null +++ b/util/opt/ext.h @@ -0,0 +1,16 @@ +/* $Header$ */ + +#ifndef FILE +#include +#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; diff --git a/util/opt/flow.c b/util/opt/flow.c new file mode 100644 index 00000000..b83c39bd --- /dev/null +++ b/util/opt/flow.c @@ -0,0 +1,127 @@ +#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; + } + } +} diff --git a/util/opt/getline.c b/util/opt/getline.c new file mode 100644 index 00000000..d1080f9c --- /dev/null +++ b/util/opt/getline.c @@ -0,0 +1,556 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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;il_instr = n; + lnp->l_next = curpro.lastline; + curpro.lastline = lnp; + return(0); +} + +tstinpro() { + + if (prodepth==0) + error("This is not allowed outside a procedure"); +} diff --git a/util/opt/line.h b/util/opt/line.h new file mode 100644 index 00000000..d24237da --- /dev/null +++ b/util/opt/line.h @@ -0,0 +1,88 @@ +/* $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) diff --git a/util/opt/lookup.c b/util/opt/lookup.c new file mode 100644 index 00000000..d6126e34 --- /dev/null +++ b/util/opt/lookup.c @@ -0,0 +1,94 @@ +#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); +} diff --git a/util/opt/lookup.h b/util/opt/lookup.h new file mode 100644 index 00000000..0d36e3b4 --- /dev/null +++ b/util/opt/lookup.h @@ -0,0 +1,25 @@ +/* $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 diff --git a/util/opt/main.c b/util/opt/main.c new file mode 100644 index 00000000..11b274fd --- /dev/null +++ b/util/opt/main.c @@ -0,0 +1,77 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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); + } +} diff --git a/util/opt/makedepend b/util/opt/makedepend new file mode 100755 index 00000000..31e2e20d --- /dev/null +++ b/util/opt/makedepend @@ -0,0 +1,15 @@ +: '$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 diff --git a/util/opt/mktab.y b/util/opt/mktab.y new file mode 100644 index 00000000..969c068a --- /dev/null +++ b/util/opt/mktab.y @@ -0,0 +1,370 @@ +%{ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 MNEM +%token NUMBER +%type 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;imaxpatlen) 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;pex_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;pex_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>8)&0377); +} + +out(w) { + + if (w<255) { + outbyte(w); + } else { + outbyte(255); + outshort(w); + } +} + +#include "scan.c" diff --git a/util/opt/optim.h b/util/opt/optim.h new file mode 100644 index 00000000..d59e4375 --- /dev/null +++ b/util/opt/optim.h @@ -0,0 +1,12 @@ +/* $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 diff --git a/util/opt/param.h b/util/opt/param.h new file mode 100644 index 00000000..167d1265 --- /dev/null +++ b/util/opt/param.h @@ -0,0 +1,15 @@ +/* $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 diff --git a/util/opt/pattern.h b/util/opt/pattern.h new file mode 100644 index 00000000..e2211934 --- /dev/null +++ b/util/opt/pattern.h @@ -0,0 +1,126 @@ +/* $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[]; diff --git a/util/opt/patterns b/util/opt/patterns new file mode 100644 index 00000000..461d3a85 --- /dev/null +++ b/util/opt/patterns @@ -0,0 +1,519 @@ +"$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=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 diff --git a/util/opt/peephole.c b/util/opt/peephole.c new file mode 100644 index 00000000..1a52beea --- /dev/null +++ b/util/opt/peephole.c @@ -0,0 +1,652 @@ +#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 +#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<>(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<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;il_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; il_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 */ +} diff --git a/util/opt/process.c b/util/opt/process.c new file mode 100644 index 00000000..0c763d84 --- /dev/null +++ b/util/opt/process.c @@ -0,0 +1,185 @@ +#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; + } + } +} diff --git a/util/opt/proinf.h b/util/opt/proinf.h new file mode 100644 index 00000000..0813fef1 --- /dev/null +++ b/util/opt/proinf.h @@ -0,0 +1,36 @@ +/* $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; diff --git a/util/opt/putline.c b/util/opt/putline.c new file mode 100644 index 00000000..afa49f76 --- /dev/null +++ b/util/opt/putline.c @@ -0,0 +1,381 @@ +#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;lengthab_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++ ); + } +} diff --git a/util/opt/reg.c b/util/opt/reg.c new file mode 100644 index 00000000..9c1081c6 --- /dev/null +++ b/util/opt/reg.c @@ -0,0 +1,106 @@ +#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 +} diff --git a/util/opt/scan.l b/util/opt/scan.l new file mode 100644 index 00000000..660c97a7 --- /dev/null +++ b/util/opt/scan.l @@ -0,0 +1,77 @@ +%{ +#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++; } diff --git a/util/opt/special.c b/util/opt/special.c new file mode 100644 index 00000000..5147aa90 --- /dev/null +++ b/util/opt/special.c @@ -0,0 +1,33 @@ +#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); +} diff --git a/util/opt/testopt b/util/opt/testopt new file mode 100755 index 00000000..37430956 --- /dev/null +++ b/util/opt/testopt @@ -0,0 +1,9 @@ +: '$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 diff --git a/util/opt/types.h b/util/opt/types.h new file mode 100644 index 00000000..9b946219 --- /dev/null +++ b/util/opt/types.h @@ -0,0 +1,21 @@ +/* $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 diff --git a/util/opt/util.c b/util/opt/util.c new file mode 100644 index 00000000..85529cdc --- /dev/null +++ b/util/opt/util.c @@ -0,0 +1,62 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 diff --git a/util/opt/var.c b/util/opt/var.c new file mode 100644 index 00000000..9d5be0a5 --- /dev/null +++ b/util/opt/var.c @@ -0,0 +1,40 @@ +#ifndef NORCSID +static char rcsid[] = "$Header$"; +#endif + +#include +#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 */ diff --git a/util/shf/Makefile b/util/shf/Makefile new file mode 100644 index 00000000..813a5eff --- /dev/null +++ b/util/shf/Makefile @@ -0,0 +1,17 @@ +# $Header$ + +install: + -rm -f ../../bin/march + cp march.sh ../../bin/march + +clean: + @echo always clean + +cmp: + cmp march.sh ../../bin/march + +opr: + make pr|opr + +pr: + pr march.sh diff --git a/util/shf/march.sh b/util/shf/march.sh new file mode 100755 index 00000000..8d76d3af --- /dev/null +++ b/util/shf/march.sh @@ -0,0 +1,51 @@ +: '$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 + ${RANLIB-:} $2 + 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